source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMPDRP.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: 9.3 KB
Line 
1PXRMPDRP ;SLC/AGP,PKR - Patient List Demographic report print routine ;06/20/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4ADDTXT(TEXT) ;Accumulate text in ^TMP.
5 S LINCNT=LINCNT+1
6 S ^TMP("PXRMPDEM",$J,LINCNT)=TEXT
7 Q
8 ;
9APPHDR(DC,APPDATA) ;Build the appointment header.
10 I APPDATA("LEN")'>0 Q
11 N HDR,IND,JND,KND,LND,TEMP
12 S IND=0,HDR=""
13 F IND=1:1:APPDATA("MAX") D
14 . F JND=1:1:APPDATA("LEN") D
15 .. S KND=$P(APPDATA,",",JND)
16 .. S LND=""
17 .. F S LND=$O(APPDATA(KND,LND)) Q:LND="" D
18 ... S TEMP=$P(APPDATA(KND,LND),U,1)
19 ... S HDR=HDR_TEMP_IND_DC
20 S APPDATA("HDR")=HDR
21 Q
22 ;
23APPPRINT(DFN,APPDATA) ;Print appointment data.
24 N CLINIC,COUNT,DATE,HDR,IND,JND,KND,LINE,PCLINIC,PDATE,TEMP
25 S (PCLINIC,PDATE)=0
26 F IND=1:1:APPDATA("LEN") D
27 . S JND=$P(APPDATA,",",IND)
28 . I JND=1 S PDATE=1
29 . I JND=2 S PCLINIC=1
30 S HDR=""
31 I PDATE S HDR=" "_$P(APPDATA(1,1),U,1)
32 I PCLINIC S HDR=HDR_" "_$P(APPDATA(2,2),U,1)
33 D ADDTXT(" ")
34 D ADDTXT("Appointment Data")
35 D ADDTXT(HDR)
36 S COUNT=0
37 F S COUNT=$O(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT)) Q:COUNT="" D
38 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",COUNT))
39 . S LINE=""
40 . I PDATE S LINE=LINE_$P(TEMP,U,1)
41 . I PCLINIC S LINE=LINE_" "_$P(TEMP,U,2)
42 . D ADDTXT(LINE)
43 Q
44 ;
45DELIMHDR(DC,DATA) ;Build the delimited header for a data type.
46 I DATA("LEN")'>0 Q
47 N HDR,IND,JND,KND,LND,MAX,TEMP
48 S IND=0,HDR=""
49 F IND=1:1:DATA("LEN") D
50 . S JND=$P(DATA,",",IND)
51 . S KND=""
52 . F S KND=$O(DATA(JND,KND)) Q:KND="" D
53 .. S TEMP=$P(DATA(JND,KND),U,1)
54 .. S MAX=$P(DATA(JND,KND),U,3)
55 .. I MAX="" S HDR=HDR_TEMP_DC
56 .. I +MAX>0 F LND=1:1:MAX S HDR=HDR_TEMP_LND_DC
57 S DATA("HDR")=HDR
58 Q
59 ;
60DELIMPR(DC,PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;
61 ;Print the delimited report.
62 N DATALIST,DFN,IND,NDT,PNAME
63 S NDT=0
64 I ADDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ADDDATA"
65 I APPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="APPDATA"
66 I DEMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="DEMDATA"
67 I ELIGDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="ELIGDATA"
68 I FINDDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="FINDDATA"
69 I INPDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="INPDATA"
70 I PFACDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="PFACDATA"
71 I REMDATA("LEN")>0 S NDT=NDT+1,DATALIST(NDT)="REMDATA"
72 D TITLE(PLIEN,1)
73 ;Output the delimited header.
74 F IND=1:1:NDT D
75 . I DATALIST(IND)="ADDDATA" D DELIMHDR(DC,.ADDDATA) Q
76 . I DATALIST(IND)="APPDATA" D APPHDR(DC,.APPDATA) Q
77 . I DATALIST(IND)="DEMDATA" D DELIMHDR(DC,.DEMDATA) Q
78 . I DATALIST(IND)="ELIGDATA" D DELIMHDR(DC,.ELIGDATA) Q
79 . I DATALIST(IND)="FINDDATA" D DELIMHDR(DC,.FINDDATA) Q
80 . I DATALIST(IND)="INPDATA" D DELIMHDR(DC,.INPDATA) Q
81 . I DATALIST(IND)="PFACDATA" D PFACHDR(.PFACDATA)
82 . I DATALIST(IND)="REMDATA" D REMHDR(DC,.REMDATA) Q
83 D DELTITLE(DC,.ADDDATA,.APPDATA,.DEMDATA,.FINDDATA,.INPDATA,.PFACDATA,.REMDATA)
84 S PNAME=":"
85 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D
86 . S DFN=""
87 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D
88 .. W !,PNAME_DC
89 .. F IND=1:1:NDT D
90 ... I DATALIST(IND)="ADDDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ADDDATA) Q
91 ... I DATALIST(IND)="APPDATA" D PAPPDATA(DFN,DC,.APPDATA) Q
92 ... I DATALIST(IND)="DEMDATA" D PDELDATA(DFN,DC,DATALIST(IND),.DEMDATA) Q
93 ... I DATALIST(IND)="ELIGDATA" D PDELDATA(DFN,DC,DATALIST(IND),.ELIGDATA) Q
94 ... I DATALIST(IND)="FINDDATA" D PFINDATA(DFN,DC,.FINDDATA) Q
95 ... I DATALIST(IND)="INPDATA" D PDELDATA(DFN,DC,DATALIST(IND),.INPDATA) Q
96 ... I DATALIST(IND)="PFACDATA" D PFACDATA(DFN,.PFACDATA) Q
97 ... I DATALIST(IND)="REMDATA" D PREMDATA(DFN,DC,.REMDATA) Q
98 .. W "\\"
99 Q
100 ;
101DELTITLE(DC,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;Combine
102 ;all the headers to create the delimited title.
103 W !,"PATIENT"_DC
104 W $G(ADDDATA("HDR"))
105 W $G(APPDATA("HDR"))
106 W $G(DEMDATA("HDR"))
107 W $G(ELIGDATA("HDR"))
108 W $G(FINDDATA("HDR"))
109 W $G(INPDATA("HDR"))
110 W $G(PFACDATA("HDR"))
111 W $G(REMDATA("HDR"))
112 W "\\"
113 Q
114 ;
115FINDPR(DFN,FINDDATA) ;Print finding information.
116 N IND,JND,LINE,TEMP
117 D ADDTXT(" ")
118 S LINE="Finding Data"
119 D ADDTXT(LINE)
120 F IND=1:1:FINDDATA("LEN") D
121 . S JND=$P(FINDDATA,",",IND)
122 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND))
123 . I TEMP="" Q
124 . S LINE=" "_$P(FINDDATA(JND,JND),U,1)_": "_TEMP
125 . D ADDTXT(LINE)
126 Q
127 ;
128OUTPUT ;Output the text.
129 N IND,LC,LO,VSIZE
130 S VSIZE=IOSL-2
131 S (LC,LO)=0
132 F IND=1:1:LINCNT D
133 . S LC=LC+1,LO=LO+1
134 . W !,^TMP("PXRMPDEM",$J,LC)
135 . I LO=VSIZE D
136 .. D PAGE
137 .. I $D(DTOUT)!$D(DUOUT) S IND=LINCNT Q
138 .. S LO=0
139 Q
140 ;
141PAGE ;
142 I ($E(IOST)="C")&(IO=IO(0)) D
143 . N DIR
144 . S DIR(0)="E"
145 . W !
146 . D ^DIR K DIR
147 I $D(DUOUT)!$D(DTOUT) Q
148 W:$D(IOF) @IOF
149 I $E(IOST)="C",IO=IO(0) W @IOF
150 Q
151 ;
152PAPPDATA(DFN,DC,APPDATA) ;Print the delimited appointment data.
153 N IND,JND,KND,LINE,LND,PIECE,TEMP
154 I APPDATA("LEN")'>0 Q
155 S LINE=""
156 F IND=1:1:APPDATA("MAX") D
157 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"APPDATA",IND))
158 . F JND=1:1:APPDATA("LEN") D
159 .. S KND=$P(APPDATA,",",JND)
160 .. S LND=""
161 .. F S LND=$O(APPDATA(KND,LND)) Q:LND="" D
162 ... S PIECE=$P(APPDATA(KND,KND),U,2)
163 ... S LINE=LINE_$P(TEMP,U,PIECE)_DC
164 W LINE
165 Q
166 ;
167PDELDATA(DFN,DC,DTYPE,DATA) ;Print the delimited data.
168 N IND,JND,KND,LINE,LND,TEMP,TTEMP
169 I DATA("LEN")'>0 Q
170 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
171 S LINE=""
172 F IND=1:1:DATA("LEN") D
173 . S JND=$P(DATA,",",IND)
174 . S KND=""
175 . F S KND=$O(DATA(JND,KND)) Q:KND="" D
176 .. S MAX=$P(DATA(JND,KND),U,3)
177 .. I MAX="" S LINE=LINE_$P(TEMP,U,KND)_DC Q
178 .. I +MAX>1 S TTEMP=$P(TEMP,U,KND) F LND=1:1:MAX S LINE=LINE_$P(TTEMP,"~",LND)_DC
179 W LINE
180 Q
181 ;
182PFACHDR(PFACDATA) ;Build the preferred facility header.
183 I PFACDATA(0)=1 S PFACDATA("HDR")="PATIENT'S PREFERRED FACILITY"
184 Q
185 ;
186PFACDATA(DFN,PFACDATA) ;Print the patient's preferred facility data, delimited.
187 I PFACDATA(0)=0 Q
188 W ^TMP("PXRMPLD",$J,DFN,"PFACDATA")
189 Q
190 ;
191PFACPR(DFN,PFACDATA) ;Print the patient's preferred facility.
192 I PFACDATA(0)=0 Q
193 D ADDTXT("Patient's Preferred Facility")
194 D ADDTXT(" "_$G(^TMP("PXRMPLD",$J,DFN,"PFACDATA")))
195 Q
196 ;
197PFINDATA(DFN,DC,FINDDATA) ;Print the finding data.
198 N IND,JND,LINE,TEMP
199 I FINDDATA("LEN")'>0 Q
200 S LINE=""
201 F IND=1:1:FINDDATA("LEN") D
202 . S JND=$P(FINDDATA,",",IND)
203 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"FINDDATA",JND))
204 . S LINE=LINE_TEMP_DC
205 W LINE
206 Q
207 ;
208PREMDATA(DFN,DC,REMDATA) ;Print the reminder data.
209 N IND,JND,LINE,TEMP
210 I REMDATA("LEN")'>0 Q
211 S LINE=""
212 F IND=1:1:REMDATA("LEN") D
213 . S JND=$P(REMDATA,",",IND)
214 . S LINE=LINE_REMDATA("RNAME",JND)_DC
215 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",REMDATA("IEN",JND)))
216 . S LINE=LINE_$P(TEMP,U,2)_DC_$P(TEMP,U,3)_"^"_$P(TEMP,U,4)_DC
217 W LINE
218 Q
219 ;
220REGPR(PLIEN,ADDDATA,APPDATA,DEMDATA,FINDDATA,INPDATA,PFACDATA,REMDATA) ;
221 ;Print the regular report..
222 N DATATYPE,DFN,PNAME,LINCNT
223 K ^TMP("PXRMPDEM",$J)
224 S LINCNT=0
225 D TITLE(PLIEN,0)
226 S PNAME=":"
227 F S PNAME=$O(^TMP("PXRMPLN",$J,PNAME)) Q:PNAME="" D
228 . S DFN=0
229 . F S DFN=$O(^TMP("PXRMPLN",$J,PNAME,DFN)) Q:DFN="" D
230 .. D ADDTXT(" ")
231 .. D ADDTXT("---------- "_PNAME_" DFN="_DFN_" ----------")
232 .. S DATATYPE=""
233 .. F S DATATYPE=$O(^TMP("PXRMPLD",$J,DFN,DATATYPE)) Q:DATATYPE="" D
234 ... I DATATYPE="ADDDATA" D VADPTPR(DFN,"Address Data",DATATYPE,.ADDDATA) Q
235 ... I DATATYPE="APPDATA" D APPPRINT(DFN,.APPDATA) Q
236 ... I DATATYPE="DEMDATA" D VADPTPR(DFN,"Demographic Data",DATATYPE,.DEMDATA) Q
237 ... I DATATYPE="ELIGDATA" D VADPTPR(DFN,"Eligibility Data",DATATYPE,.ELIGDATA) Q
238 ... I DATATYPE="FINDDATA" D FINDPR(DFN,.FINDDATA) Q
239 ... I DATATYPE="INPDATA" D VADPTPR(DFN,"Inpatient Data",DATATYPE,.INPDATA) Q
240 ... I DATATYPE="PFACDATA" D PFACPR(DFN,.PFACDATA) Q
241 ... I DATATYPE="REMDATA" D REMPR(DFN,.REMDATA) Q
242 D OUTPUT
243 K ^TMP("PXRMPDEM",$J)
244 Q
245 ;
246REMHDR(DC,REMDATA) ;Build the reminder data delimited header.
247 N HDR,IND,JND
248 S HDR=""
249 F IND=1:1:REMDATA("LEN") D
250 . S JND=$P(REMDATA,",",IND)
251 . S HDR=HDR_"REMINDER"_JND_DC_"STATUS"_JND_DC_"DUE DATE"_JND_DC_"LAST DONE"_JND_DC
252 S REMDATA("HDR")=HDR
253 Q
254 ;
255REMPR(DFN,REMDATA) ;Print reminder status information.
256 N DUE,IND,JND,LAST,LINE,NSP,STATUS,TEMP
257 D ADDTXT(" ")
258 S LINE="Reminder:"_$$INSCHR^PXRMEXLC(27," ")_"--STATUS-- --DUE DATE-- --LAST DONE--"
259 D ADDTXT(LINE)
260 F IND=1:1:REMDATA("LEN") D
261 . S JND=$P(REMDATA,",",IND)
262 . S RIEN=REMDATA("IEN",JND)
263 . S TEMP=$G(^TMP("PXRMPLD",$J,DFN,"REMDATA",RIEN))
264 . I TEMP="" Q
265 . S STATUS=$P(TEMP,U,2)
266 . S DUE=$P(TEMP,U,3),DUE=$$EDATE^PXRMDATE(DUE)
267 . S LAST=$P(TEMP,U,4),LAST=$$EDATE^PXRMDATE(LAST)
268 . S NSP=38-$L(REMDATA("RNAME",JND))
269 . S LINE=REMDATA("RNAME",JND)_$$INSCHR^PXRMEXLC(NSP," ")_STATUS
270 . S NSP=54-$L(LINE)-($L(DUE)/2)
271 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_DUE
272 . S NSP=69-$L(LINE)-($L(LAST)/2)
273 . S LINE=LINE_$$INSCHR^PXRMEXLC(NSP," ")_LAST
274 . D ADDTXT(LINE)
275 Q
276 ;
277TITLE(PLIEN,DELIM) ;Print the report title.
278 N LISTNAME
279 S LISTNAME=$P(^PXRMXP(810.5,PLIEN,0),U,1)
280 I DELIM D
281 . W @IOF
282 . W !,"Patient Demographic Report"
283 . W !," Patient List: "_LISTNAME
284 . W !," Created on "_$$FMTE^XLFDT(DCREAT)
285 I 'DELIM D
286 . D ADDTXT("Patient Demographic Report")
287 . D ADDTXT(" Patient List: "_LISTNAME)
288 . D ADDTXT(" Created on "_$$FMTE^XLFDT(DCREAT))
289 Q
290 ;
291VADPTPR(DFN,DNAME,DTYPE,DATA) ;Print data returned by a VADPT call.
292 N IND,JND,KND,LINE,LND,MAX,TEMP,TTEMP
293 D ADDTXT(" ")
294 D ADDTXT(DNAME)
295 S TEMP=$G(^TMP("PXRMPLD",$J,DFN,DTYPE))
296 F IND=1:1:DATA("LEN") D
297 . S JND=$P(DATA,",",IND)
298 . S KND=""
299 . F S KND=$O(DATA(JND,KND)) Q:KND="" D
300 .. S TTEMP=$P(TEMP,U,KND)
301 .. S MAX=+$P(DATA(JND,KND),U,3)
302 .. I MAX=0 S MAX=1
303 .. F LND=1:1:MAX D
304 ... S LINE=" "_$P(DATA(JND,KND),U,1)_": "_$P(TTEMP,"~",LND)
305 ... D ADDTXT(LINE)
306 Q
307 ;
Note: See TracBrowser for help on using the repository browser.