source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDE.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1RMPFDE ;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)
13END K DDH,DFN,DISYS,EL,RD,RX,TT,VA,VADM,VAERR,Y
14 K RMPFOUT,RMPQOUT,I,%XX,%YY,Y Q
15LIST ;;List active requests for eligibility determination
16 ;; input: None
17 ;;output: RMPFDS1
18 S (RD,TT)=0 K RMPFS1,RMPFX
19L1 S RD=$O(^RMPF(791810,"AF",RD)) Q:'RD
20 S RX=0
21L2 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
36LISTOT W !!,"Total Orders: ",TT
37 I IOST?1"P-".E W @IOF
38 Q
39HEAD1 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
47CONT K RMPRVIEW
48 F I=1:1 Q:$Y>19 W !
49CONT1 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
59QUE 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
72QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
73READ 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
78PRINT D HEAD1,LIST,LISTOT Q
Note: See TracBrowser for help on using the repository browser.