RMPFDX ;DDC/KAW-STATION 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,!,"STATION ORDER INFORMATION" H 1
LIST S RMPFP="*",(RMPFORD,RMPFTP)="S" D ^RMPFDS1 K RMPFX D SEL:RMPFCX
G END:$D(RMPFOUT)!'$D(RMPFX)
START D DISP,CONT G END:$D(RMPFOUT),START:$D(RMPFX),LIST
END K RMPFO,RMPFP,RMPFORD,RMPFTP,RMPFX,RMPFCX,RMPFOUT,RMPFQUT,RMPFS
K T,J,L,Y,DFN,RMPFERR Q
CONT F I=1:1 Q:$Y>(IOSL-4) W !
W !!,"Type <P>rint,"
I $O(^RMPF(791810,RMPFX,201,0)) W " <M>essages,"
W " <RETURN> to continue or <^> to exit: " D READ K I
I $D(RMPFOUT) K Y Q
I $D(RMPFQUT) D MSG^RMPFDT Q
I Y="" K RMPFX Q
S Y=$E(Y,1) I "Pp"[Y D QUE K RMPFX Q
I "mM"[Y D ^RMPFDT4 K RMPFX Q
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP I IO=IO(0),'$D(IO("S")) D DISP,CONT G QUEE
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G DISP^RMPFDX
S ZTRTN="DISP^RMPFDX",ZTSAVE("RMPF*")="",ZTIO=ION
S ZTDESC="STATION ORDER INFO" D ^%ZTLOAD D HOME^%ZIS
W:$D(ZTSK) !!,"*** Request Queued ***" H 2
QUEE K %,%T,%ZIS,POP,Y1,ZTSK,ZTDESC,ZTRTN,ZTIO,ZTSAVE 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
DISP D ^RMPFDT1
Q
SEL W !!,"Select Order Number or <RETURN> to exit: " D READ
Q:$D(RMPFOUT)
SEL1 I $D(RMPFQUT) W !!,"Type the number of the order you wish to view or <RETURN> to continue." G SEL
Q:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G SEL1
S RMPFX=RMPFS(Y) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDX 1712 printed Apr 09, 2024@21:38:26 Page 2
RMPFDX ;DDC/KAW-STATION 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,!,"STATION ORDER INFORMATION"
HANG 1
LIST SET RMPFP="*"
SET (RMPFORD,RMPFTP)="S"
DO ^RMPFDS1
KILL RMPFX
if RMPFCX
DO SEL
+1 if $DATA(RMPFOUT)!'$DATA(RMPFX)
GOTO END
START DO DISP
DO CONT
if $DATA(RMPFOUT)
GOTO END
if $DATA(RMPFX)
GOTO START
GOTO LIST
END KILL RMPFO,RMPFP,RMPFORD,RMPFTP,RMPFX,RMPFCX,RMPFOUT,RMPFQUT,RMPFS
+1 KILL T,J,L,Y,DFN,RMPFERR
QUIT
CONT FOR I=1:1
if $Y>(IOSL-4)
QUIT
WRITE !
+1 WRITE !!,"Type <P>rint,"
+2 IF $ORDER(^RMPF(791810,RMPFX,201,0))
WRITE " <M>essages,"
+3 WRITE " <RETURN> to continue or <^> to exit: "
DO READ
KILL I
+4 IF $DATA(RMPFOUT)
KILL Y
QUIT
+5 IF $DATA(RMPFQUT)
DO MSG^RMPFDT
QUIT
+6 IF Y=""
KILL RMPFX
QUIT
+7 SET Y=$EXTRACT(Y,1)
IF "Pp"[Y
DO QUE
KILL RMPFX
QUIT
+8 IF "mM"[Y
DO ^RMPFDT4
KILL RMPFX
QUIT
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
IF IO=IO(0)
IF '$DATA(IO("S"))
DO DISP
DO CONT
GOTO QUEE
+1 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO DISP^RMPFDX
+2 SET ZTRTN="DISP^RMPFDX"
SET ZTSAVE("RMPF*")=""
SET ZTIO=ION
+3 SET ZTDESC="STATION ORDER INFO"
DO ^%ZTLOAD
DO HOME^%ZIS
+4 if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
QUEE KILL %,%T,%ZIS,POP,Y1,ZTSK,ZTDESC,ZTRTN,ZTIO,ZTSAVE
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
DISP DO ^RMPFDT1
+1 QUIT
SEL WRITE !!,"Select Order Number or <RETURN> to exit: "
DO READ
+1 if $DATA(RMPFOUT)
QUIT
SEL1 IF $DATA(RMPFQUT)
WRITE !!,"Type the number of the order you wish to view or <RETURN> to continue."
GOTO SEL
+1 if Y=""
QUIT
IF '$DATA(RMPFS(Y))
SET RMPFQUT=""
GOTO SEL1
+2 SET RMPFX=RMPFS(Y)
QUIT
