1%macro irmst_market_risk_funs_def_1;
5 function RSK_EUROPEANCALLOPTION_PF(Price,Strike,RiskFreeRate,YieldParam,TimeToExpiration,Volatility)
6 label=
"European call option pricing by Black and Scholes (1973)";
10 IF TimeToExpiration lt 0 THEN
return(0);
11 IF TimeToExpiration eq 0 THEN
return (max(Price-Strike,0));
16 Fname =
'rsk_europeancalloption_pf';
20 ReturnMissingFlg = rsk_check_num_missing_pf( RiskFreeRate, Fname,
'3',
'RiskFreeRate', ReturnMissingFlg );
21 ReturnMissingFlg = rsk_check_num_missing_pf( YieldParam, Fname,
'4',
'YieldParam', ReturnMissingFlg );
22 ReturnMissingFlg = rsk_check_num_missing_pf( TimeToExpiration, Fname,
'5',
'TimeToExpiration', ReturnMissingFlg );
23 ReturnMissingFlg = rsk_check_num_missing_pf( Price, Fname,
'1',
'Price', ReturnMissingFlg );
24 ReturnMissingFlg = rsk_check_nonpositive_pf( Strike, Fname,
'2',
'Strike', ReturnMissingFlg );
25 ReturnMissingFlg = rsk_check_nonpositive_pf( Volatility, Fname,
'6',
'Volatility', ReturnMissingFlg );
27 if ReturnMissingFlg eq 1 then
return(.);
31 CostofCarry=RiskFreeRate - YieldParam;
32 g = Volatility*sqrt(TimeToExpiration);
33 d1 = (log(Price / Strike) + CostofCarry * TimeToExpiration )/g + 0.5 * g;
35 OptionPrice = Price * exp( -YieldParam * TimeToExpiration) * probnorm(d1) - Strike * exp(-RiskFreeRate * TimeToExpiration) * probnorm(d2);
42 function RSK_DAYCOUNT(Convention $,BeginDate,EndDate)
43 label=
"Calculates the number of years between two dates, given a day counting convention";
46 length local_convention $32;
47 local_convention = Convention;
49 if missing(local_convention) then local_convention =
'ACT/365';
51 if EndDate le BeginDate or missing(BeginDate) then
return(0);
53 select(local_convention);
58 num = EndDate - BeginDate ;
60 returnval = num / den;
64 returnval = yrdif( BeginDate, EndDate, local_convention );
74 function RSK_INTPOLATE(refdate , matdate , Convention $, Curve[*], CurveMat[*], IntpMethod $)
75 label="Interpolates on a curve, given the reference and maturity dates";
79 length local_convention upIntpMethod $32;
80 local_convention = Convention;
81 upIntpMethod = upcase(IntpMethod);
82 period = rsk_daycount(local_convention,Refdate,matdate);
83 IntVal = rsk_intpolate2( period, Curve, CurveMat, upIntpMethod );
90 function RSK_CALC_NEXT_DATE(RefDate, Nmbr_Mth)
91 label="Calculates the next date using a fixed months for the period";
92 BeginMonth = intnx('month',RefDate,Nmbr_Mth);
93 DayMax = day (intnx ('month',BeginMonth ,1)-1);
94 if day(RefDate) le DayMax then
95 Sameday_Next = mdy (month(BeginMonth) , day(RefDate), year(BeginMonth));
97 sameday_next = mdy (month(BeginMonth) , DayMax, year(BeginMonth));
98 return (sameday_next);
103 function RSK_IMPLIED_FWD_RATE(RefDate, fwd_date, fwd_dateto, Convention $, Curve [*], CurveMat[*],IntpMethod $)
104 label="Computes a single forward rate, given the spot rates (continuous compounding)";
107 length local_convention $32;
108 local_convention = Convention;
109 period1 = rsk_daycount(local_convention,Refdate,fwd_date);
111 period2 = rsk_daycount(local_convention,Refdate,fwd_dateto);
113 rate1 = rsk_intpolate2( period1, Curve, CurveMat, IntpMethod);
115 rate2 = rsk_intpolate2( period2, Curve, CurveMat,IntpMethod );
117 forward_period = period2-period1;
121 sqrtmaceps = constant('SQRTMACEPS');
122 if forward_period > sqrtmaceps and refdate le fwd_date then do;
123 fwd_rate = (1+rate2)**(period2/forward_period) / (1+rate1)**(period1/forward_period) - 1;
126 if abs(forward_period) le sqrtmaceps then fwd_rate = rate1;
137 function RSK_INTPOLATE2(Period, Curve[*], CurveMat[*], IntpMethod $)
138 label="Interpolates on a curve, given the target maturity in years";
146 ReturnMissingFlg = 0;
147 Fname = 'rsk_intpolate2';
151 ReturnMissingFlg = rsk_check_num_missing_pf( Period, Fname, '1', 'Period', ReturnMissingFlg );
153 ReturnMissingFlg = rsk_check_array_pf( CurveMat, dim, 'MISSING', Fname, '3', 'CurveMat', ReturnMissingFlg );
154 ReturnMissingFlg = rsk_check_array_pf( CurveMat, dim, 'UNORDERED', Fname, '3', 'CurveMat', ReturnMissingFlg );
156 if ReturnMissingFlg eq 1 then return(.);
160 if IntpMethod eq 'LOG' then do;
162 j = rsk_find_right( period, CurveMat );
163 if j eq 1 then IntVal = Curve{1};
165 if j > dim then IntVal = Curve{dim};
167 IntVal = Curve{j-1} * ( ( Curve{j} / Curve{j-1} ) ** ( ( period - CurveMat{j-1} ) / ( CurveMat{j} - CurveMat{j-1} ) ) );
170 if IntpMethod eq
'CUBIC' then
do;
173 if ( period <= CurveMat{1} ) then IntVal = Curve{1};
175 if ( period >= CurveMat{dim} ) then IntVal = Curve{dim};
178 Array M_temp[1] /nosym;
179 Array N_temp[1] /nosym;
180 Array Q_temp[1] /nosym;
181 Array A_temp[1] /nosym;
182 Array B_temp[1] /nosym;
183 Array D_temp[1] /nosym;
184 Array AA_temp[1] /nosym;
185 Array BB_temp[1] /nosym;
186 Array CC_temp[1] /nosym;
187 CALL DYNAMIC_ARRAY(M_temp,dim);
188 CALL DYNAMIC_ARRAY(N_temp,dim);
189 CALL DYNAMIC_ARRAY(Q_temp,dim);
190 CALL DYNAMIC_ARRAY(A_temp,dim);
191 CALL DYNAMIC_ARRAY(B_temp,dim);
192 CALL DYNAMIC_ARRAY(D_temp,dim);
193 CALL DYNAMIC_ARRAY(AA_temp,dim);
194 CALL DYNAMIC_ARRAY(BB_temp,dim);
195 CALL DYNAMIC_ARRAY(CC_temp,dim);
197 M_temp[1]=CurveMat[2] - CurveMat[1];
198 N_temp[1]=Curve[2] - Curve[1];
204 M_temp[i]= CurveMat[i+1] - CurveMat[i];
205 N_temp[i]= Curve[i+1] - Curve[i];
206 Q_temp[i]= 3*( (N_temp[i] / M_temp[i] ) - (N_temp[i-1] / M_temp[i-1] ) );
207 A_temp[i]= 2* (M_temp[i-1] + M_temp[i]) - M_temp[i-1] * B_temp[i-1];
208 B_temp[i]= M_temp[i] / A_temp[i];
209 D_temp[i]= ( Q_temp[i] - M_temp[i-1] * D_temp[i-1] ) / A_temp[i];
216 do i=(dim-1) to 1 BY -1;
217 BB_temp[i]= D_temp[i] - B_temp[i] * BB_temp[i+1];
218 AA_temp[i]= (N_temp[i] / M_temp[i] ) - ( M_temp[i] / 3* ( BB_temp[i+1] + 2*BB_temp[i] ) );
219 CC_temp[i]= (BB_temp[i+1] - BB_temp[i]) / (3*M_temp[i]);
221 j = rsk_find_right( period, CurveMat );
222 if j eq 1 then IntVal = Curve{1};
224 if j > dim then IntVal = Curve{dim};
228 IntVal = Curve{j} + ( AA_temp{j} * ( period - CurveMat{j} ) ) + ( BB_temp{j} * ( period - CurveMat{j} )**2 ) + ( CC_temp{j} * ( period - CurveMat{j} )**3 );
233 if IntpMethod eq
'STEP' then
do;
234 j = rsk_find_left( period, CurveMat );
239 if IntpMethod eq
'FORWARD_RATE' then
do;
240 j = rsk_find_left( period, CurveMat );
241 if j < 1 then IntVal = Curve[1];
243 if j eq dim(CurveMat) then IntVal = Curve[j];
246 timediff = period - CurveMat[j];
247 if abs(timediff) le constant(
'SQRTMACEPS') then IntVal = Curve[j];
250 fwdperiod = CurveMat[j+1] - CurveMat[j];
251 r1plus1 = 1+Curve[j];
252 forward_rate_plus1 = (1+Curve[j+1])**(CurveMat[j+1]/fwdperiod) / r1plus1**(CurveMat[j]/fwdperiod);
253 IntVal = r1plus1**(CurveMat[j]/period) * forward_rate_plus1 ** (timediff/period)-1;
260 j = rsk_find_right( period, CurveMat );
261 if j eq 1 then IntVal = Curve{1};
263 if j > dim then IntVal = Curve{dim};
265 IntVal = Curve{j-1} + ( ( Curve{j} - Curve{j-1} ) * ( period - CurveMat{j-1} ) / ( CurveMat{j} - CurveMat{j-1} ) );
272 function RSK_CHECK_NONPOSITIVE_PF(VariableValue, FunctionName $, VariableNum $, VariableName $, ErrorFoundFlag)
273 label=
"Checks a value to verify that it is positive";
275 if missing(VariableValue) then
do;
276 call rsk_print_error_msg_and_abort(
'rsk_func_missing_inputs_error', FunctionName, VariableNum, VariableName,
'',
'',
'',
'' );
280 if VariableValue le constant(
'SQRTMACEPS') then do;
281 call rsk_print_error_msg_and_abort( 'rsk_func_nonpos_inputs_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
286 return(coalesce(ErrorFoundFlag,0));
291 function RSK_CHECK_NUM_MISSING_PF(VariableValue, FunctionName $, VariableNum $, VariableName $, ErrorFoundFlag)
292 label="Checks a value to verify that it is nonmissing";
294 if missing(VariableValue) then do;
295 call rsk_print_error_msg_and_abort( 'rsk_func_missing_inputs_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
300 return(coalesce(ErrorFoundFlag,0));
306 subroutine RSK_PRINT_ERROR_MSG_AND_ABORT(key $, s1 $, s2 $, s3 $, s4 $, s5 $, s6 $, s7 $)
307 label="Prints a message to the log, with call stack, and then aborts the current position";
315 array message_count[1] / nosym;
316 call dynamic_array(message_count,.);
317 if missing(message_count[1]) then message_count[1]=1;
319 message_count[1]=message_count[1]+1;
320 numputs=message_count[1];
323 if numputs le maxputs then do;
324 msg = rsk_get_msg_subr(key, s1, s2, s3, s4, s5, s6, s7);
325 call assert(0, trim(msg));
328 if numputs eq maxputs+1 then do;
329 msg = rsk_get_msg_subr('rsk_exceed_msg_limit_warning', 'NOQUOTE', '', '', '', '', '', '');
339 function RSK_FIND_LEFT(value,arr[*])
340 label="Finds closest element of a sorted array which is less than or equal to the input value";
344 do while( up-lp > 0 );
345 mp = floor((up+lp)/2);
346 if arr[mp] > value then up = mp;
348 if mp eq cap then return(cap);
350 if arr[mp+1] le value then lp = mp + 1;
359 function RSK_FIND_RIGHT(value,arr[*])
360 label="Finds closest element of a sorted array which is greater than or equal to the input value";
364 do while( up-lp > 0 );
365 mp = floor((up+lp)/2);
366 if arr[mp] < value then lp = mp + 1;
368 if mp eq 1 then return(1);
370 if arr[mp-1] ge value then up = mp;
378 function RSK_CHECK_ARRAY_PF(InputArray[*], ArraySize, CheckType $, FunctionName $, VariableNum $, VariableName $, ErrorFoundFlag)
379 label="Checks the values of a one-dimensional array to verify they meet expected criteria";
381 newsize = min(ArraySize,dim(InputArray));
383 tempvalue = coalesce(InputArray[1],0);
384 if CheckType eq 'NONPOSITIVE' then do i = 1 to newsize while( InputArray[i] > 0 );
387 if CheckType eq 'NEGATIVE' then do i = 1 to newsize while( InputArray[i] ge 0 );
390 if CheckType eq 'MISSING' then do i = 1 to newsize while( not missing(InputArray[i]) );
393 if CheckType eq 'UNORDERED' then do i = 1 to newsize while( tempvalue le InputArray[i] );
394 tempvalue = InputArray[i];
396 if i le newsize and not missing(i) then do;
397 if CheckType eq 'NONPOSITIVE' then do;
398 call rsk_print_error_msg_and_abort( 'rsk_func_nonpos_array_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
401 if CheckType eq 'NEGATIVE' then do;
402 call rsk_print_error_msg_and_abort( 'rsk_func_neg_array_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
405 if CheckType eq 'MISSING' then do;
406 call rsk_print_error_msg_and_abort( 'rsk_func_miss_array_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
409 if CheckType eq 'UNORDERED' then do;
410 call rsk_print_error_msg_and_abort( 'rsk_func_order_array_error', FunctionName, VariableNum, VariableName, '', '', '', '' );
416 return(coalesce(ErrorFoundFlag,0));
421 function RSK_GET_MSG_SUBR(key $, s1 $, s2 $, s3 $, s4 $, s5 $, s6 $, s7 $)
422 label="Fetches and returns a translated message";
427 msgfile = 'sashelp.rmbutilmsg';
428 if not missing(s7) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2), trim(s3), trim(s4), trim(s5), trim(s6), trim(s7) );
430 if not missing(s6) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2), trim(s3), trim(s4), trim(s5), trim(s6) );
432 if not missing(s5) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2), trim(s3), trim(s4), trim(s5) );
434 if not missing(s4) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2), trim(s3), trim(s4) );
436 if not missing(s3) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2), trim(s3) );
438 if not missing(s2) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1), trim(s2) );
440 if not missing(s1) then msg = sasmsgl( msgfile, key, 'en', 'NOQUOTE', trim(s1) );
442 msg = sasmsgl( msgfile, key, 'en','NOQUOTE' );
450 function RSK_CALC_CF_DUR(PV, CFAmt[*], CFMat[*], CFNum, Yield, START_DT)
451 label="Calculates duration of a series of cash flows";
452 if(PV le 0 or CFNUM le 0) then
455 array _MAT_DATE_[1]/nosym;
456 call DYNAMIC_ARRAY(_MAT_DATE_,CFNUM);
457 if START_DT ne . then do;
459 _MAT_DATE_[i]=(CFMat[i]-START_DT)/365.25;
466 _MAT_DATE_[i]=CFMat[i];
472 CFSum=CFSum+_MAT_DATE_[i]*CFAmt[i]*exp(-1*Yield*_MAT_DATE_[i]);
480 function RSK_CALC_CF_YIELD(PV, CFAmt[*], CFMat[*], CFNum, START_DT)
481 label="Calculates yield of a series of cash flows";
485 array _MAT_DATE_[1]/nosym;
486 call DYNAMIC_ARRAY(_MAT_DATE_,CFNUM);
487 if START_DT ne . then do;
489 _MAT_DATE_[i]=(CFMat[i]-START_DT)/365.25;
496 _MAT_DATE_[i]=CFMat[i];
507 array solvopts[1] initial (0.20);
508 Yield=solve("PV_Minus_Cashflow", solvopts, 0, PV, CFAmt, _MAT_DATE_, CFNum, .);
513 function RSK_PV_CSHFLW_LAMBDA(N,ValDate, Date[*], Amount[*], Convention $, ZCCurve[*],ZCCMAT[*],SPREADCurve[*],SPREADMat[*],RHO, LAMBDA, LAMBDA_IDIO, ZCIntMeth $, SPREADIntMeth $)
514 label="Cashflow present value risk premia";
518 length local_convention $32;
519 local_convention = Convention;
521 p_year=rsk_daycount(local_convention,ValDate,Date[i]);
522 if p_year gt 0 then do;
523 _a1_=probit(rsk_intpolate2(p_year,SPREADCurve,SPREADMat,SPREADIntMeth));
524 _a2_=probnorm( _a1_ + (RHO*LAMBDA+LAMBDA_IDIO)*sqrt(SPREADMat[i]));
526 _a_=(-1/SPREADMat[i])*_a3_;
527 r = sum(rsk_intpolate2(p_year,ZCCURVE,ZCCMAT,ZCIntMeth),_a_);
529 PresentVal = PresentVal + d*(Amount[i]);
539 function PV_MINUS_CASHFLOW(PV, CFAmt[*], CFMat[*], CFNum, EstimatedYield)
540 label="Difference between present value of a series of cash flows and the sum of the cash flows";
543 SumCFAmt=SumCFAmt+CFAmt[i]*exp(-1*EstimatedYield*CFMat[i]);
550 function RSK_PV_CSHFLW(N, ValDate, Date[*], Amount[*], Convention $, ZCCurve[*], ZCCMAT[*], Spread, IntpMethod $)
551 label="Calculates the present value of a series of cash flows";
559 Fname = 'rsk_pv_cshflw';
561 ErrorFoundFlg = rsk_check_num_missing_pf( N, Fname, '1', 'N', ErrorFoundFlg );
562 ErrorFoundFlg = rsk_check_num_missing_pf( ValDate, Fname, '2', 'ValDate', ErrorFoundFlg );
563 ErrorFoundFlg = rsk_check_array_pf( Date, N, 'MISSING', Fname, '3', 'Date', ErrorFoundFlg );
564 ErrorFoundFlg = rsk_check_array_pf( Amount, N, 'MISSING', Fname, '4', 'Amount', ErrorFoundFlg );
565 ErrorFoundFlg = rsk_check_array_pf( ZCCurve, dim(ZCCurve), 'MISSING', Fname, '6', 'ZCCurve', ErrorFoundFlg );
566 ErrorFoundFlg = rsk_check_array_pf( ZCCMAT, dim(ZCCMAT), 'UNORDERED', Fname, '7', 'ZCCMAT', ErrorFoundFlg );
567 ErrorFoundFlg = rsk_check_num_missing_pf( Spread, Fname, '8', 'Spread', ErrorFoundFlg );
569 if ErrorFoundFlg eq 1 then return(.);
575 length local_convention $32;
576 local_convention = Convention;
579 p = Date[i] - ValDate;
580 p_year=rsk_daycount(local_convention,ValDate,Date[i]);
582 r = rsk_intpolate2( p_year,ZCCURVE,ZCCMAT,IntpMethod) + SPREAD;
584 PresentVal = PresentVal + d*(Amount[i]);
592 function RSK_BINARY_DOUBLE_BARRIEROPT_PF(Binary_barrertype $, Price, Price_Chk_Upper, Price_Chk_Lower, Lower_Barrier, Upper_Barrier, Cash_Amt, RiskFreeRate, YieldParam, TimeToExpiration, Volatility)
593 label="European binary
double barrier option pricing by Hui (1996)";
594 IF TimeToexpiration < 0 THEN return(0);
613 length Internal_Binary_Barrier_Cd $1;
614 if lowcase(Binary_barrertype) eq 'uidi' then Internal_Binary_Barrier_Cd = '1';
616 if lowcase(Binary_barrertype) eq 'uodo' then Internal_Binary_Barrier_Cd = '2';
618 if lowcase(Binary_barrertype) eq 'uodi' then Internal_Binary_Barrier_Cd = '3';
620 if lowcase(Binary_barrertype) eq 'uido' then Internal_Binary_Barrier_Cd = '4';
623 CostofCarry=RiskFreeRate - YieldParam;
626 IF Internal_Binary_Barrier_Cd eq '1' or Internal_Binary_Barrier_Cd eq '2' THEN DO;
628 Z=log(Upper_Barrier/Lower_Barrier);
629 _alpha_=-CostofCarry/(volatility*volatility) + 0.5;
630 _beta_=-0.25*( ((2*CostofCarry)/(volatility*volatility) -1 )**2 ) - ( 2*RiskFreeRate)/(Volatility*volatility);
632 _tmp_= (2*constant('PI') *i*Cash_Amt) /(Z*Z);
633 _tmp1_=(Price/Lower_Barrier)**_alpha_ - ((-1)**i ) * ((Price/Upper_Barrier)**_alpha_);
634 _tmp2_=_alpha_*_alpha_ + ((i*constant('PI'))/Z)**2;
635 _tmp3_=sin( ( (i*constant('PI')) / Z ) * log(Price/Lower_Barrier) );
636 _tmp4_= (-0.5*( (i*constant('PI')) / Z )**2 +0.5*_beta_)* ( volatility*volatility*TimeToExpiration);
637 OptionPrice=OptionPrice + _tmp_*(_tmp1_/_tmp2_)* _tmp3_ * exp(_tmp4_);
639 IF Internal_Binary_Barrier_Cd eq '1' THEN DO;
640 OptionPrice=Cash_Amt*exp(-RiskFreeRate*TimeToExpiration) - OptionPrice;
641 IF Price_Chk_Lower le Lower_Barrier or Price_Chk_Upper ge Upper_Barrier THEN DO;
643 OptionPrice=Cash_Amt*exp(-RiskFreeRate*TimeToExpiration);
646 IF Internal_Binary_Barrier_Cd eq '2' THEN DO;
647 IF Price_Chk_Lower le Lower_Barrier or Price_Chk_Upper ge Upper_Barrier THEN DO;
655 Up_Barrier=Upper_Barrier;
656 Lo_Barrier=Lower_Barrier;
657 IF Internal_Binary_Barrier_Cd eq '4' THEN DO;
658 Up_Barrier=Lower_Barrier;
659 Lo_Barrier=Upper_Barrier;
662 Z=log(Up_Barrier/Lo_Barrier);
663 _alpha_=-CostofCarry/(volatility*volatility) + 0.5;
664 _beta_=-0.25*( ((2*CostofCarry)/(volatility*volatility) -1 )**2 ) - ( 2*RiskFreeRate)/(Volatility*volatility);
666 _tmp0_=Cash_Amt*((Price/Lo_Barrier)**_alpha_);
667 _tmp_= (2/(constant('PI')*i));
668 _tmp3_=SIN( ( (i*constant('PI')) / Z ) * log(Price/Lo_Barrier) );
669 _tmp4_= (-0.5*( (i*constant('PI')) / Z )**2 +0.5*_beta_)* ( volatility*volatility*TimeToExpiration);
670 _tmpv_=((i*constant('PI'))/Z)**2;
671 _tmpvv_= exp(_tmp4_);
672 _tmpvvv_=((i*constant('PI'))/Z)**2 - _beta_;
673 _tmpu_=(1- (log(Price/Lo_Barrier)) / Z );
674 OptionPrice=OptionPrice + _tmp3_*_tmp_* ( ( _beta_ - _tmpv_*_tmpvv_ ) / _tmpvvv_ );
676 OptionPrice=OptionPrice*_tmp0_ + +_tmpu_*_tmp0_;
683 IF Internal_Binary_Barrier_Cd eq '3' THEN DO;
684 IF Price_Chk_Lower le Lower_Barrier THEN DO;
685 IF _w02_chk_ ne 1 THEN DO;
688 OptionPrice=Cash_Amt;
692 IF Price_Chk_Upper ge Upper_Barrier THEN DO;
694 IF _w01_chk_ ne 1 THEN DO;
702 IF Internal_Binary_Barrier_Cd eq '4' THEN DO;
703 IF Price_Chk_Lower le Lower_Barrier THEN DO;
705 IF _w04_chk_ ne 1 THEN DO;
712 IF Price_Chk_Upper ge Upper_Barrier THEN DO;
713 IF _w03_chk_ ne 1 THEN DO;
716 OptionPrice=Cash_Amt;