- PRCSEB3 ;WISC/LJP-DAILY RECORD'S ADDING MACHINE ;11-6-89/15:27
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 1 W !,"+ - * /" K PRCSE,PRCSOK S PRCSY=0 W ?29,"Total"
- 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)
- 2 K PRCSE,PRCSI,PRCSR,PRCSR1,PRCSR2,PRCSY Q
- 3 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
- 4 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
- 5 S PRCSR=+PRCSR I PRCSR>0 S PRCSR=-PRCSR D CK Q
- Q
- CK S:PRCSR["?"!(+PRCSR=0)!(PRCSR<-999999.9999)!(PRCSR>999999.9999)!(PRCSR'?."-".N.1".".2N) PRCSE=1 D:PRCSE W Q
- W W $C(7),!,"Must be numeric, between -999999.9999 and 999999.9999 and not ZERO",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSEB3 996 printed Mar 13, 2025@21:22:21 Page 2
- PRCSEB3 ;WISC/LJP-DAILY RECORD'S ADDING MACHINE ;11-6-89/15:27
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- 1 WRITE !,"+ - * /"
- KILL PRCSE,PRCSOK
- SET PRCSY=0
- WRITE ?29,"Total"
- +1 FOR PRCSI=0:0
- SET PRCSE=0
- READ !," $ ",PRCSR:DTIME
- if PRCSR=""
- QUIT
- if PRCSR="^"
- GOTO 2
- DO @$SELECT(PRCSR["*":3,PRCSR["/":4,PRCSR["-":5,1:"CK")
- if 'PRCSE
- SET PRCSY=PRCSR+PRCSY
- KILL PRCSVAR
- WRITE ?27,$JUSTIFY(PRCSY,9,4)
- 2 KILL PRCSE,PRCSI,PRCSR,PRCSR1,PRCSR2,PRCSY
- QUIT
- 3 SET PRCSR1=$PIECE(PRCSR,"*",1)
- SET PRCSR2=$PIECE(PRCSR,"*",2)
- SET PRCSR=PRCSR1
- DO CK
- if PRCSE
- QUIT
- SET PRCSR=PRCSR2
- DO CK
- if PRCSE
- QUIT
- SET PRCSR=PRCSR1*PRCSR2
- WRITE ?15,$JUSTIFY(PRCSR,9,4)
- QUIT
- 4 SET PRCSR1=$PIECE(PRCSR,"/",1)
- SET PRCSR2=$PIECE(PRCSR,"/",2)
- SET PRCSR=PRCSR1
- DO CK
- if PRCSE
- QUIT
- SET PRCSR=PRCSR2
- DO CK
- if PRCSE
- QUIT
- SET PRCSR=PRCSR1/PRCSR2
- WRITE ?15,$JUSTIFY(PRCSR,9,4)
- QUIT
- 5 SET PRCSR=+PRCSR
- IF PRCSR>0
- SET PRCSR=-PRCSR
- DO CK
- QUIT
- +1 QUIT
- CK if PRCSR["?"!(+PRCSR=0)!(PRCSR<-999999.9999)!(PRCSR>999999.9999)!(PRCSR'?."-".N.1".".2N)
- SET PRCSE=1
- if PRCSE
- DO W
- QUIT
- W WRITE $CHAR(7),!,"Must be numeric, between -999999.9999 and 999999.9999 and not ZERO",!
- QUIT
