| 1 | C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
|
|---|
| 2 | ;;1.0;MU PACKAGE;;;Build 13
|
|---|
| 3 | ;
|
|---|
| 4 | ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
|
|---|
| 5 | ;General Public License See attached copy of the License.
|
|---|
| 6 | ;
|
|---|
| 7 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 8 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 9 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 10 | ;(at your option) any later version.
|
|---|
| 11 | ;
|
|---|
| 12 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 13 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 14 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 15 | ;GNU General Public License for more details.
|
|---|
| 16 | ;
|
|---|
| 17 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 18 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 19 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| 20 | ;
|
|---|
| 21 | BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
|
|---|
| 22 | ; patient lists
|
|---|
| 23 | ;N GRSLT ; ARRAY FOR RESULTS
|
|---|
| 24 | I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
|
|---|
| 25 | I '$D(C0QPR) S C0QPR=0 ;default don't print out results
|
|---|
| 26 | I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
|
|---|
| 27 | N G1 ; ONE SET OF VALUES - RNF1 FORMAT
|
|---|
| 28 | D ALL ; all currently admitted patients in the hospital
|
|---|
| 29 | D DIS ; all patients discharged since the reporting period began
|
|---|
| 30 | I C0QSS ZWR GRSLT
|
|---|
| 31 | I C0QPL D FILE ; FILE THE PATIENT LISTS
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ALL ;retrieve active inpatients
|
|---|
| 35 | N WARD S WARD=""
|
|---|
| 36 | F D Q:WARD=""
|
|---|
| 37 | . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
|
|---|
| 38 | . Q:WARD=""
|
|---|
| 39 | . N WIEN S WIEN=""
|
|---|
| 40 | . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
|
|---|
| 41 | . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
|
|---|
| 42 | . . N DFN,RB S DFN=""
|
|---|
| 43 | . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
|
|---|
| 44 | . . . D DEMO
|
|---|
| 45 | . . . D PROBLEM
|
|---|
| 46 | . . . D ALLERGY
|
|---|
| 47 | . . . D MEDS
|
|---|
| 48 | . . . I C0QPR D PRINT
|
|---|
| 49 | . . . I C0QSS D SS
|
|---|
| 50 | . . . I C0QPL D PATLIST
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | DEMO ; patient demographics
|
|---|
| 54 | S PTNAME=$P(^DPT(DFN,0),U) ;patient name
|
|---|
| 55 | S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
|
|---|
| 56 | S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
|
|---|
| 57 | D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
|
|---|
| 58 | S PTHRN=$P($G(VA("PID")),U) ;health record number
|
|---|
| 59 | S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
|
|---|
| 60 | I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
|
|---|
| 61 | S RACE=""
|
|---|
| 62 | F D Q:RACE=""
|
|---|
| 63 | . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
|
|---|
| 64 | . Q:'RACE
|
|---|
| 65 | . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
|
|---|
| 66 | S ETHN=""
|
|---|
| 67 | F D Q:ETHN=""
|
|---|
| 68 | . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
|
|---|
| 69 | . Q:'ETHN
|
|---|
| 70 | . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
|
|---|
| 71 | S RB=$P(^DPT(DFN,.101),U) ;room and bed
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | PROBLEM ; PATIENT PROBLEMS
|
|---|
| 75 | D LIST^ORQQPL(.PROBL,DFN,"A")
|
|---|
| 76 | S PBCNT=""
|
|---|
| 77 | F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
|
|---|
| 78 | . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
|
|---|
| 79 | K PROBL
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | ALLERGY ; ALLERGY LIST
|
|---|
| 83 | D LIST^ORQQAL(.ALRGYL,DFN)
|
|---|
| 84 | S ALCNT=""
|
|---|
| 85 | F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
|
|---|
| 86 | . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
|
|---|
| 87 | K ALRGYL
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | MEDS ; MEDICATIONS
|
|---|
| 91 | D COVER^ORWPS(.MEDSL,DFN)
|
|---|
| 92 | S MDCNT=""
|
|---|
| 93 | F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
|
|---|
| 94 | . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
|
|---|
| 95 | . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
|
|---|
| 96 | . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
|
|---|
| 97 | K MEDSL
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | PRINT ; PRINT TO SCREEN
|
|---|
| 101 |
|
|---|
| 102 | I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
|
|---|
| 103 | I $D(EXDTE) D ;
|
|---|
| 104 | . W !,"Discharge Date: ",EXDTE
|
|---|
| 105 | . W !,DFN," ",PTNAME
|
|---|
| 106 | W !,"DOB: ",PTDOB," HRN: ",PTHRN
|
|---|
| 107 | W !,"Language Spoken: ",$G(PTLANG)
|
|---|
| 108 | W !,"Race: ",RACEDSC
|
|---|
| 109 | W !,"Ethnicity: ",$G(ETHNDSC)
|
|---|
| 110 | W !,"Problems: "
|
|---|
| 111 | W !,PBDESC
|
|---|
| 112 | W !,"Allergies: "
|
|---|
| 113 | W !,ALDESC
|
|---|
| 114 | W !,"Medications: "
|
|---|
| 115 | W !
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | SS ; CREATE SPREADSHEET ARRAY
|
|---|
| 119 | S G1("Patient")=DFN
|
|---|
| 120 | I $D(WARD) D ;
|
|---|
| 121 | . S G1("WardName")=WARDNAME
|
|---|
| 122 | . S G1("RoomAndBed")=RB
|
|---|
| 123 | I $D(EXDTE) D ;
|
|---|
| 124 | . S G1("DischargeDate")=EXDTE
|
|---|
| 125 | S G1("PatientName")=PTNAME
|
|---|
| 126 | S G1("Gender")=PTSEX
|
|---|
| 127 | S G1("DateOfBirth")=PTDOB
|
|---|
| 128 | S G1("HealthRecordNumber")=PTHRN
|
|---|
| 129 | S G1("LanguageSpoken")=$G(PTLANG)
|
|---|
| 130 | S G1("Race")=RACEDSC
|
|---|
| 131 | S G1("Ehtnicity")=$G(ETHNDSC)
|
|---|
| 132 | S G1("Problem")=PBDESC
|
|---|
| 133 | I PBDESC["No problems found" S G1("HasProblem")=0
|
|---|
| 134 | E S G1("HasProblem")=1
|
|---|
| 135 | S G1("Allergies")=ALDESC
|
|---|
| 136 | I ALDESC["No Allergy" S G1("HasAllergy")=0
|
|---|
| 137 | E S G1("HasAllergy")=1
|
|---|
| 138 | I $D(MDITEM) D ;
|
|---|
| 139 | . S G1("HasMed")=1
|
|---|
| 140 | E S G1("HasMed")=0
|
|---|
| 141 | S G1("MedDescription")=$G(MDDESC)
|
|---|
| 142 | I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC
|
|---|
| 143 | D RNF1TO2B^C0CRNF("GRSLT","G1")
|
|---|
| 144 | K G1
|
|---|
| 145 | Q ; DON'T WANT TO DO THE NHIN STUFF NOW
|
|---|
| 146 | ;
|
|---|
| 147 | PATLIST ; CREATE PATIENT LISTS
|
|---|
| 148 | S C0QLIST("Patient",DFN)="" ; THE PATIENT LIST
|
|---|
| 149 | N DEMOYN S DEMOYN=1
|
|---|
| 150 | I $G(PTSEX)="" S DEMOYN=0
|
|---|
| 151 | I $G(PTDOB)="" S DEMOYN=0
|
|---|
| 152 | I $G(PTHRN)="" S DEMOYN=0
|
|---|
| 153 | I $G(PTLANG)="" S DEMOYN=0
|
|---|
| 154 | I $G(RACEDSC)="" S DEMOYN=0
|
|---|
| 155 | I $G(ETHNDSC)="" S DEMOYN=0
|
|---|
| 156 | I DEMOYN S C0QLIST("HasDemographics",DFN)=""
|
|---|
| 157 | E S C0QLIST("FailedDemographics",DFN)=""
|
|---|
| 158 | ;S G1("Gender")=PTSEX
|
|---|
| 159 | ;S G1("DateOfBirth")=PTDOB
|
|---|
| 160 | ;S G1("HealthRecordNumber")=PTHRN
|
|---|
| 161 | ;S G1("LanguageSpoken")=$G(PTLANG)
|
|---|
| 162 | ;S G1("Race")=RACEDSC
|
|---|
| 163 | ;S G1("Ehtnicity")=$G(ETHNDSC)
|
|---|
| 164 | S G1("Problem")=PBDESC
|
|---|
| 165 | I PBDESC["No problems found" S C0QLIST("NoProblem",DFN)=""
|
|---|
| 166 | E S C0QLIST("HasProblem",DFN)=""
|
|---|
| 167 | ;S G1("Allergies")=ALDESC
|
|---|
| 168 | I ALDESC["No Allergy" S C0QLIST("NoAllergy",DFN)=""
|
|---|
| 169 | E S C0QLIST("HasAllergy",DFN)=""
|
|---|
| 170 | I $D(MDITEM) D ;
|
|---|
| 171 | . S C0QLIST("HasMed",DFN)=""
|
|---|
| 172 | E S G1("NoMed",DFN)=""
|
|---|
| 173 | ;S G1("MedDescription")=$G(MDDESC)
|
|---|
| 174 | Q
|
|---|
| 175 | ;
|
|---|
| 176 | NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
|
|---|
| 177 | Q:DFN=137!14
|
|---|
| 178 | D EN^C0CNHIN(.G,DFN,"")
|
|---|
| 179 | ZWR G
|
|---|
| 180 | K G
|
|---|
| 181 | ;
|
|---|
| 182 | QUIT ;end of WARD
|
|---|
| 183 | ;
|
|---|
| 184 | ;
|
|---|
| 185 | DIS;
|
|---|
| 186 | N DFN,DTE,EXDTE S DTE=""
|
|---|
| 187 | F D Q:DTE=""
|
|---|
| 188 | . S DTE=$O(^DGPM("B",DTE))
|
|---|
| 189 | . Q:'DTE
|
|---|
| 190 | . Q:DTE<3110703
|
|---|
| 191 | . S EXDTE=$$FMTE^XLFDT(DTE)
|
|---|
| 192 | . N PTFM S PTFM=""
|
|---|
| 193 | . D
|
|---|
| 194 | . . S PTFM=$O(^DGPM("B",DTE,PTFM))
|
|---|
| 195 | . . Q:'PTFM
|
|---|
| 196 | . . S DFN=$P(^DGPM(PTFM,0),U,3)
|
|---|
| 197 | . . D DEMO
|
|---|
| 198 | . . D PROBLEM
|
|---|
| 199 | . . D ALLERGY
|
|---|
| 200 | . . D MEDS
|
|---|
| 201 | . . I C0QPR D PRINT
|
|---|
| 202 | . . I C0QSS D SS
|
|---|
| 203 | . . I C0QPL D PATLIST
|
|---|
| 204 | Q
|
|---|
| 205 | ;
|
|---|
| 206 | C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
|
|---|
| 207 | C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
|
|---|
| 208 | FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
|
|---|
| 209 | ;
|
|---|
| 210 | I '$D(C0QLIST) Q ;
|
|---|
| 211 | N LFN S LFN=$$C0QALFN()
|
|---|
| 212 | N ZI,ZN
|
|---|
| 213 | S ZI=""
|
|---|
| 214 | F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
|
|---|
| 215 | . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
|
|---|
| 216 | . I ZN="" D Q ; OOPS
|
|---|
| 217 | . . W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
|
|---|
| 218 | . S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
|
|---|
| 219 | . K C0QFDA
|
|---|
| 220 | . N ZJ,ZC
|
|---|
| 221 | . S ZJ="" S ZC=1
|
|---|
| 222 | . F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
|
|---|
| 223 | . . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
|
|---|
| 224 | . . S ZC=ZC+1
|
|---|
| 225 | . D UPDIE
|
|---|
| 226 | . W !,"FOUND:"_ZI
|
|---|
| 227 | Q
|
|---|
| 228 | ;
|
|---|
| 229 | KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
|
|---|
| 230 | ;
|
|---|
| 231 | N C0QFDA,ZFN,LIST,ATTR
|
|---|
| 232 | S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
|
|---|
| 233 | D CLEAN^DILF
|
|---|
| 234 | S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
|
|---|
| 235 | S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
|
|---|
| 236 | D CLEAN^DILF
|
|---|
| 237 | K ZERR
|
|---|
| 238 | S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
|
|---|
| 239 | D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
|
|---|
| 240 | I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
|
|---|
| 241 | ;. W "ERROR",!
|
|---|
| 242 | ;. ZWR ZERR
|
|---|
| 243 | ;. B
|
|---|
| 244 | K C0QFDA
|
|---|
| 245 | S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
|
|---|
| 246 | S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
|
|---|
| 247 | D UPDIE ; CREATE THE SUBFILE
|
|---|
| 248 | N ZR ; NEW IEN FOR THE RECORD
|
|---|
| 249 | S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
|
|---|
| 250 | ;
|
|---|
| 251 | Q ZR
|
|---|
| 252 | ;
|
|---|
| 253 | UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
|---|
| 254 | K ZERR
|
|---|
| 255 | D CLEAN^DILF
|
|---|
| 256 | D UPDATE^DIE("","C0QFDA","","ZERR")
|
|---|
| 257 | I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
|
|---|
| 258 | ;. W "ERROR",!
|
|---|
| 259 | ;. ZWR ZERR
|
|---|
| 260 | ;. B
|
|---|
| 261 | K C0QFDA
|
|---|
| 262 | Q
|
|---|
| 263 | ;
|
|---|
| 264 | ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
|
|---|
| 265 | ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
|
|---|
| 266 | ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
|
|---|
| 267 | ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
|
|---|
| 268 | ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
|
|---|
| 269 | ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
|
|---|
| 270 | ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
|
|---|
| 271 | ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
|
|---|
| 272 | ;. . S RACE=""
|
|---|
| 273 | ;. . F D Q:RACE=""
|
|---|
| 274 | ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
|
|---|
| 275 | ;. . . Q:'RACE
|
|---|
| 276 | ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
|
|---|
| 277 | ;. . N ETHNDSC
|
|---|
| 278 | ;. . N ETHNDSC S ETHNDSC=""
|
|---|
| 279 | ;. . S ETHN=""
|
|---|
| 280 | ;. . F D Q:ETHN=""
|
|---|
| 281 | ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
|
|---|
| 282 | ;. . . Q:'ETHN
|
|---|
| 283 | ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
|
|---|
| 284 | ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
|
|---|
| 285 | ;. . S PBCNT=""
|
|---|
| 286 | ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
|
|---|
| 287 | ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
|
|---|
| 288 | ;. . K PROBL
|
|---|
| 289 | ;. . D LIST^ORQQAL(.ALRGYL,DFN)
|
|---|
| 290 | ;. . S ALCNT=""
|
|---|
| 291 | ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
|
|---|
| 292 | ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
|
|---|
| 293 | ;. . K ALRGYL
|
|---|
| 294 | ;. . D COVER^ORWPS(.MEDSL,DFN)
|
|---|
| 295 | ;. . S MDCNT=""
|
|---|
| 296 | ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
|
|---|
| 297 | ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
|
|---|
| 298 | ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
|
|---|
| 299 | ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
|
|---|
| 300 | ;. . K MEDSL
|
|---|
| 301 | ;. . W !,"Discharge Date: ",EXDTE
|
|---|
| 302 | ;. . W !,DFN," ",PTNAME
|
|---|
| 303 | ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
|
|---|
| 304 | ;. . W !,"Language Spoken: ",$G(PTLANG)
|
|---|
| 305 | ;. . W !,"Race: ",RACEDSC
|
|---|
| 306 | ;. . W !,"Ethnicity: ",ETHNDSC
|
|---|
| 307 | ;. . W !,"Problems: "
|
|---|
| 308 | ;. . W !,PBDESC
|
|---|
| 309 | ;. . W !,"Allergies: "
|
|---|
| 310 | ;. . W !,ALDESC
|
|---|
| 311 | ;. . W !,"Medications: "
|
|---|
| 312 | ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC
|
|---|
| 313 | ;. . W !
|
|---|
| 314 | ;Q
|
|---|
| 315 | ;
|
|---|
| 316 | ;
|
|---|
| 317 | ;
|
|---|
| 318 | ;
|
|---|
| 319 | END ;end of C0QPRML;
|
|---|
