source: FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTL7.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 6.4 KB
Line 
1GMRCSTL7 ;SLC/JFR - DRIVER FOR CSLT PER MONITOR ;4/8/05 10:28
2 ;;3.0;CONSULT/REQUEST TRACKING;**41**;DEC 27, 1997
3 ;
4 Q
5 ;
6EN ; start here
7 K GMRCQUT
8 N DIROUT,DTOUT,DUOUT,DIR,DIRUT,GMRCTMP,GMRCDG,GMRCSVC,GMRCSVNM,GMRCDT1
9 N GMRCDT2,GMRCFMT,GMRCGRP,VALMBCK,GMRCSAVE
10 ;
11 ;Ask for service
12 N Y
13 S DIR(0)="PO^123.5:EMQ",DIR("??")="^D LISTALL^GMRCASV"
14 S DIR("A")="Select Service/Specialty"
15 D ^DIR
16 I Y<1 Q
17 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
18 ;
19 ;Ask for date range
20 D ^GMRCSPD
21 I $D(GMRCQUT) G EXIT
22 ;
23 ; what type of report
24 K DIR,X,Y
25 S DIR(0)="S:O^S:Summary;D:Delimited",DIR("A")="What type of report"
26 D ^DIR
27 I Y="" G EXIT
28 S GMRCFMT=$S(Y="S":"CP",1:"DEL")
29 ;
30 W @IOF
31 S GMRCSAVE("GMRCFMT")=""
32 S GMRCSAVE("GMRCDG")=""
33 S GMRCSAVE("GMRCDT1")=""
34 S GMRCSAVE("GMRCDT2")=""
35 S GMRCSAVE("GMRCSVNM")=""
36 ;
37 D EN^XUTMDEVQ("PRNTQ^GMRCSTL7","CONSULT PERFORMANCE MONITOR",.GMRCSAVE)
38 ;
39 D EXIT
40 ;
41 Q
42 ;
43ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCARRN) ;Entry point
44 ;.RETURN: This is the root to the returned temp array.
45 ;GMRCSVC: Service for which consults are to be displayed.
46 ;GMRCDT1: Starting date or "ALL"
47 ;GMRCDT2: Ending date if not GMRCDT1="ALL"
48 ;GMRCSTAT: The list of status to include separated by commas
49 ;GMRCARRN: Format of report becomes ^TMP array element
50 ; "CP": Summary Report; "DEL": Delimited Report
51 ;
52 ;This temp array is used internally by the report:
53 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
54 ; status is "" tracking and/or grouper
55 ; 1 grouper only
56 ; 2 tracking only
57 ; 9 disabled
58 ;
59 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCGRP,VALMCNT,VALMBCK
60 K ^TMP("GMRCR",$J,GMRCARRN)
61 S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
62 I '($D(GMRCSVC)#2) S GMRCSVC=1
63 Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
64 ;Build service array
65 S GMRCDG=GMRCSVC
66 D SERV1^GMRCASV
67 ;Get external form of date range
68 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
69 S:GMRCDT1="ALL" GMRCDT2=0
70 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
71 ;
72 N GMRCDA,INDEX,STATUS,LOOP,GROUPER
73 N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP,GMRCPT,LINETEMP
74 N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
75 N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
76 ;
77 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
78 ;
79 S GROUPER=0
80 S GROUPER(0)=0
81 I GMRCARRN="DEL" D
82 . N STR
83 . S STR="Service;Total;Unresolved;Complete;Comp w/Results;%Complete;"
84 . S STR=STR_"%Comp w/Results"
85 . S ^TMP("GMRCR",$J,GMRCARRN,1,0)=STR
86 S INDEX=""
87 ;Loop on Service
88 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
89 .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
90 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
91 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
92 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
93 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
94 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"R")=0
95 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"C")=0
96 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
97 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
98 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"R")=0
99 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"C")=0
100 . ;Check if starting a new Grouper
101 . F Q:GROUPER(GROUPER)=GMRCSVCG D
102 ..;End of a group so print the group totals
103 ..I GROUPER(GROUPER)=GMRCSVCG D
104 ... I GMRCARRN="CP" D
105 .... D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
106 ... I GMRCARRN="DEL" D
107 .... D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),GMRCARRN)
108 ..;pop grouper from stack
109 ..S GROUPER=GROUPER-1
110 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
111 ..;push new grouper on stack
112 ..S GROUPER=GROUPER+1
113 ..S GROUPER(GROUPER)=GMRCSVC
114 .;Loop for one status at a time
115 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D
116 .. D ONESTAT^GMRCSTL8(GMRCARRN,INDEX,STATUS,GMRCDT1,GMRCDT2)
117 .F GRP=GROUPER:-1:1 D
118 ..; pending for this service to all of its groupers
119 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
120 .. ; completed w/results for all groupers
121 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"R"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"R")
122 ..; for all status for this service to all of its groupers
123 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
124 .. ; add all completed for all groupers
125 .. S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"C"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"C")
126 .;
127 .;Print the totals for this service that are >0
128 . I GMRCARRN="CP" D
129 .. D PRTTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
130 . I GMRCARRN="DEL" D
131 .. D DELTOT^GMRCSTL8(1,GMRCSVC,GMRCSVCP,GMRCARRN)
132 . Q
133 ;
134 ;Done, so now list the group totals for the top group
135 ;F GROUPER=GROUPER:-1:1 D ; left for looking at all totals in future
136 I $G(GROUPER) S GROUPER=1 D
137 . I GMRCARRN="CP" D
138 .. D PRTTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
139 . I GMRCARRN="DEL" D
140 .. D DELTOT^GMRCSTL8(2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),GMRCARRN)
141 Q
142 ;
143PRNTQ ;Build report and print it
144 ;
145 N GMRCPG,GMRCTMP,IDX,GMRCQUT,TEMP
146 S GMRCPG=1
147 D SERV1^GMRCASV
148 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
149 W !,$J("",23)_"Consult/Request Performance Monitor"
150 S TEMP="FROM: "_$$FMTE^XLFDT(GMRCDT1)_" TO: "_$$FMTE^XLFDT(GMRCDT2)
151 I GMRCDT1="ALL" S TEMP="ALL DATES"
152 W !,$J("",40-($L(TEMP)/2)+.5)_TEMP,!
153 I '$O(^TMP("GMRCSLIST",$J,0)) D G EXIT
154 . W !!,"No records to print"
155 D ENOR^GMRCSTL7(.GMRCTMP,GMRCDG,GMRCDT1,GMRCDT2,"5,6,8,2,9",GMRCFMT)
156 I '$D(^TMP("GMRCR",$J,GMRCFMT)) D
157 . W !!,"No records to print",!
158 S IDX=""
159 F S IDX=$O(^TMP("GMRCR",$J,GMRCFMT,IDX)) Q:'IDX!($G(GMRCQUT)) D
160 . I IOSL-$Y<3 D
161 .. I $E(IOST,1,2)["C-" D
162 ... N DIR S DIR(0)="E" D ^DIR
163 ... I 'Y S GMRCQUT=1
164 .. Q:$G(GMRCQUT)
165 .. D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
166 . Q:$G(GMRCQUT)
167 . W ^TMP("GMRCR",$J,GMRCFMT,IDX,0),!
168 I GMRCFMT="CP",'$G(GMRCQUT) D
169 . Q:$O(^TMP("GMRCTOT",$J,0,""))=""
170 . I IOSL-$Y<6 D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
171 . W !!!,$$REPEAT^XLFSTR("-",IOM-5)
172 . W !,"Consult services with no activity meeting the criteria of this report in",!,"the specified date range:",!
173 . S IDX=""
174 . F S IDX=$O(^TMP("GMRCTOT",$J,0,IDX)) Q:IDX=""!($G(GMRCQUT)) D
175 .. I IOSL-$Y<3 D
176 ... I $E(IOST,1,2)["C-" D
177 .... N DIR S DIR(0)="E" D ^DIR
178 .... I 'Y S GMRCQUT=1
179 ... Q:$G(GMRCQUT)
180 ... D HEAD(GMRCPG) S GMRCPG=GMRCPG+1
181 .. Q:$G(GMRCQUT)
182 .. W ?4,IDX,!
183 D ^%ZISC
184 D EXIT
185 Q
186 ;
187HEAD(PAGE) ; print header for CPM
188 W @IOF
189 W "Consult Performance Monitor",?40,$$HTE^XLFDT($H)
190 W ?73,"Page: ",PAGE,!
191 W $$REPEAT^XLFSTR("-",IOM-2),!
192 Q
193 ;
194EXIT F ARR="GMRCR","GMRCS","GMRCSLIST","GMRCTOT" K ^TMP(ARR,$J)
195 K ARR
196 Q
197 ;
Note: See TracBrowser for help on using the repository browser.