RMPFDM ;DDC/KAW-DISPLAY SYSTEM STATUS [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;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,!?24,"REMOTE ORDER/ENTRY SYSTEM STATUS"
W !,"Station: ",RMPFSTAP,?68,RMPFDAT,!
F I=1:1:80 W "-"
W !!,?31,"Current",?60,"Messages"
W !?6,"Order Status",?31,"Number",?43,"Oldest Date",?60,"To Read"
W !,"-------------------------",?30,"--------",?43,"------------",?60,"--------",!
S ST=0
S1 S ST=$O(^RMPF(791810,"AC",ST)) G R3:'ST S (RMPFX,CT,DX)=0,RMPFMGG=""
S SP="" I $D(^RMPF(791810.2,ST,0)) S SP=$P(^(0),U,1)
S2 S RMPFX=$O(^RMPF(791810,"AC",ST,RMPFX)) I 'RMPFX D WRITE G S1
G S2:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0)
S X=$P(S0,U,15) S:X="" X=0 G S2:X'=$O(^RMPF(791810.5,"C",RMPFMENU,0))
G S2:$P($P($G(^RMPF(791810,RMPFX,"STA")),U,1)," - ",1)'=$P(RMPFSTAP," - ",1) S CT=CT+1
S D=$P(S0,".",1) S:'DX DX=D I D<DX S DX=D
S X=0 F I=1:1 S X=$O(^RMPF(791810,RMPFX,201,X)) Q:'X S Y=0 F J=1:1 S Y=$O(^RMPF(791810,RMPFX,201,X,101,Y)) Q:'Y I $D(^(Y,0)),'$P(^(0),U,6) S RMPFMGG="***" Q
G S2
R3 I IOST?1"P-".E W @IOF G END
F I=1:1 Q:$Y>21 W !
W !,"Enter <P>rint or <RETURN> to continue." D READ G END:Y=""
S Y=$E(Y,1) I "Pp"[Y D QUE
END K US,PT,MG,NM,CT,LD,I,D,SP,ST,DX,Y,RMPFX,RMPFS,RMPFOUT,RMPFQUT,X
K RMPFMGG,J Q
WRITE Q:'CT S LD="",Y=DX I Y D DD^%DT S LD=Y
W !,SP,?30,$J(CT,8),?43,LD,?63,$S(RMPFMGG'="":"YES",1:"NO")
Q
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D ^RMPFDM G QUEE
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDM
S ZTRTN="^RMPFDM",ZTSAVE("RMPF*")=""
S ZTIO=ION D ^%ZTLOAD
D HOME^%ZIS S RMPFOUT=""
W:$D(ZTSK) !!,"*** Request Queued ***" H 1
QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDM 2074 printed Apr 09, 2024@21:39:23 Page 2
RMPFDM ;DDC/KAW-DISPLAY SYSTEM STATUS [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;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,!?24,"REMOTE ORDER/ENTRY SYSTEM STATUS"
+3 WRITE !,"Station: ",RMPFSTAP,?68,RMPFDAT,!
+4 FOR I=1:1:80
WRITE "-"
+5 WRITE !!,?31,"Current",?60,"Messages"
+6 WRITE !?6,"Order Status",?31,"Number",?43,"Oldest Date",?60,"To Read"
+7 WRITE !,"-------------------------",?30,"--------",?43,"------------",?60,"--------",!
+8 SET ST=0
S1 SET ST=$ORDER(^RMPF(791810,"AC",ST))
if 'ST
GOTO R3
SET (RMPFX,CT,DX)=0
SET RMPFMGG=""
+1 SET SP=""
IF $DATA(^RMPF(791810.2,ST,0))
SET SP=$PIECE(^(0),U,1)
S2 SET RMPFX=$ORDER(^RMPF(791810,"AC",ST,RMPFX))
IF 'RMPFX
DO WRITE
GOTO S1
+1 if '$DATA(^RMPF(791810,RMPFX,0))
GOTO S2
SET S0=^(0)
+2 SET X=$PIECE(S0,U,15)
if X=""
SET X=0
if X'=$ORDER(^RMPF(791810.5,"C",RMPFMENU,0))
GOTO S2
+3 if $PIECE($PIECE($GET(^RMPF(791810,RMPFX,"STA")),U,1)," - ",1)'=$PIECE(RMPFSTAP," - ",1)
GOTO S2
SET CT=CT+1
+4 SET D=$PIECE(S0,".",1)
if 'DX
SET DX=D
IF D<DX
SET DX=D
+5 SET X=0
FOR I=1:1
SET X=$ORDER(^RMPF(791810,RMPFX,201,X))
if 'X
QUIT
SET Y=0
FOR J=1:1
SET Y=$ORDER(^RMPF(791810,RMPFX,201,X,101,Y))
if 'Y
QUIT
IF $DATA(^(Y,0))
IF '$PIECE(^(0),U,6)
SET RMPFMGG="***"
QUIT
+6 GOTO S2
R3 IF IOST?1"P-".E
WRITE @IOF
GOTO END
+1 FOR I=1:1
if $Y>21
QUIT
WRITE !
+2 WRITE !,"Enter <P>rint or <RETURN> to continue."
DO READ
if Y=""
GOTO END
+3 SET Y=$EXTRACT(Y,1)
IF "Pp"[Y
DO QUE
END KILL US,PT,MG,NM,CT,LD,I,D,SP,ST,DX,Y,RMPFX,RMPFS,RMPFOUT,RMPFQUT,X
+1 KILL RMPFMGG,J
QUIT
WRITE if 'CT
QUIT
SET LD=""
SET Y=DX
IF Y
DO DD^%DT
SET LD=Y
+1 WRITE !,SP,?30,$JUSTIFY(CT,8),?43,LD,?63,$SELECT(RMPFMGG'="":"YES",1:"NO")
+2 QUIT
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO ^RMPFDM
GOTO QUEE
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDM
+3 SET ZTRTN="^RMPFDM"
SET ZTSAVE("RMPF*")=""
+4 SET ZTIO=ION
DO ^%ZTLOAD
+5 DO HOME^%ZIS
SET RMPFOUT=""
+6 if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 1
QUEE KILL %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK
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
