Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGPR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXGPR.m
r613 r623 1 PXRMXGPR ; SLC/PJH - Reminder Due print calls ;11/16/20072 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 4 5 6 7 HEAD(PSTART) 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 CRIT(PSTART,PLSTCRIT) 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 DISP(CNT,PLSTCRIT) 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 OSCAT(SCL,PSTART,CNT,PLSTCRIT) 147 148 149 150 151 152 153 154 155 156 157 158 COL(NEWPAGE) 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 PAGE I ($E(IOST,1,2)="C-")&(IO=IO(0))&(PAGE>0) D177 178 179 180 181 182 183 I $E(IOST,1,2)="C-",IO=IO(0) W @IOF184 185 186 187 188 189 190 191 192 193 194 195 196 197 TOTAL 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 NULL 213 214 215 216 217 218 219 220 221 222 NONE 223 224 225 226 227 SPACER(TEXT,LENGTH) 228 229 230 231 CHECK(CNT) 232 233 1 PXRMXGPR ; 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 7 HEAD(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 42 CRIT(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 110 DISP(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 146 OSCAT(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 158 COL(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 176 PAGE 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 197 TOTAL 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 212 NULL 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 222 NONE D PAGE 223 D HEAD(0) 224 W !!,"No patients with reminders "_PXRMTX 225 Q 226 ; 227 SPACER(TEXT,LENGTH) ; 228 Q 229 ; 230 ;Check for page throw 231 CHECK(CNT) ; 232 I PXRMTABS="N",$Y>(IOSL-BMARG-CNT) D PAGE 233 Q
Note:
See TracChangeset
for help on using the changeset viewer.
