79 lines
2.3 KiB
Mathematica
79 lines
2.3 KiB
Mathematica
RMPFDE ;DDC/KAW-DISPLAY REQUESTS FOR ELIGIBILITY DETERMINATION ;07/06/01 9:25 AM
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17,18**;07/06/01
|
|
K RMPFX,RMPRVIEW
|
|
S RMPFVFG=1
|
|
D HEAD1
|
|
D LIST
|
|
G:$D(RMPFOUT) END
|
|
G:$D(RMPRVIEW) RMPFDE
|
|
D LISTOT
|
|
I RMPFVFG D CONT
|
|
G:$D(RMPRVIEW) RMPFDE
|
|
;G RMPFDE:$D(RMPFX)
|
|
END K DDH,DFN,DISYS,EL,RD,RX,TT,VA,VADM,VAERR,Y
|
|
K RMPFOUT,RMPQOUT,I,%XX,%YY,Y Q
|
|
LIST ;;List active requests for eligibility determination
|
|
;; input: None
|
|
;;output: RMPFDS1
|
|
S (RD,TT)=0 K RMPFS1,RMPFX
|
|
L1 S RD=$O(^RMPF(791810,"AF",RD)) Q:'RD
|
|
S RX=0
|
|
L2 S RX=$O(^RMPF(791810,"AF",RD,RX)) G L1:'RX
|
|
G L2:'$D(^RMPF(791810,RX,0))
|
|
S DFN=$P(^(0),U,4)
|
|
D DEM^VADPT S Y=RD
|
|
D DD^%DT
|
|
S EL=$P($G(^RMPF(791810,RX,2)),U,6)
|
|
I EL,$D(^RMPF(791810.4,EL,0)) S EL=$P(^(0),U,1)
|
|
S TT=TT+1,RMPFS1(TT)=RX
|
|
I RMPFVFG,$Y>19 D Q:$D(RMPFOUT) Q:$D(RMPRVIEW)
|
|
.D CONT
|
|
.Q:$D(RMPFOUT)
|
|
.D HEAD1
|
|
I IOST?1"P-".E,$Y>(IOSL-5) D HEAD1
|
|
W !,$J(TT,2),?4,Y,?24,$E(VADM(1),1,16),?43,$P(VADM(2),U,2),?56,$E(EL,1,24)
|
|
G L2
|
|
LISTOT W !!,"Total Orders: ",TT
|
|
I IOST?1"P-".E W @IOF
|
|
Q
|
|
HEAD1 W @IOF,!?17,"ROES ORDERS PENDING ELIGIBILITY DETERMINATION"
|
|
W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|
W ! F I=1:1:80 W "-"
|
|
W !?1,"#",?7,"Request Date",?26,"Patient Name"
|
|
W ?47,"SSN",?58,"Proposed Eligibility"
|
|
W !,"--",?4,"------------------",?24,"-----------------"
|
|
W ?43,"-----------",?56,"------------------------"
|
|
Q
|
|
CONT K RMPRVIEW
|
|
F I=1:1 Q:$Y>19 W !
|
|
CONT1 W !!,"Type the number of the order to process, <P>rint or <RETURN> to continue: "
|
|
D READ
|
|
Q:$D(RMPFOUT)
|
|
I $D(RMPFQUT) D G CONT1
|
|
.W !!,"Enter the number to the left of the order to select it for processing"
|
|
.W !?9,"a <P> to print the list or",!?11,"<RETURN> to continue."
|
|
Q:Y=""
|
|
I "Pp"[Y D QUE Q
|
|
I $D(RMPFS1(Y)) S RMPFX=RMPFS1(Y) D ^RMPFDE1 S RMPRVIEW=""
|
|
Q
|
|
QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
|
|
I IO=IO(0),'$D(IO("S")) S RMPRVIEW="",RMPFVFG=1 G QUEE
|
|
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS D G QUEE
|
|
.S RMPFVFG=0
|
|
.D HEAD1,LIST,LISTOT
|
|
.D ^%ZISC
|
|
.S RMPRVIEW=""
|
|
.S RMPFVFG=1
|
|
S RMPFVFG=0
|
|
S ZTRTN="PRINT^RMPFDE",ZTSAVE("RMPF*")=""
|
|
S ZTIO=ION D ^%ZTLOAD
|
|
D HOME^%ZIS S RMPRVIEW="",RMPFVFG=1
|
|
W:$D(ZTSK) !!,"*** Request Queued ***" H 2
|
|
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
|
|
PRINT D HEAD1,LIST,LISTOT Q
|