- RMPFQP ;DDC/KAW-PRINT VA FORM 10-2477a; [ 06/16/95 3:06 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
- I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
- W @IOF,!!,"PRINT VA FORM 10-2477a"
- TYPE D SEL G END:$D(RMPFOUT)!(Y="")
- S RMPFRTN=$S("Bb"[Y:"^RMPFQP2","Oo"[Y:"^RMPFQP3",1:"^RMPFQP4")
- G QUE:"Bb"[Y I "Pp"[Y D PAT G END:'$D(DFN),QUE
- D PAT G END:'$D(DFN)!$D(RMPFOUT) S (DX,CX)=0
- F I=1:1 S DX=$O(^RMPF(791810,"AE",DFN,DX)) Q:'DX S EX=0 F J=1:1 S EX=$O(^RMPF(791810,"AE",DFN,DX,EX)) Q:'EX S RMPFX=EX,CX=CX+1
- PAT1 I CX=0 W !!,"*** NO ORDERS EXIST FOR THIS PATIENT ***" G TYPE
- G QUE:CX=1 S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 I 'RMPFCX S CX=0 G PAT1
- D SEL^RMPFDX G END:$D(RMPFOUT),TYPE:'$D(RMPFX)
- D QUE G END:$D(RMPFOUT),RMPFSET
- END K RMPFRTN,RMPFORD,RMPFTP,RMPFP,RMPFX,RMPFS,RMPFR,RMPFOUT,RMPFQUT
- K EX,DX,CX,DFN,RMPFCNT,RMPFO,ZTSK,DISYS,J,I,KX,RMPFHAT
- K RMPFCX,RMPFRSTA,ZTRTN,ZTDESC,ZTIO,ZTSAVE,POP,%,%Y,%ZIS,X,Y,%T,C,DIC
- Q
- PAT K DFN W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y Q
- READ K RMPFOUT,RMPFQUT
- R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
- I Y?1"^".E S (RMPFOUT,Y)="" Q
- S:Y?1"?".E (RMPFQUT,Y)=""
- Q
- SEL W !!,"Print an <O>rder, <P>atient data only or a <B>lank Form 10-2477a: "
- D READ Q:$D(RMPFOUT)
- SEL1 I $D(RMPFQUT) W !!,"Enter an <O> to select an order to print,",!?7,"a <P> to print only the patient information or",!?7,"a <B> to print a blank Form 10-2477a." G SEL
- Q:Y="" S Y=$E(Y,1) I "OoBbPp"'[Y S RMPFQUT="" G SEL1
- K X Q
- CHOOSE K RMPFX G CHE:'$D(RMPFS)
- F I=1:1 Q:$Y>21 W !
- CH1 W !,"Select a Number or <RETURN> to continue: " D READ
- G CHE:$D(RMPFOUT)
- CH2 I $D(RMPFQUT) W !!,"Enter the number to the left of the order or",!?5,"<RETURN> to continue." G CH1
- G CHE:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G CH2
- S RMPFX=RMPFS(Y)
- CHE K RMPFS,Y Q
- QUE W ! S %ZIS="NPQ" D ^%ZIS Q:POP S RMPFCNT=1
- I IO=IO(0),'$D(IO("S")) D @(RMPFRTN) Q
- I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G @(RMPFRTN)
- NUM W !!,"Number of copies to print: 1// " D READ
- Q:$D(RMPFOUT)
- NUM1 I $D(RMPFQUT) W !!,"Enter a number from 1 to 10 for the number of copies to print." G NUM
- S:Y="" Y=1 I 'Y!(Y<1)!(Y>10) S RMPFQUT="" G NUM1
- S RMPFCNT=$P(Y,".",1)
- S ZTRTN=RMPFRTN,ZTDESC="FORM 10-2477a",ZTIO=ION,ZTSAVE("RM*")="",ZTSAVE("DFN")=""
- D ^%ZTLOAD,HOME^%ZIS Q:'$D(ZTSK)
- W:$D(ZTSK) !!,"*** Request Queued ***" H 1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFQP 2558 printed Feb 19, 2025@00:03:20 Page 2
- RMPFQP ;DDC/KAW-PRINT VA FORM 10-2477a; [ 06/16/95 3:06 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
- RMPFSET ;;RMPFMENU must be defined
- IF '$DATA(RMPFMENU)
- DO MENU^RMPFUTL
- IF '$DATA(RMPFMENU)
- WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
- QUIT
- +1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- DO ^RMPFUTL
- if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- QUIT
- +2 WRITE @IOF,!!,"PRINT VA FORM 10-2477a"
- TYPE DO SEL
- if $DATA(RMPFOUT)!(Y="")
- GOTO END
- +1 SET RMPFRTN=$SELECT("Bb"[Y:"^RMPFQP2","Oo"[Y:"^RMPFQP3",1:"^RMPFQP4")
- +2 if "Bb"[Y
- GOTO QUE
- IF "Pp"[Y
- DO PAT
- if '$DATA(DFN)
- GOTO END
- GOTO QUE
- +3 DO PAT
- if '$DATA(DFN)!$DATA(RMPFOUT)
- GOTO END
- SET (DX,CX)=0
- +4 FOR I=1:1
- SET DX=$ORDER(^RMPF(791810,"AE",DFN,DX))
- if 'DX
- QUIT
- SET EX=0
- FOR J=1:1
- SET EX=$ORDER(^RMPF(791810,"AE",DFN,DX,EX))
- if 'EX
- QUIT
- SET RMPFX=EX
- SET CX=CX+1
- PAT1 IF CX=0
- WRITE !!,"*** NO ORDERS EXIST FOR THIS PATIENT ***"
- GOTO TYPE
- +1 if CX=1
- GOTO QUE
- SET (RMPFORD,RMPFTP)="P"
- DO ^RMPFDS1
- IF 'RMPFCX
- SET CX=0
- GOTO PAT1
- +2 DO SEL^RMPFDX
- if $DATA(RMPFOUT)
- GOTO END
- if '$DATA(RMPFX)
- GOTO TYPE
- +3 DO QUE
- if $DATA(RMPFOUT)
- GOTO END
- GOTO RMPFSET
- END KILL RMPFRTN,RMPFORD,RMPFTP,RMPFP,RMPFX,RMPFS,RMPFR,RMPFOUT,RMPFQUT
- +1 KILL EX,DX,CX,DFN,RMPFCNT,RMPFO,ZTSK,DISYS,J,I,KX,RMPFHAT
- +2 KILL RMPFCX,RMPFRSTA,ZTRTN,ZTDESC,ZTIO,ZTSAVE,POP,%,%Y,%ZIS,X,Y,%T,C,DIC
- +3 QUIT
- PAT KILL DFN
- WRITE !
- SET DIC=2
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y=-1
- GOTO END
- SET DFN=+Y
- QUIT
- READ KILL RMPFOUT,RMPFQUT
- +1 READ Y:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- READ Y:5
- if Y="."
- GOTO READ
- if '$TEST
- SET Y=U
- +2 IF Y?1"^".E
- SET (RMPFOUT,Y)=""
- QUIT
- +3 if Y?1"?".E
- SET (RMPFQUT,Y)=""
- +4 QUIT
- SEL WRITE !!,"Print an <O>rder, <P>atient data only or a <B>lank Form 10-2477a: "
- +1 DO READ
- if $DATA(RMPFOUT)
- QUIT
- SEL1 IF $DATA(RMPFQUT)
- WRITE !!,"Enter an <O> to select an order to print,",!?7,"a <P> to print only the patient information or",!?7,"a <B> to print a blank Form 10-2477a."
- GOTO SEL
- +1 if Y=""
- QUIT
- SET Y=$EXTRACT(Y,1)
- IF "OoBbPp"'[Y
- SET RMPFQUT=""
- GOTO SEL1
- +2 KILL X
- QUIT
- CHOOSE KILL RMPFX
- if '$DATA(RMPFS)
- GOTO CHE
- +1 FOR I=1:1
- if $Y>21
- QUIT
- WRITE !
- CH1 WRITE !,"Select a Number or <RETURN> to continue: "
- DO READ
- +1 if $DATA(RMPFOUT)
- GOTO CHE
- CH2 IF $DATA(RMPFQUT)
- WRITE !!,"Enter the number to the left of the order or",!?5,"<RETURN> to continue."
- GOTO CH1
- +1 if Y=""
- GOTO CHE
- IF '$DATA(RMPFS(Y))
- SET RMPFQUT=""
- GOTO CH2
- +2 SET RMPFX=RMPFS(Y)
- CHE KILL RMPFS,Y
- QUIT
- QUE WRITE !
- SET %ZIS="NPQ"
- DO ^%ZIS
- if POP
- QUIT
- SET RMPFCNT=1
- +1 IF IO=IO(0)
- IF '$DATA(IO("S"))
- DO @(RMPFRTN)
- QUIT
- +2 IF $DATA(IO("S"))
- SET %ZIS=""
- SET IOP=ION
- DO ^%ZIS
- GOTO @(RMPFRTN)
- NUM WRITE !!,"Number of copies to print: 1// "
- DO READ
- +1 if $DATA(RMPFOUT)
- QUIT
- NUM1 IF $DATA(RMPFQUT)
- WRITE !!,"Enter a number from 1 to 10 for the number of copies to print."
- GOTO NUM
- +1 if Y=""
- SET Y=1
- IF 'Y!(Y<1)!(Y>10)
- SET RMPFQUT=""
- GOTO NUM1
- +2 SET RMPFCNT=$PIECE(Y,".",1)
- +3 SET ZTRTN=RMPFRTN
- SET ZTDESC="FORM 10-2477a"
- SET ZTIO=ION
- SET ZTSAVE("RM*")=""
- SET ZTSAVE("DFN")=""
- +4 DO ^%ZTLOAD
- DO HOME^%ZIS
- if '$DATA(ZTSK)
- QUIT
- +5 if $DATA(ZTSK)
- WRITE !!,"*** Request Queued ***"
- HANG 1
- QUIT
