| [1223] | 1 | C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
|
|---|
| [1232] | 2 | ;;1.0;MU PACKAGE;;;Build 19
|
|---|
| [1223] | 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
|
|---|
| [1230] | 28 | ; INITIALIZE LISTS
|
|---|
| [1232] | 29 | ; this is done so that if there are no matching patients, the patient list
|
|---|
| 30 | ; will be zeroed out
|
|---|
| [1230] | 31 | S C0QLIST("HasDemographics")=""
|
|---|
| 32 | S C0QLIST("Patient")=""
|
|---|
| 33 | S C0QLIST("HasProblem")=""
|
|---|
| 34 | S C0QLIST("HasAllergy")=""
|
|---|
| 35 | S C0QLIST("HasMed")=""
|
|---|
| [1232] | 36 | S C0QLIST("HasVitalSigns")=""
|
|---|
| 37 | S C0QLIST("HasMedOrders")=""
|
|---|
| 38 | S C0QLIST("HasSmokingStatus")=""
|
|---|
| [1223] | 39 | D ALL ; all currently admitted patients in the hospital
|
|---|
| 40 | D DIS ; all patients discharged since the reporting period began
|
|---|
| 41 | I C0QSS ZWR GRSLT
|
|---|
| [1230] | 42 | I C0QPL D ;
|
|---|
| 43 | . D FILE ; FILE THE PATIENT LISTS
|
|---|
| 44 | . D UPDATE^C0QUPDT(.G,8) ; UPDATE THE MU MEASUREMENT SET
|
|---|
| [1223] | 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | ALL ;retrieve active inpatients
|
|---|
| 48 | N WARD S WARD=""
|
|---|
| 49 | F D Q:WARD=""
|
|---|
| 50 | . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
|
|---|
| 51 | . Q:WARD=""
|
|---|
| 52 | . N WIEN S WIEN=""
|
|---|
| 53 | . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
|
|---|
| 54 | . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
|
|---|
| 55 | . . N DFN,RB S DFN=""
|
|---|
| 56 | . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
|
|---|
| 57 | . . . D DEMO
|
|---|
| 58 | . . . D PROBLEM
|
|---|
| 59 | . . . D ALLERGY
|
|---|
| 60 | . . . D MEDS
|
|---|
| [1232] | 61 | . . . D SMOKING
|
|---|
| 62 | . . . D VITALS
|
|---|
| [1223] | 63 | . . . I C0QPR D PRINT
|
|---|
| 64 | . . . I C0QSS D SS
|
|---|
| 65 | . . . I C0QPL D PATLIST
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | DEMO ; patient demographics
|
|---|
| 69 | S PTNAME=$P(^DPT(DFN,0),U) ;patient name
|
|---|
| 70 | S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
|
|---|
| 71 | S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
|
|---|
| 72 | D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
|
|---|
| 73 | S PTHRN=$P($G(VA("PID")),U) ;health record number
|
|---|
| 74 | S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
|
|---|
| 75 | I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
|
|---|
| 76 | S RACE=""
|
|---|
| 77 | F D Q:RACE=""
|
|---|
| 78 | . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
|
|---|
| 79 | . Q:'RACE
|
|---|
| 80 | . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
|
|---|
| 81 | S ETHN=""
|
|---|
| 82 | F D Q:ETHN=""
|
|---|
| 83 | . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
|
|---|
| 84 | . Q:'ETHN
|
|---|
| 85 | . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
|
|---|
| [1232] | 86 | S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
|
|---|
| [1223] | 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | PROBLEM ; PATIENT PROBLEMS
|
|---|
| 90 | D LIST^ORQQPL(.PROBL,DFN,"A")
|
|---|
| 91 | S PBCNT=""
|
|---|
| 92 | F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
|
|---|
| 93 | . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
|
|---|
| 94 | K PROBL
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | ALLERGY ; ALLERGY LIST
|
|---|
| 98 | D LIST^ORQQAL(.ALRGYL,DFN)
|
|---|
| 99 | S ALCNT=""
|
|---|
| 100 | F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
|
|---|
| 101 | . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
|
|---|
| 102 | K ALRGYL
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | MEDS ; MEDICATIONS
|
|---|
| [1232] | 106 | ;
|
|---|
| 107 | I DFN=97 D Q ;
|
|---|
| 108 | . S MDCNT=271
|
|---|
| [1223] | 109 | K MEDSL
|
|---|
| [1232] | 110 | D EN^C0CNHIN(.MEDSL,DFN,"MED;") ; GET THE MEDS FROM THE NHIN API
|
|---|
| 111 | ; can't use COVER^ORWPS even though it's fast.. we need to detect
|
|---|
| 112 | ; if the medications are Inpatient to compute the CPOE measure
|
|---|
| 113 | ; we will use the NHINV routines for this purpose
|
|---|
| 114 | ;D COVER^ORWPS(.MEDSL,DFN)
|
|---|
| 115 | S MDCNT="" S HASINP=0
|
|---|
| 116 | F S MDCNT=$O(MEDSL("med",MDCNT)) Q:MDCNT="" D
|
|---|
| 117 | . ;Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
|
|---|
| 118 | . Q:MEDSL("med",MDCNT,"status@value")'="active"
|
|---|
| 119 | . ;S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
|
|---|
| 120 | . S MDDESC=$G(MEDSL("med",MDCNT,"products.product@name"))
|
|---|
| 121 | . ;S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
|
|---|
| 122 | . S MDITEM=$G(MEDSL("med",MDCNT,"sig")) ; i think this is what meditem is
|
|---|
| 123 | . I MEDSL("med",MDCNT,"vaType@value")="I" S HASINP=1
|
|---|
| 124 | I HASINP D ; THE PATIENT HAS AN INPATIENT MED
|
|---|
| 125 | . S C0QLIST("HasMedOrders",DFN)="" ; an inpatient drug indicates CPOE
|
|---|
| 126 | E S C0QLIST("NoMedOrders",DFN)="" ; this will be different for outpatient
|
|---|
| 127 | K MEDSL
|
|---|
| [1223] | 128 | Q
|
|---|
| 129 | ;
|
|---|
| [1232] | 130 | SMOKING ;
|
|---|
| 131 | N C0QSMOKE
|
|---|
| 132 | D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
|
|---|
| 133 | ; PATIENT IN THE CATEGORY OF TOBACCO
|
|---|
| 134 | I $D(C0QSMOKE) S C0QLIST("HasSmokingStatus",DFN)=""
|
|---|
| 135 | E S C0QLIST("NoSmokingStatus",DFN)=""
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | VITALS ;
|
|---|
| 139 | ;
|
|---|
| 140 | N C0QSDT,C0QEDT
|
|---|
| 141 | D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
|
|---|
| 142 | D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
|
|---|
| 143 | D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
|
|---|
| 144 | I $D(VITRSLT) D ;ZWR VITRSLT B ;
|
|---|
| 145 | . I VITRSLT(1)["No vitals found." S C0QLIST("NoVitalSigns",DFN)=""
|
|---|
| 146 | . E S C0QLIST("HasVitalSigns",DFN)=""
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| [1223] | 149 | PRINT ; PRINT TO SCREEN
|
|---|
| 150 |
|
|---|
| 151 | I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
|
|---|
| 152 | I $D(EXDTE) D ;
|
|---|
| 153 | . W !,"Discharge Date: ",EXDTE
|
|---|
| 154 | . W !,DFN," ",PTNAME
|
|---|
| 155 | W !,"DOB: ",PTDOB," HRN: ",PTHRN
|
|---|
| 156 | W !,"Language Spoken: ",$G(PTLANG)
|
|---|
| 157 | W !,"Race: ",RACEDSC
|
|---|
| 158 | W !,"Ethnicity: ",$G(ETHNDSC)
|
|---|
| 159 | W !,"Problems: "
|
|---|
| 160 | W !,PBDESC
|
|---|
| 161 | W !,"Allergies: "
|
|---|
| 162 | W !,ALDESC
|
|---|
| 163 | W !,"Medications: "
|
|---|
| 164 | W !
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | SS ; CREATE SPREADSHEET ARRAY
|
|---|
| 168 | S G1("Patient")=DFN
|
|---|
| 169 | I $D(WARD) D ;
|
|---|
| 170 | . S G1("WardName")=WARDNAME
|
|---|
| 171 | . S G1("RoomAndBed")=RB
|
|---|
| 172 | I $D(EXDTE) D ;
|
|---|
| 173 | . S G1("DischargeDate")=EXDTE
|
|---|
| 174 | S G1("PatientName")=PTNAME
|
|---|
| 175 | S G1("Gender")=PTSEX
|
|---|
| 176 | S G1("DateOfBirth")=PTDOB
|
|---|
| 177 | S G1("HealthRecordNumber")=PTHRN
|
|---|
| 178 | S G1("LanguageSpoken")=$G(PTLANG)
|
|---|
| 179 | S G1("Race")=RACEDSC
|
|---|
| 180 | S G1("Ehtnicity")=$G(ETHNDSC)
|
|---|
| 181 | S G1("Problem")=PBDESC
|
|---|
| 182 | I PBDESC["No problems found" S G1("HasProblem")=0
|
|---|
| 183 | E S G1("HasProblem")=1
|
|---|
| 184 | S G1("Allergies")=ALDESC
|
|---|
| 185 | I ALDESC["No Allergy" S G1("HasAllergy")=0
|
|---|
| 186 | E S G1("HasAllergy")=1
|
|---|
| 187 | I $D(MDITEM) D ;
|
|---|
| 188 | . S G1("HasMed")=1
|
|---|
| 189 | E S G1("HasMed")=0
|
|---|
| 190 | S G1("MedDescription")=$G(MDDESC)
|
|---|
| 191 | I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC
|
|---|
| 192 | D RNF1TO2B^C0CRNF("GRSLT","G1")
|
|---|
| 193 | K G1
|
|---|
| 194 | Q ; DON'T WANT TO DO THE NHIN STUFF NOW
|
|---|
| 195 | ;
|
|---|
| 196 | PATLIST ; CREATE PATIENT LISTS
|
|---|
| 197 | S C0QLIST("Patient",DFN)="" ; THE PATIENT LIST
|
|---|
| 198 | N DEMOYN S DEMOYN=1
|
|---|
| 199 | I $G(PTSEX)="" S DEMOYN=0
|
|---|
| 200 | I $G(PTDOB)="" S DEMOYN=0
|
|---|
| 201 | I $G(PTHRN)="" S DEMOYN=0
|
|---|
| 202 | I $G(PTLANG)="" S DEMOYN=0
|
|---|
| 203 | I $G(RACEDSC)="" S DEMOYN=0
|
|---|
| 204 | I $G(ETHNDSC)="" S DEMOYN=0
|
|---|
| 205 | I DEMOYN S C0QLIST("HasDemographics",DFN)=""
|
|---|
| 206 | E S C0QLIST("FailedDemographics",DFN)=""
|
|---|
| 207 | ;S G1("Gender")=PTSEX
|
|---|
| 208 | ;S G1("DateOfBirth")=PTDOB
|
|---|
| 209 | ;S G1("HealthRecordNumber")=PTHRN
|
|---|
| 210 | ;S G1("LanguageSpoken")=$G(PTLANG)
|
|---|
| 211 | ;S G1("Race")=RACEDSC
|
|---|
| 212 | ;S G1("Ehtnicity")=$G(ETHNDSC)
|
|---|
| 213 | S G1("Problem")=PBDESC
|
|---|
| 214 | I PBDESC["No problems found" S C0QLIST("NoProblem",DFN)=""
|
|---|
| 215 | E S C0QLIST("HasProblem",DFN)=""
|
|---|
| 216 | ;S G1("Allergies")=ALDESC
|
|---|
| 217 | I ALDESC["No Allergy" S C0QLIST("NoAllergy",DFN)=""
|
|---|
| 218 | E S C0QLIST("HasAllergy",DFN)=""
|
|---|
| 219 | I $D(MDITEM) D ;
|
|---|
| 220 | . S C0QLIST("HasMed",DFN)=""
|
|---|
| 221 | E S G1("NoMed",DFN)=""
|
|---|
| 222 | ;S G1("MedDescription")=$G(MDDESC)
|
|---|
| 223 | Q
|
|---|
| 224 | ;
|
|---|
| 225 | NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
|
|---|
| 226 | Q:DFN=137!14
|
|---|
| 227 | D EN^C0CNHIN(.G,DFN,"")
|
|---|
| 228 | ZWR G
|
|---|
| 229 | K G
|
|---|
| 230 | ;
|
|---|
| 231 | QUIT ;end of WARD
|
|---|
| 232 | ;
|
|---|
| 233 | ;
|
|---|
| 234 | DIS;
|
|---|
| 235 | N DFN,DTE,EXDTE S DTE=""
|
|---|
| 236 | F D Q:DTE=""
|
|---|
| 237 | . S DTE=$O(^DGPM("B",DTE))
|
|---|
| 238 | . Q:'DTE
|
|---|
| 239 | . Q:DTE<3110703
|
|---|
| 240 | . S EXDTE=$$FMTE^XLFDT(DTE)
|
|---|
| 241 | . N PTFM S PTFM=""
|
|---|
| 242 | . D
|
|---|
| 243 | . . S PTFM=$O(^DGPM("B",DTE,PTFM))
|
|---|
| 244 | . . Q:'PTFM
|
|---|
| 245 | . . S DFN=$P(^DGPM(PTFM,0),U,3)
|
|---|
| 246 | . . D DEMO
|
|---|
| 247 | . . D PROBLEM
|
|---|
| 248 | . . D ALLERGY
|
|---|
| 249 | . . D MEDS
|
|---|
| [1232] | 250 | . . D SMOKING
|
|---|
| 251 | . . D VITALS
|
|---|
| [1223] | 252 | . . I C0QPR D PRINT
|
|---|
| 253 | . . I C0QSS D SS
|
|---|
| 254 | . . I C0QPL D PATLIST
|
|---|
| 255 | Q
|
|---|
| 256 | ;
|
|---|
| 257 | C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
|
|---|
| 258 | C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
|
|---|
| 259 | FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
|
|---|
| 260 | ;
|
|---|
| 261 | I '$D(C0QLIST) Q ;
|
|---|
| 262 | N LFN S LFN=$$C0QALFN()
|
|---|
| 263 | N ZI,ZN
|
|---|
| 264 | S ZI=""
|
|---|
| 265 | F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
|
|---|
| 266 | . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
|
|---|
| 267 | . I ZN="" D Q ; OOPS
|
|---|
| 268 | . . W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
|
|---|
| [1230] | 269 | . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
|
|---|
| 270 | . N C0QNEW,C0QOLD,C0QRSLT
|
|---|
| 271 | . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
|
|---|
| 272 | . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
|
|---|
| 273 | . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
|
|---|
| 274 | . N ZJ,ZK
|
|---|
| 275 | . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
|
|---|
| [1223] | 276 | . K C0QFDA
|
|---|
| [1230] | 277 | . S ZJ=""
|
|---|
| 278 | . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY
|
|---|
| 279 | . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
|
|---|
| 280 | . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN
|
|---|
| 281 | . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
|
|---|
| 282 | . . . B
|
|---|
| 283 | . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
|
|---|
| 284 | . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
|
|---|
| 285 | . ; SECOND, PROCESS THE ADDITIONS
|
|---|
| 286 | . K C0QFDA
|
|---|
| 287 | . S ZJ="" S ZK=1
|
|---|
| 288 | . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0
|
|---|
| 289 | . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
|
|---|
| 290 | . . S ZK=ZK+1
|
|---|
| 291 | . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
|
|---|
| 292 | ;. Q
|
|---|
| 293 | ;. K C0QFDA
|
|---|
| 294 | ;. N ZJ,ZC
|
|---|
| 295 | ;. S ZJ="" S ZC=1
|
|---|
| 296 | ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
|
|---|
| 297 | ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
|
|---|
| 298 | ;. . S ZC=ZC+1
|
|---|
| 299 | ;. D UPDIE
|
|---|
| 300 | ;. W !,"FOUND:"_ZI
|
|---|
| [1223] | 301 | Q
|
|---|
| 302 | ;
|
|---|
| 303 | KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
|
|---|
| 304 | ;
|
|---|
| 305 | N C0QFDA,ZFN,LIST,ATTR
|
|---|
| 306 | S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
|
|---|
| 307 | D CLEAN^DILF
|
|---|
| 308 | S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
|
|---|
| 309 | S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
|
|---|
| 310 | D CLEAN^DILF
|
|---|
| 311 | K ZERR
|
|---|
| 312 | S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
|
|---|
| 313 | D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
|
|---|
| 314 | I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
|
|---|
| 315 | ;. W "ERROR",!
|
|---|
| 316 | ;. ZWR ZERR
|
|---|
| 317 | ;. B
|
|---|
| 318 | K C0QFDA
|
|---|
| 319 | S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
|
|---|
| 320 | S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
|
|---|
| 321 | D UPDIE ; CREATE THE SUBFILE
|
|---|
| 322 | N ZR ; NEW IEN FOR THE RECORD
|
|---|
| 323 | S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
|
|---|
| 324 | ;
|
|---|
| 325 | Q ZR
|
|---|
| 326 | ;
|
|---|
| 327 | UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
|---|
| 328 | K ZERR
|
|---|
| 329 | D CLEAN^DILF
|
|---|
| 330 | D UPDATE^DIE("","C0QFDA","","ZERR")
|
|---|
| 331 | I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
|
|---|
| 332 | ;. W "ERROR",!
|
|---|
| 333 | ;. ZWR ZERR
|
|---|
| 334 | ;. B
|
|---|
| 335 | K C0QFDA
|
|---|
| 336 | Q
|
|---|
| 337 | ;
|
|---|
| 338 | ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
|
|---|
| 339 | ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
|
|---|
| 340 | ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
|
|---|
| 341 | ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
|
|---|
| 342 | ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
|
|---|
| 343 | ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
|
|---|
| 344 | ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
|
|---|
| 345 | ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
|
|---|
| 346 | ;. . S RACE=""
|
|---|
| 347 | ;. . F D Q:RACE=""
|
|---|
| 348 | ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
|
|---|
| 349 | ;. . . Q:'RACE
|
|---|
| 350 | ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
|
|---|
| 351 | ;. . N ETHNDSC
|
|---|
| 352 | ;. . N ETHNDSC S ETHNDSC=""
|
|---|
| 353 | ;. . S ETHN=""
|
|---|
| 354 | ;. . F D Q:ETHN=""
|
|---|
| 355 | ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
|
|---|
| 356 | ;. . . Q:'ETHN
|
|---|
| 357 | ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
|
|---|
| 358 | ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
|
|---|
| 359 | ;. . S PBCNT=""
|
|---|
| 360 | ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
|
|---|
| 361 | ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
|
|---|
| 362 | ;. . K PROBL
|
|---|
| 363 | ;. . D LIST^ORQQAL(.ALRGYL,DFN)
|
|---|
| 364 | ;. . S ALCNT=""
|
|---|
| 365 | ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
|
|---|
| 366 | ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
|
|---|
| 367 | ;. . K ALRGYL
|
|---|
| 368 | ;. . D COVER^ORWPS(.MEDSL,DFN)
|
|---|
| 369 | ;. . S MDCNT=""
|
|---|
| 370 | ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
|
|---|
| 371 | ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
|
|---|
| 372 | ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
|
|---|
| 373 | ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
|
|---|
| 374 | ;. . K MEDSL
|
|---|
| 375 | ;. . W !,"Discharge Date: ",EXDTE
|
|---|
| 376 | ;. . W !,DFN," ",PTNAME
|
|---|
| 377 | ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
|
|---|
| 378 | ;. . W !,"Language Spoken: ",$G(PTLANG)
|
|---|
| 379 | ;. . W !,"Race: ",RACEDSC
|
|---|
| 380 | ;. . W !,"Ethnicity: ",ETHNDSC
|
|---|
| 381 | ;. . W !,"Problems: "
|
|---|
| 382 | ;. . W !,PBDESC
|
|---|
| 383 | ;. . W !,"Allergies: "
|
|---|
| 384 | ;. . W !,ALDESC
|
|---|
| 385 | ;. . W !,"Medications: "
|
|---|
| 386 | ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC
|
|---|
| 387 | ;. . W !
|
|---|
| 388 | ;Q
|
|---|
| 389 | ;
|
|---|
| 390 | ;
|
|---|
| 391 | ;
|
|---|
| 392 | ;
|
|---|
| 393 | END ;end of C0QPRML;
|
|---|
