source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDE2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1RMPFDE2 ;DDC/PJU - R3 DISPLAY ELIG REQUESTS ;7/8/04
2 ;;3.0;REMOTE ORDER/ENTRY SYSTEM;**1**;11/1/02
3 ;SETUP OPTION RMPFDE2 IN THE OPTION FILE TO ACCESS THIS ROUTINE.
4LIST(RMLIST) ;FUNCTION RETURNING LIST OF ELIG AWAITING APPROVAL IN RMLIST
5 ;TAKE FROM ^RMPF(791814,"C",2,DA)
6 ;RMPFVFLG = 1 to see CONT/Actions,, 0 to list w/o interaction
7 ;ND=node,TT=line num, CT=counter,NM=DFN name,EL=sugg elig, RD=request date
8 ;RQ=REQUESTER DUZ, RN=REQUESTER NAME, RMPFX is selected node for action
9 N CT,DFN,EL,EXIT,I,IEN,NM,RD,RN,RMMSG,RMPFX,RQ,S0,S1,S2,SSN,TT,Y
10REPT K RMLIST,RMPFS1 S RMPFVFLG=1,EXIT=0
11 D GETLIST
12 D SORT
13 G:'$G(TT) END ;no entries left
14 G END:EXIT=1 ;chose quit
15 G REPT
16END K RMLIST,RMPFS1,RMPFVFLG,VADM,VAERR Q
17 ;
18GETLIST ;
19 S (CT,IEN,TT)=0,RMPFS1(0)=""
20L1 S IEN=$O(^RMPF(791814,"C",2,IEN))
21 Q:'IEN
22 I '$D(^RMPF(791814,IEN)) D G L1 ;BAD ENTRY IN XREF
23 .K ^RMPF(791814,"C",2,IEN)
24 S S0=$G(^RMPF(791814,IEN,0))
25 S S1=$G(^RMPF(791814,IEN,1))
26 S S2=$G(^RMPF(791814,IEN,2))
27 S DFN=$P(S0,U,1)
28 D DEM^VADPT
29 G:$G(VAERR) L1 ;error
30 S NM=VADM(1)
31 S SSN=$P(VADM(2),U,1)
32 S EL=$P(S1,U,1) ;suggested eligibility
33 S RMMSG=$P(S1,U,2) ;msg #
34 S RD=$P(S0,U,2) ;REQUEST date
35 S RQ=$P(S0,U,3) ;requestor DUZ
36 S CT=CT+1
37 S RMPFS1(RD,CT)=NM_U_SSN_U_EL_U_DFN_U_RQ_U_RMMSG_U_IEN ;keep in chron order, use TT to sort
38 K VADM G L1
39SORT ;create a sorted list by entry date with a ctr subscript (may be mult on date)
40 S (RD,CT)=0 F D Q:'RD
41 .S RD=$O(RMPFS1(RD)) Q:'RD S CT=0 D
42 ..F S CT=$O(RMPFS1(RD,CT)) Q:'CT D
43 ...S TT=TT+1 S RMLIST(TT)=RD_U_RMPFS1(RD,CT)
44 ..;RMLIST(TT)=req dt^pat name^pat SSN^sug el^dfn^req DUZ^MSG#^IEN
45 ;
46PRT D HEAD1 ;now print list
47 I 'TT W !!,"NO REQUESTS TO REPORT" Q
48 S CT=0
49 F S CT=$O(RMLIST(CT)) Q:'CT D Q:$G(EXIT)=1
50 .W !,CT,?4,$$FMTE^XLFDT($P(RMLIST(CT),U,1)),?24,$P(RMLIST(CT),U,2)
51 .S SSN=$P(RMLIST(CT),U,3)
52 .W ?43,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9),?56,$P(RMLIST(CT),U,4)
53 .I $G(RMPFVFLG)=1,CT#15=0 D CONT Q:$G(EXIT)=1 ;repeat command line if list long
54 ;
55LISTOT Q:$G(EXIT)=1
56 W !!,"Total Orders: ",TT
57 D:$G(RMPFVFLG)=1 CONT
58 D KILL^XM
59 Q
60HEAD1 W @IOF,!?17,"ROES REQUESTS FOR ELIGIBILITY DETERMINATION"
61 W:$G(RMPFVFLG)'=1 !,?68,$$FMTE^XLFDT(DT)
62 W ! F I=1:1:80 W "-"
63 W !?1,"#",?7,"Request Date",?26,"Patient Name"
64 W ?47,"SSN",?58,"Proposed Eligibility"
65 W !,"--",?4,"------------------",?24,"-----------------"
66 W ?43,"-----------",?56,"------------------------"
67 Q
68CONT ;EOL actions
69 Q:$G(RMPFVFLG)=0 ;printing
70 F I=1:1 Q:$Y>19 W !
71CONT1 W !!,"Type the NUMBER of the request, <P>rint "
72 W:CT<15 "or " W:CT>14 ","
73 W "<Q>uit('^') the option"
74 I CT>14 W " or <RETURN> to continue: "
75 E W ": "
76 D READ
77 I $D(RMPFOUT) S EXIT=1 G CONTE
78 I $D(RMPFQUT) D G CONT1
79 .W !!,"Enter the number to the left of the request to select it for processing"
80 .W !?9,"a <P> to print the list, <Q> or '^' to quit the list, or"
81 .W !?11,"<RETURN> to continue in list."
82 I Y="" D HEAD1 G CONTE
83 I "Pp"[$E(Y,1) D QUE G CONTE
84 I "Qq"[$E(Y,1) S EXIT=1 G CONTE
85 I $D(RMLIST(Y)) S RMPFX=RMLIST(Y) D
86 .D DISPLINE^RMPFDE3 ;display inf
87CONTE Q
88QUE W ! S %ZIS="NPQ" D ^%ZIS G QUEE:POP
89 I IO=IO(0),'$D(IO("S")) S RMPFVFLG=1 G QUEE
90 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS D G QUEE ;SLAVE PRINT
91 .S RMPFVFLG=0
92 .D PRT
93 .D ^%ZISC
94 .D HOME^%ZIS
95 .S RMPFVFLG=1
96 S RMPFVFLG=0 ;NON-SLAVE PRINT
97 S ZTDTH=$H,ZTRTN="PRT^RMPFDE2",ZTSAVE("TT")=""
98 S ZTSAVE("RM*")=""
99 S ZTIO=ION D ^%ZTLOAD
100 D HOME^%ZIS S RMPFVFLG=1
101 W:$D(ZTSK) !!,"*** Request Queued ***" H 2
102 ;
103QUEE K POP,ZTRTN,ZTSAVE,ZTIO,ZTSK
104 Q
105READ K RMPFOUT,RMPFQUT
106 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
107 I Y?1"^".E S (RMPFOUT,Y)="" Q
108 S:Y?1"?".E (RMPFQUT,Y)=""
109 Q
110PRINT D HEAD1,LIST,LISTOT Q
Note: See TracBrowser for help on using the repository browser.