RMPFDT ;DDC/KAW-PATIENT ORDER INFORMATION; [ 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,!!,"PATIENT ORDER INFORMATION"
PAT W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 K DIC S DFN=+Y
ORDERS S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 G END:$D(RMPFOUT),PAT:'RMPFCX
D SEL G END:$D(RMPFOUT),RMPFSET:'$D(RMPFX)
S RMPFHAT="",X=$P(^RMPF(791810,RMPFX,0),U,2) I X,$D(^RMPF(791810.1,X,0)) S RMPFHAT=$P(^(0),U,2)
ORDERS0 D ^RMPFDT1 G END:$D(RMPFOUT)
ORDERS1 D CONT G END:$D(RMPFOUT),ORDERS0:$D(RMPFX),RMPFSET
END K DFN,RMPFORD,RMPFTP,RMPFHAT,Y,RMPFCX,CN,RMPFOUT,RMPFQUT,RMPFX,RMPFO
K DISYS,DIC,%,%Y,C,I,J,X,T,CM,L 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
CONT F I=1:1 Q:$Y>(IOSL-4) W !
W !,"Type <P>rint, E<X>tended"
I $O(^RMPF(791810,RMPFX,201,0)) W ", <M>essages"
I "CIX"[RMPFHAT W ", <H>istory"
I $O(^RMPF(791810,RMPFX,301,0)) W ", <A>uthorized Aids"
W:$X>65 ! W " or <RETURN> to continue: " D READ Q:$D(RMPFOUT)
CONT1 I $D(RMPFQUT) D MSG G CONT1:$D(RMPFQUT) Q
I Y="" K RMPFX Q
S Y=$E(Y,1) I "Mm"[Y D ^RMPFDT4 Q
I "CIX"[RMPFHAT,"Hh"[Y D ^RMPFDT7 Q
I "Aa"[Y D ^RMPFDT8 Q
I "Xx"[Y D ^RMPFDT9 Q
S:Y="p" Y="P" I Y'="P" K I Q
QUE W ! S %ZIS="QNP" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D ^RMPFDT1 D QUEE G CONT
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT1
S ZTRTN="^RMPFDT1",ZTSAVE("RMPF*")="",ZTIO=ION D ^%ZTLOAD
D HOME^%ZIS W:$D(ZTSK) !!,"*** Request Queued ***" H 2
QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
SEL ;;input: RMPFS
;;output: RMPFX
K RMPFX F I=1:1 Q:$Y>20 W !
W !!!,"Enter the number of the order to view detail or <^> to exit. "
D READ G SELE:$D(RMPFOUT)
S1 I $D(RMPFQUT) W !!,"Enter the number to the left of the order you wish to view or",!?5," an <^> to exit." G SEL
G SELE:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G S1
S RMPFX=RMPFS(Y)
SELE K RMPFS,Y,I Q
MSG W !!,"Enter <P> to print this screen"
W:RMPFTP'="S" !?6,"<X> to view the Extended Information Screen"
I $O(^RMPF(791810,RMPFX,201,0)) W !?6,"<M> to view messages for this order"
I $P(^RMPF(791810,RMPFX,0),U,2)=2 W !?6,"<H> to view the history of this order"
W !?6,"<RETURN> to continue."
W !!,"Enter <RETURN> to continue." D READ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDT 2541 printed Sep 15, 2024@21:59:54 Page 2
RMPFDT ;DDC/KAW-PATIENT ORDER INFORMATION; [ 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,!!,"PATIENT ORDER INFORMATION"
PAT WRITE !
SET DIC=2
SET DIC(0)="AEQM"
DO ^DIC
if Y=-1
GOTO END
KILL DIC
SET DFN=+Y
ORDERS SET (RMPFORD,RMPFTP)="P"
DO ^RMPFDS1
if $DATA(RMPFOUT)
GOTO END
if 'RMPFCX
GOTO PAT
+1 DO SEL
if $DATA(RMPFOUT)
GOTO END
if '$DATA(RMPFX)
GOTO RMPFSET
+2 SET RMPFHAT=""
SET X=$PIECE(^RMPF(791810,RMPFX,0),U,2)
IF X
IF $DATA(^RMPF(791810.1,X,0))
SET RMPFHAT=$PIECE(^(0),U,2)
ORDERS0 DO ^RMPFDT1
if $DATA(RMPFOUT)
GOTO END
ORDERS1 DO CONT
if $DATA(RMPFOUT)
GOTO END
if $DATA(RMPFX)
GOTO ORDERS0
GOTO RMPFSET
END KILL DFN,RMPFORD,RMPFTP,RMPFHAT,Y,RMPFCX,CN,RMPFOUT,RMPFQUT,RMPFX,RMPFO
+1 KILL DISYS,DIC,%,%Y,C,I,J,X,T,CM,L
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
CONT FOR I=1:1
if $Y>(IOSL-4)
QUIT
WRITE !
+1 WRITE !,"Type <P>rint, E<X>tended"
+2 IF $ORDER(^RMPF(791810,RMPFX,201,0))
WRITE ", <M>essages"
+3 IF "CIX"[RMPFHAT
WRITE ", <H>istory"
+4 IF $ORDER(^RMPF(791810,RMPFX,301,0))
WRITE ", <A>uthorized Aids"
+5 if $X>65
WRITE !
WRITE " or <RETURN> to continue: "
DO READ
if $DATA(RMPFOUT)
QUIT
CONT1 IF $DATA(RMPFQUT)
DO MSG
if $DATA(RMPFQUT)
GOTO CONT1
QUIT
+1 IF Y=""
KILL RMPFX
QUIT
+2 SET Y=$EXTRACT(Y,1)
IF "Mm"[Y
DO ^RMPFDT4
QUIT
+3 IF "CIX"[RMPFHAT
IF "Hh"[Y
DO ^RMPFDT7
QUIT
+4 IF "Aa"[Y
DO ^RMPFDT8
QUIT
+5 IF "Xx"[Y
DO ^RMPFDT9
QUIT
+6 if Y="p"
SET Y="P"
IF Y'="P"
KILL I
QUIT
QUE WRITE !
SET %ZIS="QNP"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO ^RMPFDT1
DO QUEE
GOTO CONT
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDT1
+3 SET ZTRTN="^RMPFDT1"
SET ZTSAVE("RMPF*")=""
SET ZTIO=ION
DO ^%ZTLOAD
+4 DO HOME^%ZIS
if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
QUEE KILL %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK
QUIT
SEL ;;input: RMPFS
+1 ;;output: RMPFX
+2 KILL RMPFX
FOR I=1:1
if $Y>20
QUIT
WRITE !
+3 WRITE !!!,"Enter the number of the order to view detail or <^> to exit. "
+4 DO READ
if $DATA(RMPFOUT)
GOTO SELE
S1 IF $DATA(RMPFQUT)
WRITE !!,"Enter the number to the left of the order you wish to view or",!?5," an <^> to exit."
GOTO SEL
+1 if Y=""
GOTO SELE
IF '$DATA(RMPFS(Y))
SET RMPFQUT=""
GOTO S1
+2 SET RMPFX=RMPFS(Y)
SELE KILL RMPFS,Y,I
QUIT
MSG WRITE !!,"Enter <P> to print this screen"
+1 if RMPFTP'="S"
WRITE !?6,"<X> to view the Extended Information Screen"
+2 IF $ORDER(^RMPF(791810,RMPFX,201,0))
WRITE !?6,"<M> to view messages for this order"
+3 IF $PIECE(^RMPF(791810,RMPFX,0),U,2)=2
WRITE !?6,"<H> to view the history of this order"
+4 WRITE !?6,"<RETURN> to continue."
+5 WRITE !!,"Enter <RETURN> to continue."
DO READ
+6 QUIT
