source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTU.m@ 613

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1GMRCSTU ;SLC/DCM,dee - Statistic Utilities for C/RT ;09/26/02 10:16
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,7,29,30,43,61**;DEC 27, 1997;Build 2
3 Q
4 ;
5GETDT(GMRCO) ;get the date that the consult/request was accepted by service
6 N ND,GMRCDA
7 S COMPLDT=9999999
8 S ND=0 F S ND=$O(^GMR(123,GMRCO,40,ND)) Q:ND?1A.E!(ND="") D
9 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=21 GMRCDA=$P(^(0),"^",1)
10 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=1 GMRCDA(1)=$P(^(0),"^",1)
11 .S:$P(^GMR(123,GMRCO,40,ND,0),"^",2)=15 GMRCDA(15)=$P(^(0),"^",3)
12 .I $P(^GMR(123,GMRCO,40,ND,0),"^",2)=10,$P(^(0),"^",3)<COMPLDT S COMPLDT=$P(^(0),"^",3)
13 S RCVDT=$S($D(GMRCDA)#2:GMRCDA,$D(GMRCDA(1)):GMRCDA(1),$D(GMRCDA(15)):GMRCDA(15),1:$P(^GMR(123,GMRCO,0),"^",1))
14 Q
15EN ;
16 K ^TMP("GMRCSLIST",$J),GMRCQUT
17 ;Get the service/grouper
18 D ASRV^GMRCASV
19 G:$D(GMRCQUT) KILL
20 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
21 ;Get the date range
22 D ^GMRCSPD
23 G:$D(GMRCQUT) KILL
24 Q
25 ;
26ENOR(RETURN,GMRCSRVC,GMRCDT1,GMRCDT2) ;Entry point for GUI interface.
27 ;.RETURN: This is the root to the returned temp array.
28 ;GMRCSRVC: Service for which consults are to be displayed.
29 ;GMRCDT1: Starting date or "ALL"
30 ;GMRCDT2: Ending date if not GMRCDT1="ALL"
31 ;
32 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
33 ; status is "" tracking and/or grouper
34 ; 1 grouper only
35 ; 2 tracking only
36 ; 9 disabled
37 ;
38 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
39 N GMRCWRIT
40 S GMRCWRIT=0
41 K ^TMP("GMRCR",$J,"PRL")
42 S RETURN="^TMP(""GMRCR"",$J,""PRL"")"
43 I '($D(GMRCSRVC)#2) S GMRCSRVC=1
44 Q:'$D(^GMR(123.5,$G(GMRCSRVC),0))
45 ;Build service array
46 S GMRCDG=GMRCSRVC
47 D SERV1^GMRCASV
48 ;Get external form of date range
49 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
50 S:GMRCDT1="ALL" GMRCDT2=0
51 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
52 G ODTSTR
53 ;
54ODT ;List Manager entry point
55 N GMRCWRIT
56 S GMRCWRIT=1
57 D WAIT^DICD
58 ;
59ODTSTR ;Find the mean, standard deviation of how long to complete a consult from when it is accepted in the service to when it is complete
60 N RCVDT,COMPLDT,INDEX,TEMPTMP,GROUPER,TAB
61 N GMRCDG,GMRCDGT,GMRCDT,GMRCDTP
62 N GMRCGRP,GMRCND,GMRCO,ND,X,X1,X2,X3,X4
63 S GMRCDTP=GMRCDT2
64 S GMRCDT2=GMRCDT2+1
65 I '$O(^TMP("GMRCSLIST",$J,0)) S GMRCQUT=1 G KILL
66 S INDEX=0
67 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
68 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
69 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
70 .S ^TMP("GMRCSVC",$J,1,ND,"T")="0^0^0^0^0^0"
71 .S ^TMP("GMRCSVC",$J,1,ND,"I")="0^0^0^0^0"
72 .S ^TMP("GMRCSVC",$J,1,ND,"O")="0^0^0^0^0"
73 .S ^TMP("GMRCSVC",$J,1,ND,"U")="0^0^0^0^0"
74 .S ^TMP("GMRCSVC",$J,2,ND,"T")="0^0^0^0^0^0"
75 .S ^TMP("GMRCSVC",$J,2,ND,"I")="0^0^0^0^0"
76 .S ^TMP("GMRCSVC",$J,2,ND,"O")="0^0^0^0^0"
77 .S ^TMP("GMRCSVC",$J,2,ND,"U")="0^0^0^0^0"
78 S GMRCND=0
79 S INDEX=""
80 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX),-1) Q:INDEX="" D
81 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
82 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
83 .Q:$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)>0
84 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",5)'=1 D
85 ..S GMRCDT=""
86 ..F S GMRCDT=$O(^GMR(123,"AE",ND,2,GMRCDT)) Q:GMRCDT="" D
87 ...S GMRCO=0
88 ...F S GMRCO=$O(^GMR(123,"AE",ND,2,GMRCDT,GMRCO)) Q:GMRCO="" D W:GMRCWRIT&'(GMRCND#25) "."
89 ....D GETDT(GMRCO)
90 ....I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
91 .....S X1=COMPLDT
92 .....S X2=RCVDT
93 .....D ^%DTC
94 .....IF X=0 D
95 ......S X=$$FMDIFF^XLFDT(COMPLDT,RCVDT,3)
96 ......S X=+$P(X," ",2)/24
97 ......S X3=$E(X,1,3)
98 ......S X4=$E(X,4)
99 ......S:X4>4 X3=X3+.01
100 ......S X=X3
101 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),U)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),U)+X
102 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",2)+1
103 .....S $P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"T"),"^",3)+(X*X)
104 .....I $P(^GMR(123,GMRCO,0),"^",18)="I" D
105 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",1)+X
106 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",2)+1
107 ......S $P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"I"),"^",3)+(X*X)
108 .....E I $P(^GMR(123,GMRCO,0),"^",18)="O" D
109 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",1)+X
110 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",2)+1
111 ......S $P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"O"),"^",3)+(X*X)
112 .....E D
113 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",1)+X
114 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",2)+1
115 ......S $P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)=$P(^TMP("GMRCSVC",$J,1,ND,"U"),"^",3)+(X*X)
116 .....S GMRCND=GMRCND+1
117 .D PARENTS^GMRCSTU1(ND,+$P(^TMP("GMRCSLIST",$J,INDEX),"^",3))
118 S ND=0
119STAT ;Do the statistics
120 F S ND=$O(^TMP("GMRCSVC",$J,2,ND)) Q:ND="" D
121 .I $P($G(^TMP("GMRCSVC",$J,1,ND,"T")),"^",1)>0 D DOSTAT^GMRCSTU1(1,ND)
122 .I $P(^TMP("GMRCSVC",$J,2,ND,"T"),"^",1)>0 D DOSTAT^GMRCSTU1(2,ND)
123 K ^TMP("GMRCR",$J,"PRL")
124 S GMRCCT=0
125 S GMRCDT2=GMRCDTP ;reset date value to print report heading
126 D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
127 S TAB=""
128 S $P(TAB," ",40)=""
129 S GMRCCT=GMRCCT+1
130 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,19)_"Consult/Request Completion Time Statistics"
131 S GMRCCT=GMRCCT+1
132 S TEMPTMP="FROM: "_GMRCEDT1_" TO: "_GMRCEDT2
133 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-($L(TEMPTMP)/2))_TEMPTMP
134 S GMRCCT=GMRCCT+1
135 S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
136 S INDEX=0
137 S GROUPER=0
138 S GROUPER(0)=0
139 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
140 .S ND=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
141 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9&'$D(^TMP("GMRCSVC",$J,2,ND))
142 .F Q:GROUPER(GROUPER)=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3) D
143 ..;End of a group so print the group totals
144 ..D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
145 ..;pop grouper from stack
146 ..S GROUPER=GROUPER-1
147 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
148 ..;Start of a new group so print the group heading.
149 ..S GMRCCT=GMRCCT+1
150 ..S TEMPTMP="GROUPER: "_$P(^GMR(123.5,ND,0),"^",1)
151 ..S:$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)>0 TEMPTMP=TEMPTMP_" in Group: "_$P(^GMR(123.5,$P(^TMP("GMRCSLIST",$J,INDEX),"^",3),0),"^",1)
152 ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=$E(TAB,1,40-(($L(TEMPTMP)/2)+.5))_TEMPTMP
153 ..S GMRCCT=GMRCCT+1
154 ..S ^TMP("GMRCR",$J,"PRL",GMRCCT,0)=""
155 ..;push new grouper on stack
156 ..S GROUPER=GROUPER+1
157 ..S GROUPER(GROUPER)=ND
158 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=1
159 .Q:$P(^TMP("GMRCSLIST",$J,INDEX),"^",5)=9
160 .D SERVSTAT^GMRCSTU1(.GMRCCT,1,ND,GROUPER(GROUPER))
161 ;Now list the group totals for the current groups.
162 F GROUPER=GROUPER:-1:1 D
163 .;End of a group so print the group totals
164 .D SERVSTAT^GMRCSTU1(.GMRCCT,2,GROUPER(GROUPER),GROUPER(GROUPER))
165 ;Done building list.
166 S VALMCNT=GMRCCT,VALMBCK="R"
167KILL ;kill variables and exit
168 S:$D(GMRCQUT) VALMBCK="Q"
169 K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
170 Q
171PRNT ;print statistics to a printer
172 ;Called from a List Manager action
173 Q:'$D(^TMP("GMRCR",$J,"PRL",2,0))
174 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
175 D PRNTASK
176 D PRNTIT("PRL","PRNTQ^GMRCSTU","CONSULT/REQUEST PACKAGE PRINT COMPLETION TIME STATISTICS FROM LIST MANAGER DISPLAY")
177 Q
178 ;
179PRNTASK ;Ask for device
180 N POP,%ZIS
181 K GMRCQUT
182 S POP=0
183 S %ZIS="MQ"
184 D ^%ZIS
185 I POP D Q
186 .S GMRCMSG="Printer Busy. Try Again Later."
187 .D EXAC^GMRCADC(GMRCMSG)
188 .K GMRCMSG
189 .S GMRCQUT=1
190 Q
191 ;
192PRNTIT(TMPNAME,QUERTN,QUEDESC) ;Send list to printer
193 N ANSWER,INDEX,DOLLARH,ZTRTN,ZTDESC
194 I $D(IO("Q")) D Q
195 .S DOLLARH=$H
196 .M ^XTMP("GMRCR","$"_$J,DOLLARH,"PRINT")=^TMP("GMRCR",$J,TMPNAME)
197 .S ZTRTN=QUERTN
198 .S ZTDESC=QUEDESC
199 .S ZTSAVE("J")="$"_$J
200 .S ZTSAVE("DOLLARH")=""
201 .S ZTSAVE("TMPNAME")=""
202 .S ZTSAVE("GMRCDG")=""
203 .S ZTSAVE("GMRCDT1")=""
204 .S ZTSAVE("GMRCDT2")=""
205 .D ^%ZTLOAD,^%ZISC
206 .K ZTSAVE
207 .S VALMBCK="R"
208 U IO
209 S ANSWER=""
210 S INDEX=""
211 F S INDEX=$O(^TMP("GMRCR",$J,TMPNAME,INDEX)) Q:INDEX="" W ^TMP("GMRCR",$J,TMPNAME,INDEX,0),! I IOST["C-",$S($D(IOSL)#2:$Y>(IOSL-2),1:$Y>22) R "Press <ENTER> To Continue, '^' To Quit: ",ANSWER:DTIME Q:'$T!(ANSWER["^") W @IOF
212 I ANSWER'["^",IOST["C-",$Y>1 R !,"Press <ENTER> To Continue: ",ANSWER:DTIME
213 U IO(0)
214 D ^%ZISC
215 S VALMBCK="R"
216 Q
217 ;
218PRNTQ ;Print Queued report from ^XTMP global then kill off ^XTMP
219 N INDEX
220 U IO
221 S INDEX=""
222 F S INDEX=$O(^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX)) Q:INDEX="" W ^XTMP("GMRCR",J,DOLLARH,"PRINT",INDEX,0),!
223 K ^XTMP("GMRCR",J,DOLLARH,"PRINT"),J,DOLLARH
224 D ^%ZISC
225 Q
Note: See TracBrowser for help on using the repository browser.