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 Apr 09, 2024@21:38:57 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
