RMPFDS2 ;DDC/KAW-DISPLAY ORDERS IN ERROR STATUS [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17**;06/06/01
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)
I RMPFMENU=10,$D(^RMPF(791810,"AF")) D G END:$D(RMPFOUT)
.W $C(7),@IOF,!?15,"*** ROES ***"
.W !?15,"*** ELIGIBILITY DETERMINATIONS AWAITING ACTION ***",!
.D ^RMPFDE
S (X,FL)=0,MU=$O(^RMPF(791810.5,"C",RMPFMENU,0))
G END:'$P(RMPFSYS,U,9),END:'$D(^RMPF(791810,"AC",6))
F S X=$O(^RMPF(791810,"AC",6,X)) Q:'X I $D(^RMPF(791810,X,0)),$P(^(0),U,15)=MU S FL=1 Q
G END:'FL
S RMPFORD="S",RMPFTP="B",RMPFP(6)="" D ^RMPFDS1 G END:$D(RMPFOUT)
D CONT^RMPFDS1
END K X,FL,MU,S0,RMPFORD,RMPFTP,RMPFP,RMPFCX,RMPFDOD,RMPFOUT,RMPFQUT,RMPFS
K SS,%XX,%YY,DFN,I,Y,RMPFOUT,RMPFQUT Q
CONT F Q:$Y>21 W !
W !,"Type <RETURN> to continue." D READ 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
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D ^RMPFDS1,CONT^RMPFDS1 S RMPFOUT="" G QUEE
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDS1
S ZTRTN="^RMPFDS1",ZTSAVE("RMPF*")="",ZTSAVE("DFN")=""
S ZTSAVE("RMPFP(")="",ZTIO=ION D ^%ZTLOAD
D HOME^%ZIS S RMPFOUT=""
W:$D(ZTSK) !!,"*** Request Queued ***" H 2
QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFDS2 1570 printed Dec 13, 2024@02:35:48 Page 2
RMPFDS2 ;DDC/KAW-DISPLAY ORDERS IN ERROR STATUS [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17**;06/06/01
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 IF RMPFMENU=10
IF $DATA(^RMPF(791810,"AF"))
Begin DoDot:1
+3 WRITE $CHAR(7),@IOF,!?15,"*** ROES ***"
+4 WRITE !?15,"*** ELIGIBILITY DETERMINATIONS AWAITING ACTION ***",!
+5 DO ^RMPFDE
End DoDot:1
if $DATA(RMPFOUT)
GOTO END
+6 SET (X,FL)=0
SET MU=$ORDER(^RMPF(791810.5,"C",RMPFMENU,0))
+7 if '$PIECE(RMPFSYS,U,9)
GOTO END
if '$DATA(^RMPF(791810,"AC",6))
GOTO END
+8 FOR
SET X=$ORDER(^RMPF(791810,"AC",6,X))
if 'X
QUIT
IF $DATA(^RMPF(791810,X,0))
IF $PIECE(^(0),U,15)=MU
SET FL=1
QUIT
+9 if 'FL
GOTO END
+10 SET RMPFORD="S"
SET RMPFTP="B"
SET RMPFP(6)=""
DO ^RMPFDS1
if $DATA(RMPFOUT)
GOTO END
+11 DO CONT^RMPFDS1
END KILL X,FL,MU,S0,RMPFORD,RMPFTP,RMPFP,RMPFCX,RMPFDOD,RMPFOUT,RMPFQUT,RMPFS
+1 KILL SS,%XX,%YY,DFN,I,Y,RMPFOUT,RMPFQUT
QUIT
CONT FOR
if $Y>21
QUIT
WRITE !
+1 WRITE !,"Type <RETURN> to continue."
DO READ
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
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO ^RMPFDS1
DO CONT^RMPFDS1
SET RMPFOUT=""
GOTO QUEE
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDS1
+3 SET ZTRTN="^RMPFDS1"
SET ZTSAVE("RMPF*")=""
SET ZTSAVE("DFN")=""
+4 SET ZTSAVE("RMPFP(")=""
SET ZTIO=ION
DO ^%ZTLOAD
+5 DO HOME^%ZIS
SET RMPFOUT=""
+6 if $DATA(ZTSK)
WRITE !!,"*** Request Queued ***"
HANG 2
QUEE KILL %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK
QUIT
