source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGPR.m@ 1474

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

revised back to 6/30/08 version
File size: 8.9 KB
Line 
1PXRMXGPR ; SLC/PJH - Reminder Due print calls ;01/09/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Called from PXRMXPR
5 ;
6 ;Print Selection criteria
7HEAD(PSTART) ;
8 I SUB="TOTAL" N NAM S NAM="TOTAL REPORT"
9 I PXRMTABS="Y" D Q
10 .N FFAC,FNAM
11 .S FNAM=NAM
12 .I "CES"[PXRMTABC S FNAM=$TR(FNAM,SEP,"_")
13 .I PXRMFCMB="N","LT"[PXRMSEL D Q
14 ..S FFAC=$TR(FACPNAME,SEP,"_")
15 ..W !,"0"_SEP_FFAC_"_"_FNAM_SEP_SEP
16 .I PXRMFCMB="N","LT"'[PXRMSEL W !,"0"_SEP_FNAM_SEP_SEP Q
17 .I PXRMFCMB="Y" W !,"0"_SEP_"COMBINED_REPORT_"_FNAM_SEP_SEP Q
18 I "LT"[PXRMSEL D
19 .I PXRMFCMB="N" W !,?PSTART,"Facility: ",FACPNAME Q
20 .W !,?PSTART,"Combined Report: "
21 .N FACN,LENGTH,TEXT
22 .S FACN=0,LENGTH=17+PSTART
23 .F S FACN=$O(PXRMFACN(FACN)) Q:'FACN D
24 ..S TEXT=$P(PXRMFACN(FACN),U)_" ("_FACN_")"
25 ..I $O(PXRMFACN(FACN)) S TEXT=TEXT_", "
26 ..I (LENGTH+$L(TEXT))>80 S LENGTH=17+PSTART W !,?(17+PSTART)
27 ..W TEXT S LENGTH=LENGTH+$L(TEXT)
28 I "PTO"[PXRMSEL D
29 .I SUB="TOTAL" W !,?PSTART,NAM Q
30 .W !,?PSTART,"Reminders "_PXRMTX_" for ",NAM
31 I PXRMSEL="L" W !,?PSTART,"Reminders "_PXRMTX_" "_SD_" - ",NAM
32 I PXRMSEL="L" D
33 .I "PF"[PXRMFD W " for ",BD," to ",ED
34 .I PXRMFD="A" W " admissions from ",BD," to ",ED
35 .I PXRMFD="C" W " for current inpatients"
36 I PXRMSEL'="L" W " for ",SD
37 W:PXRMSEL="I" !
38 ;
39 Q
40 ;
41 ;Output the provider report criteria
42CRIT(PSTART,PLSTCRIT) ;
43 N CNT,RCCNT,RCDES,RICNT,RIDES,UNDL
44 S CNT=0
45 S UNDL=$TR($J("",79)," ","_") D LITS^PXRMXPR1
46 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART-8)_"Report Criteria:",CNT=CNT+1
47 I PXRMTMP'="" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Report Title:",22)_$P(PXRMTMP,U,3),CNT=CNT+1
48 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Patient Sample:",22)_PXRMFLD,CNT=CNT+1
49 I PXRMSEL'="L" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22) D DISP(.CNT,.PLSTCRIT)
50 I PXRMSEL="L" D
51 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR(PXRMFLD_":",22)_DES,CNT=CNT+1
52 .I $E(PXRMLCSC,2)'="A" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",10) D DISP(.CNT,.PLSTCRIT)
53 I $D(PXRMRCAT) D
54 .S RCCNT=0
55 .F S RCCNT=$O(PXRMRCAT(RCCNT)) Q:'RCCNT D
56 ..S RCDES=$P(PXRMRCAT(RCCNT),U,2)
57 ..I RCCNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder Category:",22)_RCDES_U_6,CNT=CNT+1
58 ..I RCCNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RCDES
59 .S RICNT=0
60 .F S RICNT=$O(PXRMREM(RICNT)) Q:'RICNT D
61 ..S RIDES=$P(PXRMREM(RICNT),U,2)
62 ..I RICNT=1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Individual Reminder:",22)_RIDES_U_6,CNT=CNT+1
63 ..I RICNT>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",22)_RIDES,CNT=CNT+1
64 S PLSTCRIT(CNT)=U_6,CNT=CNT+1
65 I PXRMREP="D" D
66 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Reminder:",22)_RDES,CNT=CNT+1
67 .;Display future appointments for Reminder Due report only
68 .I PXRMRT="PXRMX" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_"Appointments:" D
69 ..I PXRMFUT="Y" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"All Future Appointments",CNT=CNT+1
70 ..I PXRMFUT="N" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$$LJ^XLFSTR(" ",32-$L(PLSTCRIT(CNT)))_"Next Appointment only",CNT=CNT+1
71 I PXRMSEL="P" S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("All/Primary:",22)_CDES,CNT=CNT+1
72 I PXRMSEL="L" D S CNT=CNT+1
73 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date Range:",22)
74 .I "PAF"[PXRMFD S PLSTCRIT(CNT)=PLSTCRIT(CNT)_BD_" to "_ED Q
75 .I PXRMFD="C" S PLSTCRIT(CNT)=PLSTCRIT(CNT)_"not applicable" Q
76 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Effective Due Date:",22)_SD,CNT=CNT+1
77 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Date run:",22)_RD,CNT=CNT+1
78 I PXRMTMP'="" D
79 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Template Name:",22)_$P(PXRMTMP,U,2),CNT=CNT+1
80 .I PXRMUSER S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Requested by:",22)_$$GET1^DIQ(200,DUZ,.01)_U_3,CNT=CNT+1
81 I (PXRMFCMB="Y")!(PXRMLCMB="Y")!(PXRMTCMB="Y") D
82 .N LIT,TEXT
83 .S LIT=$S(PXRMSEL="P":"Providers","OT"[PXRMSEL:"Teams",1:"Locations")
84 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Combined report:",22)
85 .I PXRMFCMB="Y",PXRMLCMB="Y" S TEXT="Combined Facility and Combined "_LIT
86 .I PXRMFCMB="Y",PXRMLCMB="N" S TEXT="Combined Facility by Individual "_LIT
87 .I PXRMLCMB="Y",PXRMFCMB="N" S TEXT="Combined "_LIT
88 .I PXRMTCMB="Y" S TEXT="Combined "_LIT
89 .S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
90 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
91 I PXRMREP="S","IRT"[PXRMTOT,"IR"'[PXRMSEL D
92 .N LIT1,LIT2,LIT3,TEXT
93 .D LIT^PXRMXD
94 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Summary report:",22)
95 .I PXRMTOT="I" S TEXT=LIT1
96 .I PXRMTOT="R" S TEXT=LIT2
97 .I PXRMTOT="T" S TEXT=LIT3
98 .S PLSTCRIT(CNT)=PLSTCRIT(CNT)_TEXT,CNT=CNT+1
99 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
100 I $D(PXRMSCAT),PXRMSCAT]"",PXRMFD="P" D OSCAT(PXRMSCAT,PSTART,.CNT,.PLSTCRIT)
101 N CHECK,CNT,NODE,STR
102 S CNT=0 F S CNT=$O(PLSTCRIT(CNT)) Q:CNT'>0 D
103 .S NODE=$G(PLSTCRIT(CNT)),CHECK=$P(NODE,U,2),STR=$P(NODE,U)
104 .I CHECK>0 D CHECK(CHECK) I STR="" Q
105 .W !,STR
106 W !,UNDL,!
107 Q
108 ;
109 ;Display selected teams/providers
110DISP(CNT,PLSTCRIT) ;
111 N IC
112 S IC=""
113 I PXRMSEL="P" F S IC=$O(PXRMPRV(IC)) Q:IC="" D
114 .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
115 .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPRV(IC),U,2),CNT=CNT+1
116 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
117 I PXRMSEL="T" F S IC=$O(PXRMPCM(IC)) Q:IC="" D
118 .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
119 .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPCM(IC),U,2),CNT=CNT+1
120 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
121 I PXRMSEL="O" F S IC=$O(PXRMOTM(IC)) Q:IC="" D
122 .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMOTM(IC),U,3),CNT=CNT+1
123 .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMOTM(IC),U,2),CNT=CNT+1
124 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
125 I PXRMSEL="I" F S IC=$O(PXRMPAT(IC)) Q:IC="" D
126 .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
127 .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMPAT(IC),U,2),CNT=CNT+1
128 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
129 I PXRMSEL="R" F S IC=$O(PXRMLIST(IC)) Q:IC="" D
130 .I IC=1 S PLSTCRIT(CNT)=PLSTCRIT(CNT)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
131 .I IC>1 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMLIST(IC),U,2),CNT=CNT+1
132 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
133 I PXRMSEL="L" D
134 .I $E(PXRMLCSC)="H" F S IC=$O(^XTMP(PXRMXTMP,"HLOC",IC)) Q:IC="" D
135 ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(^XTMP(PXRMXTMP,"HLOC",IC),U,2),CNT=CNT+1
136 ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
137 .I $E(PXRMLCSC)="C" F S IC=$O(PXRMCS(IC)) Q:IC="" D
138 ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCS(IC),U,1)_" "_$P(PXRMCS(IC),U,3),CNT=CNT+1
139 ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
140 .I $E(PXRMLCSC)="G" F S IC=$O(PXRMCGRP(IC)) Q:IC="" D
141 ..S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",32)_$P(PXRMCGRP(IC),U,2),CNT=CNT+1
142 ..S PLSTCRIT(CNT)=U_3,CNT=CNT+1
143 Q
144 ;
145 ;Output the service categories
146OSCAT(SCL,PSTART,CNT,PLSTCRIT) ;
147 N IC,CSTART,EM,SC,SCTEXT
148 S CSTART=PSTART+3
149 S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",PSTART)_$$LJ^XLFSTR("Service categories:",22)_SCL,CNT=CNT+1
150 F IC=1:1:$L(SCL,",") D
151 .S SC=$P(SCL,",",IC)
152 .S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
153 .S PLSTCRIT(CNT)=U_3,CNT=CNT+1
154 .S PLSTCRIT(CNT)=$$RJ^XLFSTR(" ",CSTART)_SC_" - "_SCTEXT,CNT=CNT+1
155 Q
156 ;
157 ;If necessary, write the header
158COL(NEWPAGE) ;
159 I NEWPAGE D Q:DONE
160 .I PXRMTABS="N" D PAGE
161 .I PXRMTABS="Y" W !!
162 D CHECK(0) Q:DONE
163 D HEAD(0)
164 S HEAD=0
165 I PXRMTABS="Y" Q
166 I PXRMREP="D" D
167 .N PNAM
168 .S PNAM=$P(PXRMREM(1),U,4) I PNAM="" S PNAM=$P(PXRMREM(1),U,2)
169 .W !!,PNAM,": ",COUNT
170 .W:COUNT>1 " patients have the reminder "_PXRMTX
171 .W:COUNT=1 " patient has the reminder "_PXRMTX
172 N IC F IC=0:1:2 W !,?PXRMT(IC),PXRMH(IC)
173 Q
174 ;
175 ;form feed to new page
176PAGE I ($E(IOST)="C")&(IO=IO(0))&(PAGE>0) D
177 .S DIR(0)="E"
178 .W !
179 .D ^DIR K DIR
180 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
181 W:$D(IOF)&(PAGE>0) @IOF
182 S PAGE=PAGE+1,FIRST=0
183 I $E(IOST)="C",IO=IO(0) W @IOF
184 E W !
185 N TEMP,TEXTLEN
186 S TEMP=$$NOW^XLFDT,TEMP=$$FMTE^XLFDT(TEMP,"P")
187 S TEMP=TEMP_" Page "_PAGE
188 S TEXTLEN=$L(TEMP)
189 W ?(IOM-TEXTLEN),TEMP
190 S TEXTLEN=$L(PXRMOPT)
191 I TEXTLEN>0 D
192 .W !!
193 .W ?((IOM-TEXTLEN)/2),PXRMOPT
194 Q
195 ;
196 ;count of patients in sample
197TOTAL N LIT
198 I PXRMTABS="Y" D Q
199 .I PXRMREP="D" W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_"APPLICABLE"_SEP_APPL Q
200 .I PXRMREP="S" W !,"0"_SEP_"PATIENTS"_SEP_TOTAL_SEP_SEP_$TR(SUB,SEP,"_") Q
201 I (PXRMRT="PXRMX")!(PXRMREP="S") W !
202 ;S LIT=" patient."
203 ;I TOTAL>1 S LIT=" patients."
204 S LIT=$S(TOTAL=0:" patients.",TOTAL=1:" patient.",1:" patients.")
205 W !,"Report run on "_TOTAL_LIT
206 I PXRMREP="D" D
207 .S LIT=$S(APPL=0:" patients.",APPL=1:" patient.",1:" patients.")
208 .W !,"Applicable to "_APPL_LIT
209 Q
210 ;
211 ;Null report prints if no patients found
212NULL I PXRMSEL="L" D
213 .I PXRMFD="P" W !!,"No patient visits found"
214 .I PXRMFD="A" W !!,"No patient admissions found"
215 .I PXRMFD="C" W !!,"No current inpatient found"
216 .I PXRMFD="F" W !!,"No patient appointments found"
217 I PXRMSEL="P" W !!,"No patients found for provider(s) selected"
218 I "OT"[PXRMSEL W !!,"No patients found for team(s) selected"
219 Q
220 ;
221 ;Null report if no patients due/satisfied - detailed report only
222NONE D PAGE
223 D HEAD(0)
224 W !!,"No patients with reminders "_PXRMTX
225 Q
226 ;
227SPACER(TEXT,LENGTH) ;
228 Q
229 ;
230 ;Check for page throw
231CHECK(CNT) ;
232 I PXRMTABS="N",$Y>(IOSL-BMARG-CNT) D PAGE
233 Q
Note: See TracBrowser for help on using the repository browser.