PRCSEB3.m

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 ---PRCSEB3   996     printed  Apr 09, 2024@21:03:17                                                                                                                                                                                                      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