source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMPDRP.m@ 628

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

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