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