source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSEB3.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 984 bytes
Line 
1PRCSEB3 ;WISC/LJP-DAILY RECORD'S ADDING MACHINE ;11-6-89/15:27
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
41 W !,"+ - * /" K PRCSE,PRCSOK S PRCSY=0 W ?29,"Total"
5 F PRCSI=0:0 S PRCSE=0 R !," $ ",PRCSR:DTIME Q:PRCSR="" G:PRCSR="^" 2 D @$S(PRCSR["*":3,PRCSR["/":4,PRCSR["-":5,1:"CK") S:'PRCSE PRCSY=PRCSR+PRCSY K PRCSVAR W ?27,$J(PRCSY,9,4)
62 K PRCSE,PRCSI,PRCSR,PRCSR1,PRCSR2,PRCSY Q
73 S PRCSR1=$P(PRCSR,"*",1),PRCSR2=$P(PRCSR,"*",2),PRCSR=PRCSR1 D CK Q:PRCSE S PRCSR=PRCSR2 D CK Q:PRCSE S PRCSR=PRCSR1*PRCSR2 W ?15,$J(PRCSR,9,4) Q
84 S PRCSR1=$P(PRCSR,"/",1),PRCSR2=$P(PRCSR,"/",2),PRCSR=PRCSR1 D CK Q:PRCSE S PRCSR=PRCSR2 D CK Q:PRCSE S PRCSR=PRCSR1/PRCSR2 W ?15,$J(PRCSR,9,4) Q
95 S PRCSR=+PRCSR I PRCSR>0 S PRCSR=-PRCSR D CK Q
10 Q
11CK S:PRCSR["?"!(+PRCSR=0)!(PRCSR<-999999.9999)!(PRCSR>999999.9999)!(PRCSR'?."-".N.1".".2N) PRCSE=1 D:PRCSE W Q
12W W $C(7),!,"Must be numeric, between -999999.9999 and 999999.9999 and not ZERO",! Q
Note: See TracBrowser for help on using the repository browser.