source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMPTDF.m@ 1006

Last change on this file since 1006 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 8.8 KB
Line 
1PXRMPTDF ; SLC/PKR/PJH - Reminder Inquiry print template routines. ;01/30/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;================================================
5PFIND ;Print the reminder definition finding multiple.
6 N DIWF,FIELD,FILENUM,FINDING,FIND0,FIND3,FINDNAM,FL,HFCAT,HFIEN
7 N IEN1,IND,INT,LEN,PAD,PADS,PARRAY,RJC,RFIND,RTERM,SCNT,SIEN,STAT0
8 ;If called by a FileMan print build the variable pointer list.
9 I '$D(PXRMFVPL) N PXRMFVPL D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
10 ;No printing is done by PFIND it accumulates all output using ^DIWP.
11 ;The print template outputs the text with ^DIWW.
12 ;Because of the way DIWP works we need to format all the found and
13 ;not found text first and store it in ^TMP.
14 K ^TMP($J,"W")
15 S FILENUM="811.902"
16 S RJC=30,PAD=" ",PADS=""
17 F IND=1:1:(RJC+2) S PADS=PADS_PAD
18 S FINDING=0
19 F S FINDING=$O(^PXD(811.9,D0,20,FINDING)) Q:+FINDING=0 D
20 .D WPFORMAT(FINDING,20,RJC,1)
21 .D WPFORMAT(FINDING,20,RJC,2)
22 K ^UTILITY($J,"W")
23 S FINDING=0
24 F S FINDING=$O(^PXD(811.9,D0,25,FINDING)) Q:+FINDING=0 D
25 .D WPFORMAT(FINDING,25,RJC,1)
26 .D WPFORMAT(FINDING,25,RJC,2)
27 S DIWF="C80",DIWL=2
28 K ^UTILITY($J,"W")
29 S FINDING=0
30 F S FINDING=$O(^PXD(811.9,D0,20,FINDING)) Q:+FINDING=0 D
31 .S FIND0=^PXD(811.9,D0,20,FINDING,0)
32 .S FIELD=$P(FIND0,U,1)
33 .S RTERM=FIELD
34 .S X=" "
35 .D ^DIWP
36 .S FINDNAM=$$ENTRYNAM^PXRMPTD2(FIELD)
37 .I FINDNAM="" S FINDNAM="?"
38 .S X=$$RJ^XLFSTR("---- Begin:",12,PAD)
39 .S X=X_" "_FINDNAM
40 .S RFIND=$$GENIEN^PXRMPTD2(FINDING)
41 .S X=X_" "_RFIND_" "
42 .S LEN=(75-$L(X))
43 .F INT=1:1:LEN S X=X_"-"
44 .D ^DIWP
45 .;
46 .S X=$$RJ^XLFSTR("Finding Type:",RJC,PAD)
47 .S X=X_" "_$$FTYPE^PXRMPTD2(FIELD,0)
48 .D ^DIWP
49 .I RFIND["HF" D
50 ..S HFIEN=$P($P($P(RFIND,"HF",2),"(",2),")")
51 ..S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
52 ..S HFCAT=$S(HFCAT="":"UNDEFINED",1:$P($G(^AUTTHF(HFCAT,0)),U,1))
53 ..S X=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
54 ..S X=X_" "_HFCAT
55 ..D ^DIWP
56 .;
57 .S FIELD=$P(FIND0,U,4)
58 .I $L(FIELD)>0 D
59 ..S X=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
60 ..S X=X_" "_$$GENFREQ^PXRMPTD2(FIND0)
61 ..D ^DIWP
62 .;
63 .D SFDISP(FIND0,5,6,"Rank Frequency:",RJC,PAD,FILENUM)
64 .D SFDISP(FIND0,6,7,"Use in Resolution Logic:",RJC,PAD,FILENUM)
65 .D SFDISP(FIND0,7,8,"Use in Patient Cohort Logic:",RJC,PAD,FILENUM)
66 .D DATE^PXRMPTD2(FIND0,8,9,"Beginning Date/Time:",RJC,PAD,FILENUM)
67 .D DATE^PXRMPTD2(FIND0,11,12,"Ending Date/Time:",RJC,PAD,FILENUM)
68 .D SFDISP(FIND0,14,17,"Occurrence Count:",RJC,PAD,FILENUM)
69 .D SFDISP(FIND0,9,10,"Use Inactive Problems:",RJC,PAD,FILENUM)
70 .D SFDISP(FIND0,10,11,"Within Category Rank:",RJC,PAD,FILENUM)
71 .D SFDISP(FIND0,16,28,"Include Visit Data:",RJC,PAD,FILENUM)
72 .D SFDISP(FIND0,12,13,"MH Scale:",RJC,PAD,FILENUM)
73 .D SFDISP(FIND0,13,16,"Rx Type:",RJC,PAD,FILENUM)
74 .D SFDISP(FIND0,15,27,"Use Start Date:",RJC,PAD,FILENUM)
75 .I $D(^PXD(811.9,D0,20,FINDING,5,0))=1 D
76 ..S (SCNT,SIEN)=0
77 ..F S SIEN=$O(^PXD(811.9,D0,20,FINDING,5,SIEN)) Q:SIEN="" D
78 ...S STAT0=$G(^PXD(811.9,D0,20,FINDING,5,SIEN,0))
79 ...D STATUS(STAT0,"Status List:",RJC) S SCNT=SCNT+1
80 .S FIND0=$G(^PXD(811.9,D0,20,FINDING,3))
81 .D SFDISP(FIND0,1,14,"Condition:",RJC,PAD,FILENUM)
82 .D SFDISP(FIND0,2,15,"Condition Case Sensitive:",RJC,PAD,FILENUM)
83 .D SFDISP(FIND0,3,18,"Use Cond in Finding Search:",RJC,PAD,FILENUM)
84 .I $G(^PXD(811.9,D0,20,FINDING,15))'="" D
85 ..S X=$$RJ^XLFSTR("Computed Finding Parameter:",RJC,PAD)
86 ..S X=X_" "_$G(^PXD(811.9,D0,20,FINDING,15))
87 ..D ^DIWP
88 .D WPOUT(FINDING,20,"Found Text:",RJC,PAD,PADS,1)
89 .D WPOUT(FINDING,20,"Not Found Text:",RJC,PAD,PADS,2)
90 .I RTERM["PXRMD(811.5" S IEN1=$P(RTERM,";") D RTERM
91 .S X=$$RJ^XLFSTR("---- End:",10,PADS)
92 .S X=X_" "_FINDNAM_" "
93 .S LEN=(75-$L(X))
94 .F INT=1:1:(LEN) S X=X_"-"
95 .D ^DIWP
96 .S X=" "
97 .D ^DIWP
98 ;
99 ;Function Findings
100 I +$P($G(^PXD(811.9,D0,25,0)),U,4)>0 D
101 .S X=" "
102 .D ^DIWP
103 .S X="Function Findings:"
104 .D ^DIWP
105 .;Build the list of findings for this reminder.
106 .D BLDFLST^PXRMPTL(D0,.FL)
107 .S FILENUM="811.925",FINDING=0
108 .F S FINDING=$O(^PXD(811.9,D0,25,FINDING)) Q:+FINDING=0 D
109 ..S FIND0=$G(^PXD(811.9,D0,25,FINDING,0))
110 ..S FIND3=$G(^PXD(811.9,D0,25,FINDING,3))
111 ..I FIND3="" Q
112 ..S FIELD=$P(FIND0,U,1)
113 ..S FINDNAM="FF("_FIELD_")"
114 ..S X=" "
115 ..D ^DIWP
116 ..S X=$$RJ^XLFSTR("---- Begin:",12,PAD)
117 ..S X=X_" "_FINDNAM
118 ..S LEN=(75-$L(X))
119 ..F INT=1:1:LEN S X=X_"-"
120 ..D ^DIWP
121 ..;
122 ..D SFDISP(FIND3,1,3,"Function String:",RJC,PAD,FILENUM)
123 ..S X=" Expanded Function String:" D ^DIWP
124 ..D DISLOGF^PXRMPTL(D0,FINDING,.FL,.PARRAY)
125 ..S INT=0
126 ..F S INT=$O(PARRAY(INT)) Q:'INT D
127 ...S X=$J("",6)_PARRAY(INT) D ^DIWP
128 ..;
129 ..S FIELD=$P(FIND0,U,4)
130 ..I $L(FIELD)>0 D
131 ...S X=$$RJ^XLFSTR("Match Frequency/Age:",RJC,PAD)
132 ...S X=X_" "_$$GENFREQ^PXRMPTD2(FIND0)
133 ...D ^DIWP
134 ..;
135 ..D SFDISP(FIND0,5,10,"Rank Frequency:",RJC,PAD,FILENUM)
136 ..D SFDISP(FIND0,6,11,"Use in Resolution Logic:",RJC,PAD,FILENUM)
137 ..D SFDISP(FIND0,7,12,"Use in Patient Cohort Logic:",RJC,PAD,FILENUM)
138 ..;
139 ..D WPOUT(FINDING,25,"Found Text:",RJC,PAD,PADS,1)
140 ..D WPOUT(FINDING,25,"Not Found Text:",RJC,PAD,PADS,2)
141 ..S X=$$RJ^XLFSTR("---- End:",10,PADS)
142 ..S X=X_" "_FINDNAM_" "
143 ..S LEN=(75-$L(X))
144 ..F INT=1:1:(LEN) S X=X_"-"
145 ..D ^DIWP
146 ..S X=" "
147 ..D ^DIWP
148 ;
149 K ^TMP($J,"W")
150 ;^UTILITY($J,"W") will be killed by ^DIWW in the print template.
151 Q
152 ;
153 ;================================================
154RTERM ;Reminder Term
155 N CNT,RJT,SCNT,SIEN,STAT0,TERM,TERM3,TERMNUM,TERMS
156 S CNT=0,RJT=RJC+10,TERMNUM="811.52"
157 S TERMS=0 F S TERMS=$O(^PXRMD(811.5,IEN1,20,TERMS)) Q:+TERMS=0 D
158 .S TERM=$G(^PXRMD(811.5,IEN1,20,TERMS,0))
159 .S TERM3=$G(^PXRMD(811.5,IEN1,20,TERMS,3))
160 .D SFDISP(TERM,1,.01,"Mapped Finding Item:",RJT,PAD,TERMNUM,CNT)
161 .D SFDISP(TERM,8,9,"Beginning Date/Time:",RJT,PAD,TERMNUM)
162 .D SFDISP(TERM,9,10,"Use Inactive Problems:",RJT,PAD,TERMNUM)
163 .D SFDISP(TERM,11,12,"Ending Date/Time:",RJT,PAD,TERMNUM)
164 .D SFDISP(TERM,10,11,"Within Category Rank:",RJT,PAD,TERMNUM)
165 .D SFDISP(TERM,12,13,"MH Scale:",RJT,PAD,TERMNUM)
166 .D SFDISP(TERM,13,16,"RX Type:",RJT,PAD,TERMNUM)
167 .D SFDISP(TERM,14,17,"Occurrence Count:",RJT,PAD,TERMNUM)
168 .I $D(^PXRMD(811.5,IEN1,20,TERMS,5,0))=1 D
169 ..S (SCNT,SIEN)=0
170 ..F S SIEN=$O(^PXRMD(811.5,IEN1,20,TERMS,5,SIEN)) Q:SIEN="" D
171 ...S STAT0=$G(^PXRMD(811.5,IEN1,20,TERMS,5,SIEN,0))
172 ...D STATUS(STAT0,"Status List:",RJT) S SCNT=SCNT+1
173 .D SFDISP(TERM3,1,14,"Condition:",RJT,PAD,TERMNUM,1)
174 .D SFDISP(TERM3,2,15,"Condition Case Sensitive:",RJT,PAD,TERMNUM)
175 .D SFDISP(TERM3,3,18,"Use Cond in Finding Search:",RJT,PAD,TERMNUM)
176 .I $G(^PXRMD(811.5,IEN1,20,TERMS,15))'="" D
177 ..S X=$$RJ^XLFSTR("Computed Finding Parameter:",RJT,PAD)
178 ..S X=X_" "_$G(^PXRMD(811.5,IEN1,20,TERMS,15))
179 ..D ^DIWP
180 .S X=""
181 .D ^DIWP
182 .S CNT=CNT+1
183 I CNT=0 D Q
184 .S X=$$RJ^XLFSTR("RT Mapped Finding:",RJC,PAD)
185 .S X=X_" No Reminder Finding Found"
186 .D ^DIWP
187 Q
188 ;
189 ;================================================
190SFDISP(FIND0,PIECE,FLDNUM,TITLE,RJC,PAD,FILENUM,FLG) ;Standard finding
191 ;multiple field display.
192 N FIELD,HFCAT,HFIEN,NAME,TYPE,X
193 S NAME=""
194 S FIELD=$P(FIND0,U,PIECE)
195 I (PIECE=1)&(FLDNUM=".01")&(FILENUM="811.52") D
196 .I FLG=0 D
197 ..S X=""
198 ..D ^DIWP
199 ..S RTERM=$P($P(RFIND,"=",2),")")_")"
200 ..S X=$$RJ^XLFSTR("Mapped Findings:",40)
201 ..D ^DIWP
202 .S TYPE=$$FTYPE^PXRMPTD2(FIELD,1),NAME=$$ENTRYNAM^PXRMPTD2(FIELD)
203 .S X=$$RJ^XLFSTR(TITLE,RJC,PAD)
204 .S X=X_" "_TYPE_"."_NAME
205 .D ^DIWP
206 .I TYPE="HF" D
207 ..S HFIEN=$P(TERM,";")
208 ..S HFCAT=$P($G(^AUTTHF(HFIEN,0)),U,3)
209 ..S HFCAT=$P($G(^AUTTHF(HFCAT,0)),U)
210 ..S X=$$RJ^XLFSTR("Health Factor Category:",RJC,PAD)
211 ..S X=X_" "_HFCAT
212 ..D ^DIWP
213 I NAME'="" Q
214 I $L(FIELD)>0 D
215 .S X=$$RJ^XLFSTR(TITLE,RJC,PAD)
216 .S X=X_" "_$$EXTERNAL^DILFD(FILENUM,FLDNUM,"",FIELD,"")
217 .D ^DIWP
218 Q
219 ;
220 ;================================================
221STATUS(STAT0,TITLE,SPACE) ;
222 I $L(STAT0)>0 D
223 .I SCNT=0 S X=$$RJ^XLFSTR(TITLE,SPACE,PAD)
224 .I SCNT>0 S X=$$RJ^XLFSTR("",SPACE,PAD)
225 .S X=X_" "_STAT0
226 .D ^DIWP
227 Q
228 ;
229 ;================================================
230WPFORMAT(FINDING,NODE,RJC,INDEX) ;Format found/not found word processing text.
231 I '$D(^PXD(811.9,D0,NODE,FINDING,INDEX,1,0)) Q
232 ;Save the title using the current format for DIWP.
233 N DIWF,DIWL,DIWR,IND,NLINES,SC,X
234 K ^UTILITY($J,"W")
235 S DIWF="|",DIWL=RJC+2,DIWR=78
236 S IND=0
237 F S IND=$O(^PXD(811.9,D0,NODE,FINDING,INDEX,IND)) Q:+IND=0 D
238 .S X=$G(^PXD(811.9,D0,NODE,FINDING,INDEX,IND,0))
239 .D ^DIWP
240 ;Find where this stuff went.
241 S SC=$O(^UTILITY($J,"W",""))
242 ;Save into ^TMP.
243 S NLINES=^UTILITY($J,"W",SC)
244 S ^TMP($J,"W",FINDING,NODE,INDEX)=NLINES
245 F IND=1:1:NLINES D
246 .S ^TMP($J,"W",FINDING,NODE,INDEX,IND)=^UTILITY($J,"W",SC,IND,0)
247 K ^UTILITY($J,"W")
248 Q
249 ;
250 ;================================================
251WPOUT(FINDING,NODE,TITLE,RJC,PAD,PADS,INDEX) ;Output found/not found word processing
252 ;text.
253 I $D(^TMP($J,"W",FINDING,NODE,INDEX)) D
254 .N IND,X
255 .S X=$$RJ^XLFSTR(TITLE,RJC,PAD)_" "_^TMP($J,"W",FINDING,NODE,INDEX,1)
256 .D ^DIWP
257 .F IND=2:1:^TMP($J,"W",FINDING,NODE,INDEX) D
258 ..S X=PADS_^TMP($J,"W",FINDING,NODE,INDEX,IND)
259 ..D ^DIWP
260 Q
261 ;
Note: See TracBrowser for help on using the repository browser.