| 1 | RMPFDE ;DDC/KAW-DISPLAY REQUESTS FOR ELIGIBILITY DETERMINATION ;07/06/01 9:25 AM
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**17,18**;07/06/01
|
|---|
| 3 | K RMPFX,RMPRVIEW
|
|---|
| 4 | S RMPFVFG=1
|
|---|
| 5 | D HEAD1
|
|---|
| 6 | D LIST
|
|---|
| 7 | G:$D(RMPFOUT) END
|
|---|
| 8 | G:$D(RMPRVIEW) RMPFDE
|
|---|
| 9 | D LISTOT
|
|---|
| 10 | I RMPFVFG D CONT
|
|---|
| 11 | G:$D(RMPRVIEW) RMPFDE
|
|---|
| 12 | ;G RMPFDE:$D(RMPFX)
|
|---|
| 13 | END K DDH,DFN,DISYS,EL,RD,RX,TT,VA,VADM,VAERR,Y
|
|---|
| 14 | K RMPFOUT,RMPQOUT,I,%XX,%YY,Y Q
|
|---|
| 15 | LIST ;;List active requests for eligibility determination
|
|---|
| 16 | ;; input: None
|
|---|
| 17 | ;;output: RMPFDS1
|
|---|
| 18 | S (RD,TT)=0 K RMPFS1,RMPFX
|
|---|
| 19 | L1 S RD=$O(^RMPF(791810,"AF",RD)) Q:'RD
|
|---|
| 20 | S RX=0
|
|---|
| 21 | L2 S RX=$O(^RMPF(791810,"AF",RD,RX)) G L1:'RX
|
|---|
| 22 | G L2:'$D(^RMPF(791810,RX,0))
|
|---|
| 23 | S DFN=$P(^(0),U,4)
|
|---|
| 24 | D DEM^VADPT S Y=RD
|
|---|
| 25 | D DD^%DT
|
|---|
| 26 | S EL=$P($G(^RMPF(791810,RX,2)),U,6)
|
|---|
| 27 | I EL,$D(^RMPF(791810.4,EL,0)) S EL=$P(^(0),U,1)
|
|---|
| 28 | S TT=TT+1,RMPFS1(TT)=RX
|
|---|
| 29 | I RMPFVFG,$Y>19 D Q:$D(RMPFOUT) Q:$D(RMPRVIEW)
|
|---|
| 30 | .D CONT
|
|---|
| 31 | .Q:$D(RMPFOUT)
|
|---|
| 32 | .D HEAD1
|
|---|
| 33 | I IOST?1"P-".E,$Y>(IOSL-5) D HEAD1
|
|---|
| 34 | W !,$J(TT,2),?4,Y,?24,$E(VADM(1),1,16),?43,$P(VADM(2),U,2),?56,$E(EL,1,24)
|
|---|
| 35 | G L2
|
|---|
| 36 | LISTOT W !!,"Total Orders: ",TT
|
|---|
| 37 | I IOST?1"P-".E W @IOF
|
|---|
| 38 | Q
|
|---|
| 39 | HEAD1 W @IOF,!?17,"ROES ORDERS PENDING ELIGIBILITY DETERMINATION"
|
|---|
| 40 | W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|---|
| 41 | W ! F I=1:1:80 W "-"
|
|---|
| 42 | W !?1,"#",?7,"Request Date",?26,"Patient Name"
|
|---|
| 43 | W ?47,"SSN",?58,"Proposed Eligibility"
|
|---|
| 44 | W !,"--",?4,"------------------",?24,"-----------------"
|
|---|
| 45 | W ?43,"-----------",?56,"------------------------"
|
|---|
| 46 | Q
|
|---|
| 47 | CONT K RMPRVIEW
|
|---|
| 48 | F I=1:1 Q:$Y>19 W !
|
|---|
| 49 | CONT1 W !!,"Type the number of the order to process, <P>rint or <RETURN> to continue: "
|
|---|
| 50 | D READ
|
|---|
| 51 | Q:$D(RMPFOUT)
|
|---|
| 52 | I $D(RMPFQUT) D G CONT1
|
|---|
| 53 | .W !!,"Enter the number to the left of the order to select it for processing"
|
|---|
| 54 | .W !?9,"a <P> to print the list or",!?11,"<RETURN> to continue."
|
|---|
| 55 | Q:Y=""
|
|---|
| 56 | I "Pp"[Y D QUE Q
|
|---|
| 57 | I $D(RMPFS1(Y)) S RMPFX=RMPFS1(Y) D ^RMPFDE1 S RMPRVIEW=""
|
|---|
| 58 | Q
|
|---|
| 59 | QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
|
|---|
| 60 | I IO=IO(0),'$D(IO("S")) S RMPRVIEW="",RMPFVFG=1 G QUEE
|
|---|
| 61 | I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS D G QUEE
|
|---|
| 62 | .S RMPFVFG=0
|
|---|
| 63 | .D HEAD1,LIST,LISTOT
|
|---|
| 64 | .D ^%ZISC
|
|---|
| 65 | .S RMPRVIEW=""
|
|---|
| 66 | .S RMPFVFG=1
|
|---|
| 67 | S RMPFVFG=0
|
|---|
| 68 | S ZTRTN="PRINT^RMPFDE",ZTSAVE("RMPF*")=""
|
|---|
| 69 | S ZTIO=ION D ^%ZTLOAD
|
|---|
| 70 | D HOME^%ZIS S RMPRVIEW="",RMPFVFG=1
|
|---|
| 71 | W:$D(ZTSK) !!,"*** Request Queued ***" H 2
|
|---|
| 72 | QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
|
|---|
| 73 | READ K RMPFOUT,RMPFQUT
|
|---|
| 74 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 75 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 76 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 77 | Q
|
|---|
| 78 | PRINT D HEAD1,LIST,LISTOT Q
|
|---|
