RMPFDT9 ;DDC/KAW-EXTENDED DISPLAY FOR ROES ORDER [ 06/16/95 3:06 PM ]
;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
;; input: RMPFX
;;output: None
S DFN=$P(^RMPF(791810,RMPFX,0),U,4) G END:'DFN D PAT^RMPFUTL
D HEAD,SET,DISP,CONT:'$D(ZTSK)
END K DFN,RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,X,Y,I,RMPFOUT,RMPFQUT,%XX,%YY
K ZTSK Q
SET ;; input: RMPFX
;;output: EC,ED,EE,ET,EU,SE
S SX=$G(^RMPF(791810,RMPFX,2)),SS=$P(SX,U,2)
S EB=$P(SX,U,4),EU=$S('EB&SS:"DETERMINED FROM DATABASE BY ROES",'EB:"",1:$P(SX,U,3))
I EU,$D(^VA(200,EU,0)) S EU=$P(^(0),U,1)
S ED=$P(SX,U,5) I ED S Y=ED D DD^%DT S ED=Y
S SE=$P(SX,U,6) I SE,$D(^RMPF(791810.4,SE,0)) S SE=$P(^(0),U,1)
S EE=$P(SX,U,7) I EE,$D(^VA(200,EE,0)) S EE=$P(^(0),U,1)
S ET=$P(SX,U,8) I ET S Y=ET D DD^%DT S ET=Y
S EC=$P(SX,U,9),SX=$G(^RMPF(791810,RMPFX,10))
K EB,SX,SS Q
DISP ;; input: EC,ED,EE,ET,EU,SE
;;output: None
W !!,"Eligibility Entered By: ",EU
W !!,"Eligibility Entered On: ",ED
W:EC'="" !!?10,"PSAS Comment: ",EC
I SE'="" D
.W !!!?4,"ASPS Proposed Elig: ",SE
.W !!?6,"Elig Proposed By: ",EE
.W !!?4,"Request to PSAS On: ",ET
I IOST?1"P-".E W @IOF
D:$D(IO("S")) ^%ZISC
K EC,ED,EE,ET,EU,SE Q
HEAD W:'$D(ZTSK) @IOF W !?24,"ROES ORDER EXTENDED INFORMATION"
I $D(RMPFNAM) W !,"Patient: ",$E(RMPFNAM,1,25),?35,"SSN: ",RMPFSSN,?68,RMPFDAT
W ! F I=1:1:80 W "-"
Q
CONT F I=1:1 Q:$Y>20 W !
W !,"Type <RETURN> to continue" W:RMPFMENU=0 ", <L>ine Item View" W " or <P>rint: " D READ
Q:$D(RMPFOUT)
C1 I $D(RMPFQUT) D G CONT
.W !!,"Enter "
.W:RMPFMENU=0 "an <L> to go to the extended line item view",!?6
.W "a <P> to print this screen or",!?6,"<RETURN> to exit."
Q:Y="" S Y=$E(Y,1) I "LlPp"'[Y S RMPFQUT="" G CONT
I "Pp"[Y D QUE Q
I "Ll"[Y,RMPFMENU=0 D ^RMPFDT10 Q
Q
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
I IO=IO(0),'$D(IO("S")) D ^RMPFDT9 G QUEE
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT9
S ZTRTN="^RMPFDT9",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[HRMPFDT9 2251 printed Apr 09, 2024@21:39:11 Page 2
RMPFDT9 ;DDC/KAW-EXTENDED DISPLAY FOR ROES ORDER [ 06/16/95 3:06 PM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
+2 ;; input: RMPFX
+3 ;;output: None
+4 SET DFN=$PIECE(^RMPF(791810,RMPFX,0),U,4)
if 'DFN
GOTO END
DO PAT^RMPFUTL
+5 DO HEAD
DO SET
DO DISP
if '$DATA(ZTSK)
DO CONT
END KILL DFN,RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,X,Y,I,RMPFOUT,RMPFQUT,%XX,%YY
+1 KILL ZTSK
QUIT
SET ;; input: RMPFX
+1 ;;output: EC,ED,EE,ET,EU,SE
+2 SET SX=$GET(^RMPF(791810,RMPFX,2))
SET SS=$PIECE(SX,U,2)
+3 SET EB=$PIECE(SX,U,4)
SET EU=$SELECT('EB&SS:"DETERMINED FROM DATABASE BY ROES",'EB:"",1:$PIECE(SX,U,3))
+4 IF EU
IF $DATA(^VA(200,EU,0))
SET EU=$PIECE(^(0),U,1)
+5 SET ED=$PIECE(SX,U,5)
IF ED
SET Y=ED
DO DD^%DT
SET ED=Y
+6 SET SE=$PIECE(SX,U,6)
IF SE
IF $DATA(^RMPF(791810.4,SE,0))
SET SE=$PIECE(^(0),U,1)
+7 SET EE=$PIECE(SX,U,7)
IF EE
IF $DATA(^VA(200,EE,0))
SET EE=$PIECE(^(0),U,1)
+8 SET ET=$PIECE(SX,U,8)
IF ET
SET Y=ET
DO DD^%DT
SET ET=Y
+9 SET EC=$PIECE(SX,U,9)
SET SX=$GET(^RMPF(791810,RMPFX,10))
+10 KILL EB,SX,SS
QUIT
DISP ;; input: EC,ED,EE,ET,EU,SE
+1 ;;output: None
+2 WRITE !!,"Eligibility Entered By: ",EU
+3 WRITE !!,"Eligibility Entered On: ",ED
+4 if EC'=""
WRITE !!?10,"PSAS Comment: ",EC
+5 IF SE'=""
Begin DoDot:1
+6 WRITE !!!?4,"ASPS Proposed Elig: ",SE
+7 WRITE !!?6,"Elig Proposed By: ",EE
+8 WRITE !!?4,"Request to PSAS On: ",ET
End DoDot:1
+9 IF IOST?1"P-".E
WRITE @IOF
+10 if $DATA(IO("S"))
DO ^%ZISC
+11 KILL EC,ED,EE,ET,EU,SE
QUIT
HEAD if '$DATA(ZTSK)
WRITE @IOF
WRITE !?24,"ROES ORDER EXTENDED INFORMATION"
+1 IF $DATA(RMPFNAM)
WRITE !,"Patient: ",$EXTRACT(RMPFNAM,1,25),?35,"SSN: ",RMPFSSN,?68,RMPFDAT
+2 WRITE !
FOR I=1:1:80
WRITE "-"
+3 QUIT
CONT FOR I=1:1
if $Y>20
QUIT
WRITE !
+1 WRITE !,"Type <RETURN> to continue"
if RMPFMENU=0
WRITE ", <L>ine Item View"
WRITE " or <P>rint: "
DO READ
+2 if $DATA(RMPFOUT)
QUIT
C1 IF $DATA(RMPFQUT)
Begin DoDot:1
+1 WRITE !!,"Enter "
+2 if RMPFMENU=0
WRITE "an <L> to go to the extended line item view",!?6
+3 WRITE "a <P> to print this screen or",!?6,"<RETURN> to exit."
End DoDot:1
GOTO CONT
+4 if Y=""
QUIT
SET Y=$EXTRACT(Y,1)
IF "LlPp"'[Y
SET RMPFQUT=""
GOTO CONT
+5 IF "Pp"[Y
DO QUE
QUIT
+6 IF "Ll"[Y
IF RMPFMENU=0
DO ^RMPFDT10
QUIT
+7 QUIT
QUE WRITE !
SET %ZIS="NPQ"
DO ^%ZIS
if POP
GOTO END
+1 IF IO=IO(0)
IF '$DATA(IO("S"))
DO ^RMPFDT9
GOTO QUEE
+2 IF $DATA(IO("S"))
SET %ZIS=""
SET IOP=ION
DO ^%ZIS
GOTO ^RMPFDT9
+3 SET ZTRTN="^RMPFDT9"
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
