- 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 Mar 13, 2025@21:40:55 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
