source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSTLM.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: 9.3 KB
Line 
1GMRCSTLM ;SLC/DCM,dee,MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;11/21/02 05:29
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,7,21,23,22,29**;DEC 27, 1997
3 ; Patch #21 added a initialization KILL for ^TMP("GMRCTOT",$J)
4 ; Patch #23 remove the default prompt "ALL SERVICES"
5 Q
6 ;
7EN ;Ask for new service and date range
8 K GMRCQUT
9 N DIROUT,DTOUT,DUOUT,DIR
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 S VALMBCK="Q" Q
17 S GMRCDG=+Y,GMRCSVNM=$P(Y,U,2)
18 D SERV1^GMRCASV
19 I '$O(^TMP("GMRCSLIST",$J,0)) S VALMBCK="Q" Q
20 ;
21 ;Ask for date range
22 D ^GMRCSPD
23 I $D(GMRCQUT) S VALMBCK="Q" G EXIT
24 D LISTDATE^GMRCSTU1(GMRCDT1,GMRCDT2,.GMRCEDT1,.GMRCEDT2)
25 Q
26 ;
27ENOR(RETURN,GMRCSVC,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCCTRL,GMRCARRN) ;Entry point for GUI interface.
28 ;.RETURN: This is the root to the returned temp array.
29 ;GMRCSVC: Service for which consults are to be displayed.
30 ;GMRCDT1: Starting date or "ALL"
31 ;GMRCDT2: Ending date if not GMRCDT1="ALL"
32 ;GMRCSTAT: The list of status to include separated by commas
33 ;GMRCCTRL: 0, null or not define then just the display list is
34 ; displayed
35 ; 1 then the list will be two pieces with the first piece
36 ; being the ien of the consult for selection in the gui
37 ; and the second piece being the display text.
38 ; 10 then the consults will have a line number on them for
39 ; selection
40 ; 20 then the consults will have the consult number displayed
41 ; 100 then use abbreviations for the statuses
42 ; 1, (10 or 20) and 100 can be added together to add there features
43 ;GMRCARRN: List Template Array Name
44 ; "CP": pending; "IFC": inter-facility
45 ;
46 ;This temp array is used internally by the report:
47 ;^TMP("GMRCSLIST",$J,n)=ien^name^parient ien^"+" if grouper^status
48 ; status is "" tracking and/or grouper
49 ; 1 grouper only
50 ; 2 tracking only
51 ; 9 disabled
52 ;
53 N GMRCEDT1,GMRCEDT2,GMRCDG,GMRCHEAD,GMRCCT,GMRCGRP,VALMCNT,VALMBCK
54 K ^TMP("GMRCR",$J,GMRCARRN)
55 S RETURN="^TMP(""GMRCR"",$J,GMRCARRN)"
56 I '($D(GMRCSVC)#2) S GMRCSVC=1
57 Q:'$D(^GMR(123.5,$G(GMRCSVC),0))
58 ;Build service array
59 S GMRCDG=GMRCSVC
60 D SERV1^GMRCASV
61 ;Get external form of date range
62 I '($D(GMRCDT1)#2) S GMRCDT1="ALL"
63 S:GMRCDT1="ALL" GMRCDT2=0
64 D LISTDATE^GMRCSTU1(GMRCDT1,$G(GMRCDT2),.GMRCEDT1,.GMRCEDT2)
65 G ENORSTR
66 ;
67ENORLM(GMRCARRN) ;Entry point for List Manager interface.
68 ; Input -- GMRCARRN List Template Array Name
69 ; "CP": pending; "IFC": inter-facility
70 ; Output - None
71 D WAIT^DICD
72 ;
73ENORSTR ;Common part
74 N GMRCDA,NUMCLIN,INDEX,STATUS,LOOP,GROUPER
75 N STS,GMRCD,GMRCDT,GMRCSVCG,TEMP
76 N GMRCPT,CTRLTEMP,LINETEMP,GMRCLINE
77 N GMRCPTN,GMRCPTSN,GMRCDLA,GMRCXDT,GMRCLOC,GMRCSVCP
78 N GRP,GMRCIRF,GMRCIRFN,GMRCIDD,GMRCST,GMRCRDT
79 S:'$D(GMRCARRN) GMRCARRN="CP"
80 ;
81 ; Patch #21 added the kill for ^TMP("GMRCTOT",$J)
82 K ^TMP("GMRCR",$J,GMRCARRN),^TMP("GMRCRINDEX",$J),^TMP("GMRCTOT",$J)
83 ;
84 S GMRCCT=0
85 S NUMCLIN=0
86 S GMRCLINE=0
87 S GROUPER=0
88 S GROUPER(0)=0
89 S GMRCCT=GMRCCT+1
90 I '($D(GMRCCTRL)#2) S GMRCCTRL=0 ;default to just the list
91 S CTRLTEMP=$S(GMRCCTRL#2:"^",1:"")
92 I GMRCARRN="IFC" D
93 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",18)_"IF Consult/Request By Status - "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
94 E D
95 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",28)_"Consult/Request By Status"
96 S GMRCCT=GMRCCT+1
97 S TEMP="FROM: "_GMRCEDT1_" TO: "_GMRCEDT2
98 S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",40-($L(TEMP)/2)+.5)_TEMP
99 I GMRCARRN="IFC",$D(GMRCRF),$D(GMRCREMP) D
100 .S GMRCCT=GMRCCT+1
101 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_"Routing Facility - "_$$GET1^DIQ(4,GMRCRF,.01)
102 .S GMRCCT=GMRCCT+1
103 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_"Remote Ordering Provider - "_GMRCREMP
104 I GMRCCTRL=120 D
105 .S GMRCCT=GMRCCT+1
106 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
107 .S GMRCCT=GMRCCT+1
108 .S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=" Number St Last Action Req Dt Patient Name Patient Location"_$S(GMRCARRN="IFC":" Routing Facility Days Diff"_$S(GMRCIS="C":" Rec Dt",1:""),1:"")
109 ;
110 I '($D(GMRCSVC)#2) S GMRCSVC=1
111 I '($D(GMRCDT1)#2) S GMRCDT1="ALL",GMRCDT2=0
112 I '($D(GMRCDT2)#2) S GMRCDT2=""
113 I '($D(GMRCSTAT)#2),GMRCARRN="CP" S GMRCSTAT="3,4,5,6,8,9,11,99" ;pending consults
114 I '($D(GMRCSTAT)#2),GMRCARRN="IFC" S GMRCSTAT="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,99"
115 ;
116CAPTION ;Set the List Mangager Caption Line
117 ; Does GMRCCTRL contain 10 i.e. display line numbers
118 ; or 20 i.e. display consult number
119 I $G(VALMAR)="^TMP(""GMRCR"",$J,""CP"")"!($G(VALMAR)="^TMP(""GMRCR"",$J,""IFC"")") D
120 .I GMRCCTRL#100\10 D
121 ..I GMRCCTRL#100\10=1 D
122 ...; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
123 ...I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE"," St Last Action Request Date Patient Name Pt Location")
124 ...; Do not use abbreviations for the statuses
125 ...E D CHGCAP^VALM("CAPTION LINE"," Status Last Action Request Date Patient Name Pt Location")
126 ..; Do not display consult number
127 ..E D
128 ...; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
129 ...I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE"," Number St Last Action Request Date Patient Name Pt Location")
130 ...; Do not use abbreviations for the statuses
131 ...E D CHGCAP^VALM("CAPTION LINE"," Number Status Last Action Request Date Patient Name Pt Location")
132 .E D
133 ..; Does GMRCCTRL contain 100 i.e. use abbreviations for the statuses
134 ..I GMRCCTRL#1000\100 D CHGCAP^VALM("CAPTION LINE","St Last Action Request Date Patient Name Pt Location")
135 ..; Do not use abbreviations for the statuses
136 ..E D CHGCAP^VALM("CAPTION LINE","Status Last Action Request Date Patient Name Pt Location")
137 .I GMRCARRN="IFC" D
138 ..D CHGCAP^VALM("CAPTION LINE 1","Routing Facility Days Diff"_$S(GMRCIS="C":" Rec Date",1:""))
139 ;Set screen width
140 S VALM("RM")=$S(GMRCARRN="CP":$$CWIDTH^GMRCPC(GMRCCTRL),1:$$CWIDTH^GMRCIR(GMRCCTRL))
141 ;
142 S GMRCHEAD=$P($G(^TMP("GMRCSLIST",$J,+$O(^TMP("GMRCSLIST",$J,"")))),"^",2)
143 S INDEX=""
144SVC ;Loop on Service
145 F S INDEX=$O(^TMP("GMRCSLIST",$J,INDEX)) Q:INDEX="" D
146 .S GMRCSVC=$P(^TMP("GMRCSLIST",$J,INDEX),"^",1)
147 .S GMRCSVCP=$P(^TMP("GMRCSLIST",$J,INDEX),"^",2)
148 .S GMRCSVCG=$P(^TMP("GMRCSLIST",$J,INDEX),"^",3)
149 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0
150 .S ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=0
151 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"T")=0
152 .S ^TMP("GMRCTOT",$J,2,GMRCSVC,"P")=0
153 .I GMRCARRN="IFC" D
154 ..S GMRCST(1,GMRCSVC)="0^0"
155 ..S GMRCST(2,GMRCSVC)="0^0"
156GROUPER .;Check if starting a new Grouper
157 .F Q:GROUPER(GROUPER)=GMRCSVCG D
158 ..;End of a group so print the group totals
159 ..D LISTTOT^GMRCSTL1(.GMRCCT,2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),"",GMRCCTRL,GMRCARRN)
160 ..;pop grouper from stack
161 ..S GROUPER=GROUPER-1
162 .I $P(^TMP("GMRCSLIST",$J,INDEX),"^",4)="+" D
163 ..;Start of a new group so print the group heading.
164 ..S GMRCCT=GMRCCT+1
165 ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
166 ..S GMRCCT=GMRCCT+1
167 ..S TEMP="GROUPER: "_GMRCSVCP
168 ..S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
169 ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_$J("",40-(($L(TEMP)/2)+.5))_TEMP
170 ..;push new grouper on stack
171 ..S GROUPER=GROUPER+1
172 ..S GROUPER(GROUPER)=GMRCSVC
173STAT .;Loop for one status at a time
174 .F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) D ONESTAT^GMRCSTL2(GMRCARRN)
175 .F GRP=GROUPER:-1:1 D
176 ..; pending for this service to all of its groupers
177 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"P"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"P")
178 ..; for all status for this service to all of its groupers
179 ..S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T")=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"T"))+^TMP("GMRCTOT",$J,1,GMRCSVC,"T")
180 ..;IF Consults
181 ..I GMRCARRN="IFC" S GMRCIRFN="" F S GMRCIRFN=$O(^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)) Q:GMRCIRFN="" D
182 ...I '$D(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)) D
183 ....S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)=0
184 ....S GMRCST(2,GROUPER(GRP),GMRCIRFN)="0^0"
185 ...S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN)=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),"F",GMRCIRFN))+^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)
186 ...I +$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)>0 D
187 ....S $P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^")=($P(GMRCST(2,GROUPER(GRP)),"^"))+($P(GMRCST(1,GMRCSVC,GMRCIRFN),"^"))
188 ....S $P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^",2)=($P(GMRCST(2,GROUPER(GRP),GMRCIRFN),"^",2))+($P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2))
189 ..I GMRCARRN="IFC" D
190 ...S $P(GMRCST(2,GROUPER(GRP)),"^")=($P(GMRCST(2,GROUPER(GRP)),"^"))+($P(GMRCST(1,GMRCSVC),"^"))
191 ...S $P(GMRCST(2,GROUPER(GRP)),"^",2)=($P(GMRCST(2,GROUPER(GRP)),"^",2))+($P(GMRCST(1,GMRCSVC),"^",2))
192 .;
193PRINTST .;Print the totals for this service that are >0
194 .I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")>0 D LISTTOT^GMRCSTL1(.GMRCCT,1,GMRCSVC,GMRCSVCP,$P($G(^GMR(123.5,GMRCSVCG,0)),"^",1),GMRCCTRL,GMRCARRN)
195 ;
196 ;Done so
197 ;Now list the group totals for the current groups
198 F GROUPER=GROUPER:-1:1 D
199 .D LISTTOT^GMRCSTL1(.GMRCCT,2,GROUPER(GROUPER),$P(^GMR(123.5,GROUPER(GROUPER),0),"^",1),"",GMRCCTRL,GMRCARRN)
200 ;
201 S VALMCNT=$O(^TMP("GMRCR",$J,GMRCARRN," "),-1)
202 I $D(IOBM),$D(IOTM) S VALMBCK="R"
203EXIT Q
204 ;
Note: See TracBrowser for help on using the repository browser.