Changeset 1501 for qrda/C0Q/trunk/p
- Timestamp:
- Aug 2, 2012, 8:59:21 PM (12 years ago)
- Location:
- qrda/C0Q/trunk/p
- Files:
-
- 2 added
- 14 edited
-
C0QERTIM.m (modified) (1 diff)
-
C0QGMRAD.m (modified) (1 diff)
-
C0QGMTSA.m (modified) (1 diff)
-
C0QGMTSG.m (modified) (1 diff)
-
C0QHF.m (modified) (1 diff)
-
C0QIMMUN.m (modified) (1 diff)
-
C0QINIT.m (modified) (2 diffs)
-
C0QKIDS.m (modified) (4 diffs)
-
C0QMAIN.m (modified) (1 diff)
-
C0QMU12.m (modified) (12 diffs)
-
C0QMU121.m (added)
-
C0QMU122.m (added)
-
C0QNOTES.m (modified) (2 diffs)
-
C0QPQRI.m (modified) (1 diff)
-
C0QSET.m (modified) (3 diffs)
-
C0QUTIL.m (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
qrda/C0Q/trunk/p/C0QERTIM.m
r1438 r1501 1 1 C0QERTIM ; Time from admission to leaving a hospital location ; 5/23/12 2:26pm 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 EN ;Get Location 4 4 S DIC=42,DIC(0)="AEMQ" D ^DIC I Y<1 G EXIT -
qrda/C0Q/trunk/p/C0QGMRAD.m
r1438 r1501 1 1 C0QGMRAD ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;1/15/98 13:47 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 EN1 ; ENTRY TO GATHER PATIENT A/AR DATA 4 4 ;INPUT VARIABLES: -
qrda/C0Q/trunk/p/C0QGMTSA.m
r1438 r1501 1 1 C0QGMTSA ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QGMTSG.m
r1438 r1501 1 1 C0QGMTSG ; SLC/DLT,KER - Allergies ; 01/06/2003 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QHF.m
r1438 r1501 1 1 C0QHF ; GPL - Health Factor Utility Routines ;9/02/11 17:05 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QIMMUN.m
r1438 r1501 1 1 C0QIMMUN ;Prep Immunization Order data for HL7 Message creation ; 5/23/12 5:40pm 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; ^XTMP("C0QIMMUN",0)=purge date^create date 4 4 ; ^XTMP("C0QIMMUN",order_date,order#,item_name)=item_value -
qrda/C0Q/trunk/p/C0QINIT.m
r1438 r1501 1 C0QINIT ; GPL - Quality Reporting Initialization Routines ; 5/23/12 5:43pm2 ;;1.0;C0Q;;May 21, 2012;Build 431 C0QINIT ; GPL - Quality Reporting Initialization Routines ; 7/31/12 8:16am 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. … … 64 64 K ZERR 65 65 D CLEAN^DILF 66 ZWRITE C0QFDA66 D ZWRITE^C0QUTIL("C0QFDA") 67 67 D UPDATE^DIE("","C0QFDA","","ZERR") 68 68 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, -
qrda/C0Q/trunk/p/C0QKIDS.m
r1484 r1501 1 C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/ 13/12 11:49am2 ;;1.0;C0Q;;May 21, 2012;Build 471 C0QKIDS ; VEN/SMH - Kids Utilities for transporting C0Q data ; 7/31/12 3:01pm 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; Licensed under package license. See Documentation. 4 4 ; 5 ; PEPs: PRE, TRAN, POST 6 ; 7 PRE ; Unified Pre; PEP 8 QUIT 5 ; PEPs: TRAN, POST, PRE 6 ; 9 7 TRAN ; Unified Transport; PEP 10 8 ; D TRAN301 ; looks like I won't send that file over 11 D TRAN201 9 D TRAN201 ; C0Q MEASUREMENT 10 D TRAN101 ; C0Q QUALITY MEASURE 12 11 QUIT 13 12 POST ; Unified Post; PEP 14 13 ; D POST301 ; looks like I won't send that file over 15 D POST101 16 D POST201 14 ; D POST101 ; C0Q QUALITY MEASURE ; As of T11, I won't do that anymore. --> 15 ; I discovered that it will do it on destination systems that are set-up. 16 ; So bad bad bad idea for me to do it in a post-init. 17 ; ... I wrote TRAN101 to do the function of POST101. 18 D POST201 ; C0Q MEASUREMENT 19 QUIT 20 ; 21 PRE ; Unified Pre; PEP 22 D PRE101 17 23 QUIT 18 24 ; 19 25 ; << >> 20 26 ; 27 TRAN101 ; Remove Untransportable pointers in C0Q QUALITY MEASURE; Private EP 28 ; NB: I am reaching into KIDS's data here. This may not work for future versions 29 ; of KIDS. However, I am exporting this only; once exported, it should work in 30 ; any version of KIDS. 31 N XPDIEN S XPDIEN=$QS(XPDGREF,2) ; Get IEN of KIDS Transport Global 32 N X S X=$NA(^XTMP("XPDT",XPDIEN,"DATA",1130580001.101)) ; KIDS transports our data here 33 N IEN S IEN=0 ; Looper 34 F S IEN=$O(@X@(IEN)) Q:'IEN D ; For each IEN, remove the following: 35 . S $P(@X@(IEN,0),U,2)="" ; Numerator Patient List 36 . S $P(@X@(IEN,0),U,3)="" ; Denominator Patient List 37 . S $P(@X@(IEN,7),U,4)="" ; Negative Numerator List 38 . S $P(@X@(IEN,7),U,2)="" ; Alternate Numerator List 39 . S $P(@X@(IEN,7),U,3)="" ; Alternate Denominator List 40 . S $P(@X@(IEN,7),U,5)="" ; Alternate Negative Numerator List 41 QUIT 42 ; 21 43 TRAN301 ; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP 44 ; Not used. Dead code. 22 45 N C0QIEN S C0QIEN=0 ; IEN walker 23 46 N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference … … 56 79 ; 57 80 POST201 ; File FDA for 201; Private EP 81 ; 82 ; Clean-up data if it already exists! 83 ; ZWRITE ^C0Q(201,:,5,:,0) 84 ; ^C0Q(201,1,5,599,0)=50 85 ; ^C0Q(201,1,5,600,0)=4 86 ; ^C0Q(201,1,5,601,0)=39 87 ; ^C0Q(201,1,5,602,0)=6 88 ; ^C0Q(201,1,5,603,0)=7 89 ; ^C0Q(201,1,5,604,0)=48 90 ; ^C0Q(201,1,5,605,0)=46 91 ; 58 92 IF $O(^C0Q(201,0)) DO QUIT ; Quit if data is already there. 59 93 . D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data") 94 . D MES^XPDUTL("Cleaning up broken pointers in C0Q MEASUREMENTS from deleted data in C0Q QUALITY MEASURE") 95 . ; This is very hairy code. Run through the 5 multiple in C0Q MEASUREMENT 96 . ; Grab the IEN in the .01, check if it exists; if not, kill. 97 . N DA,DIK ; DIK Variables; as well as our looper variables 98 . S (DA,DA(1))=0 ; Initial looper values 99 . F S DA(1)=$O(^C0Q(201,DA(1))) Q:'DA(1) D ; Loop through entries 100 . . D MES^XPDUTL("...Processing entry "_$P(^C0Q(201,DA(1),0),U)) ; msg 101 . . S DIK="^C0Q(201,"_DA(1)_",5," ; deletion root for the next loop 102 . . F S DA=$O(^C0Q(201,DA(1),5,DA)) Q:'DA D ; For each Measure 103 . . . N IEN S IEN=+^C0Q(201,DA(1),5,DA,0) ; Get IEN 104 . . . I IEN,'$D(^C0Q(101,IEN)) D ; If IEN is numeric, IEN exists in dest file 105 . . . . D MES^XPDUTL("......Deleting broken pointer "_IEN) ; msg 106 . . . . D ^DIK ; delete 107 ; 108 ; If new install, add data 60 109 ; 61 110 D MES^XPDUTL("Adding data to C0Q MEASUREMENTS") … … 70 119 ; 71 120 POST301 ; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP 121 ; Not used. Dead code. 72 122 N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference 73 123 N C0QERR ; Error … … 79 129 QUIT 80 130 ; 81 POST101 ; Clean transported data from broken pointers in C0Q QUALITY MEASURE in destination systems; Private EP 82 D MES^XPDUTL("Cleaning C0Q QUALITY MEASURE data") 83 N C0QIEN S C0QIEN=0 ; Ien looper 84 N C0QFDA ; Fileman Data Array 85 F S C0QIEN=$O(^C0Q(101,C0QIEN)) Q:'+C0QIEN DO ; For each record, delete these fields 86 . S C0QFDA(1130580001.101,C0QIEN_",",1)="@" ; NUMERATOR PATIENT LIST 87 . S C0QFDA(1130580001.101,C0QIEN_",",1.5)="@" ; NEGATIVE NUMERATOR LIST 88 . S C0QFDA(1130580001.101,C0QIEN_",",2)="@" ; DENOMINATOR PATIENT LIST 89 . ; --- 90 . ; I wasn't planning on emptying these out, but the IENs in desintation systems may be different 91 . ; so it is best to remove them for now. It's a pointer field, so IENs are important. 92 . ; Desination file is populated automatically, but only at the site, and only after config. 93 . ; So we can't really ship the pointers as part of the install. 94 . ; --- 95 . S C0QFDA(1130580001.101,C0QIEN_",",1.1)="@" ; ALTERNATIVE NUMERATOR LIST 96 . S C0QFDA(1130580001.101,C0QIEN_",",1.51)="@" ; ALTERNATE NEGATIVE NUM LIST 97 . S C0QFDA(1130580001.101,C0QIEN_",",2.1)="@" ; ALTERNATIVE DENOMINATOR LIST 98 N C0QERR ; Errors 99 D FILE^DIE("","C0QFDA","C0QERR") ; Do it! 100 I $D(C0QERR) D ; if there's an error, print it out 101 . D MES^XPDUTL("Couldn't fix data into C0Q QUALITY MEASURE file") 102 . S C0QERR=$Q(C0QERR) 103 . F S C0QERR=$Q(@C0QERR) Q:C0QERR="" D MES^XPDUTL(C0QERR_": "_@C0QERR) 104 QUIT 105 ; 106 ; Code below taken from PXRMP15I 107 ;=============================================================== 131 PRE101 ; Clean existing data (from an earlier installation) from measures that are now merged to other measures 132 ; in C0Q QUALITY MEASURE in destination systems; Private EP 133 ; 134 ; Quit if C0Q Quality Measures isn't on the system. 135 Q:'$D(^C0Q(101)) 136 ; 137 D MES^XPDUTL("Removing subsumed entries in C0Q QUALITY MEASURE") 138 ; 139 ; .01 field values to for records to remove 140 N C0QLIST 141 S C0QLIST("TEST M0028A")="" 142 S C0QLIST("MU EP 0028B")="" 143 S C0QLIST("M0013")="" 144 S C0QLIST("M0024")="" 145 S C0QLIST("M1")="" 146 S C0QLIST("M3")="" 147 S C0QLIST("M2")="" 148 S C0QLIST("M0028")="" 149 S C0QLIST("M111")="" 150 S C0QLIST("M112")="" 151 S C0QLIST("M113")="" 152 S C0QLIST("M128")="" 153 S C0QLIST("M5")="" 154 S C0QLIST("M7")="" 155 S C0QLIST("M0022")="" 156 S C0QLIST("12")="" 157 S C0QLIST("M0038")="" 158 S C0QLIST("M110")="" 159 S C0QLIST("MU EP NQF 0070")="" 160 ; 161 ; Root for ^DIK 162 N DIK S DIK="^C0Q(101," 163 ; 164 ; Loop through list, find IEN for each one, kill off 165 N C0QITEM S C0QITEM="" ; Item 166 F S C0QITEM=$O(C0QLIST(C0QITEM)) Q:C0QITEM="" D ; Loop 167 . Q:'$DATA(^C0Q(101,"B",C0QITEM)) ; Quit if not present. 168 . N DA S DA=$O(^C0Q(101,"B",C0QITEM,"")) ; IEN 169 . ; The original software has MU EP NQF 0070 incorrectly. If the 1 node 170 . ; has Pneumonia, we want to remove that entry. 171 . I C0QITEM="MU EP NQF 0070",^C0Q(101,DA,1)'["Pneumonia" QUIT 172 . D MES^XPDUTL("...Removing "_C0QITEM) ; Message to user 173 . D ^DIK ; Delete 174 ; 175 REN ; Rename a bunch of entries 176 ; ("OLD NAME")="NEW NAME" 177 D MES^XPDUTL("Renaming Old entries in C0Q QUALITY MEASURE") 178 ; 179 N C0QLIST 180 S C0QLIST("NQF0038 NUM1 DPT")="MU EP NQF 0038 NUM1 DPT" 181 S C0QLIST("NQF0038 NUM10")="MU EP NQF 0038 NUM10 FLU" 182 S C0QLIST("NQF0038 NUM11 COMBO5")="MU EP NQF 0038 NUM11 COMBO5" 183 S C0QLIST("NQF0038 NUM12 COMBO6")="MU EP NQF 0038 NUM12 COMBO6" 184 S C0QLIST("NQF0038 NUM2 IPV")="MU EP NQF 0038 NUM2 IPV" 185 S C0QLIST("NQF0038 NUM3 MMR")="MU EP NQF 0038 NUM3 MMR" 186 S C0QLIST("NQF0038 NUM4 HiB")="MU EP NQF 0038 NUM4 HiB" 187 S C0QLIST("NQF0038 NUM5 HEP B")="MU EP NQF 0038 NUM5 HEP B" 188 S C0QLIST("NQF0038 NUM6 VZV")="MU EP NQF 0038 NUM6 VZV" 189 S C0QLIST("NQF0038 NUM7 PCV")="MU EP NQF 0038 NUM7 PCV" 190 S C0QLIST("NQF0038 NUM8 HEP A")="MU EP NQF 0038 NUM8 HEP A" 191 S C0QLIST("NQF0038 NUM9")="MU EP NQF 0038 NUM9 RV" 192 S C0QLIST("M124")="PQRI MEASURE 124" 193 S C0QLIST("M173")="PQRI MEASURE 173" 194 S C0QLIST("M39")="PQRI MEASURE 39" 195 S C0QLIST("M47")="PQRI MEASURE 47" 196 S C0QLIST("M48")="PQRI MEASURE 48" 197 ; 198 N C0QITEM S C0QITEM="" ; Item 199 N C0QFDA ; FDA 200 F S C0QITEM=$O(C0QLIST(C0QITEM)) Q:C0QITEM="" D ; Loop through 201 . N IEN S IEN=$O(^C0Q(101,"B",C0QITEM,"")) ; Get IEN from File using old name 202 . I IEN S C0QFDA(1130580001.101,IEN_",",.01)=C0QLIST(C0QITEM) ; If found, put new name in FDA for this IEN 203 . I IEN D MES^XPDUTL("...Renaming "_C0QITEM_" to "_C0QLIST(C0QITEM)) ; Print message to user 204 ; 205 N C0QERR ; Error for FILE^DIE 206 I $D(C0QFDA) D FILE^DIE("E",$NA(C0QFDA),$NA(C0QERR)) ; File if FDA has contents 207 E D MES^XPDUTL("No entries to rename") ; If nothing, tell user so 208 ; 209 D:$D(C0QERR) ; If Error, print it 210 . D MES^XPDUTL("Error Filing Data. FILE^DIE reported:") 211 . N REF S REF=$NA(C0QERR) ; $Q Reference 212 . F S REF=$Q(@REF) Q:REF="" D MES^XPDUTL(REF_"="_@REF) ; Loop and Print 213 ; 214 QUIT -
qrda/C0Q/trunk/p/C0QMAIN.m
r1438 r1501 1 1 C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QMU12.m
r1445 r1501 1 C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 5/30/12 11:28am2 ;;1.0;C0Q;;May 21, 2012;Build 441 C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 7/31/12 12:34pm 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU 5 5 ;General Public License See attached copy of the License. 6 ;7 ;This program is free software; you can redistribute it and/or modify8 ;it under the terms of the GNU General Public License as published by9 ;the Free Software Foundation; either version 2 of the License, or10 ;(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 of14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the15 ;GNU General Public License for more details.16 ;17 ;You should have received a copy of the GNU General Public License along18 ;with this program; if not, write to the Free Software Foundation, Inc.,19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.20 6 ; 21 7 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED … … 77 63 . D ALL ; all currently admitted patients in the hospital 78 64 . D DIS ; all patients discharged since the reporting period began 79 . I C0QSS ZWRITE GRSLT65 . I C0QSS D ZWRITE^C0QUTIL("GRSLT") 80 66 . ;D ICUPAT ; GENERATE ICU PATIENT LIST 81 67 . I C0QPL D ; … … 111 97 . . N DFN,RB S DFN="" 112 98 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward 113 . . . D DEMO 99 . . . D DEMO^C0QMU122 114 100 . . . D PROBLEM 115 101 . . . D ALLERGY … … 122 108 . . . D COD 123 109 . . . D EDTIME 124 . . . I C0QPR D PRINT 125 . . . I C0QSS D SS 126 . . . I C0QPL D PATLIST 127 Q 128 ; 129 DEMO ; patient demographics 130 K PTDOB 131 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB 132 S PTNAME=$P(^DPT(DFN,0),U) ;patient name 133 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth 134 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex 135 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility 136 S PTHRN=$P($G(VA("PID")),U) ;health record number 137 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file 138 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl 139 S RACE="" 140 F D Q:RACE="" 141 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN 142 . Q:'RACE 143 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description 144 S ETHN="" 145 F D Q:ETHN="" 146 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN 147 . Q:'ETHN 148 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description 149 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed 150 N DEMOYN S DEMOYN=1 151 I $G(PTSEX)="" S DEMOYN=0 152 I $G(PTDOB)="" S DEMOYN=0 153 I $G(PTHRN)="" S DEMOYN=0 154 I $G(PTLANG)="" S DEMOYN=0 155 I $G(RACEDSC)="" S DEMOYN=0 156 I $G(ETHNDSC)="" S DEMOYN=0 157 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)="" 158 E S C0QLIST(ZYR_"FailedDemographics",DFN)="" 110 . . . I C0QPR D PRINT^C0QMU121 111 . . . I C0QSS D SS^C0QMU121 112 . . . I C0QPL D PATLIST^C0QMU121 159 113 Q 160 114 ; … … 264 218 Q 265 219 ; 266 SMOKING ; 267 ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF 268 ; HEALTH FACTORS. GPL 269 I $$INLIST(ZYR_"HasSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STAT CHECK 270 . S C0QLIST(ZYR_"HasSmokingStatus",DFN)="" 271 . S C0QLIST(ZYR_"Over12",DFN)="" 272 I $$INLIST(ZYR_"NoSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK 273 . S C0QLIST(ZYR_"NoSmokingStatus",DFN)="" 274 . S C0QLIST(ZYR_"Over12",DFN)="" 275 N C0QSMOKE,C0QSYN 276 S C0QSYN=0 277 I $$AGE^C0QUTIL(DFN)<13 Q ; DON'T CHECK UNDER AGE 13 278 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE 279 ; PATIENT IN THE CATEGORY OF TOBACCO 280 I $D(C0QSMOKE) S C0QSYN=1 281 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago") 282 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago") 283 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago") 284 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago") 285 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago") 286 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking") 287 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago") 288 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago") 289 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago") 290 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago") 291 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago") 292 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER") 293 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO") 294 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO") 295 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO") 296 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO") 297 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO") 298 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER") 299 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS") 300 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS") 301 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR") 302 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO") 303 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO") 304 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS") 305 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO") 306 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO") 307 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS") 308 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO") 309 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER") 310 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 311 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 312 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 313 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 314 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 315 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 316 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 317 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 318 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 319 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 320 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 321 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 322 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 323 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 324 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 325 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 326 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 327 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 328 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 329 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)") 330 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 331 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 332 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 333 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 334 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 335 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 336 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 337 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 338 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 339 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 340 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 341 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 342 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 343 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 344 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 345 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 346 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 347 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 348 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 349 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 350 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 351 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 352 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 353 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 354 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 355 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 356 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 357 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 358 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 359 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 360 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 361 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 362 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 363 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 364 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 365 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 366 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 367 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 368 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 369 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 370 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 371 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 372 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 373 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 374 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 375 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 376 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 377 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 378 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 379 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 380 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 381 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 382 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 383 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 384 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 385 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 386 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 387 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 388 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 389 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 390 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 391 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 392 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 393 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 394 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 395 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 396 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 397 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 398 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 399 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 400 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 401 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 402 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 403 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 404 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 405 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 406 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 407 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 408 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 409 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)") 410 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User") 411 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No") 412 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes") 413 S C0QLIST(ZYR_"Over12",DFN)="" 414 ;N GT 415 ;S GT(1,"HasSmokingStatus","SMOK")="" 416 ;S GT(2,"HasSmokingStatus","Smok")="" 417 ;S GT(3,"HasSmokingStatus","smok")="" 418 ;I 'C0QSYN D ; 419 ;. N G 420 ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN) 421 ;. I $D(G) S C0QSYN=1 422 I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)="" 423 E S C0QLIST(ZYR_"NoSmokingStatus",DFN)="" 424 Q 425 ; 220 SMOKING G SMOKING^C0QMU121 426 221 VITALS ; 427 222 ; … … 512 307 ED1 ; 513 308 S ZYR="MU12-" 514 D DOTIME ("ED DEPARTURE TIME")309 D DOTIME^C0QMU121("ED DEPARTURE TIME") 515 310 Q 516 311 ; 517 312 ED2 ; 518 313 S ZYR="MU12-" 519 D DOTIME2("TIME DECISION TO ADMIT MADE") 520 Q 521 ; 522 DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE 523 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE 524 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED 525 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME 526 N ZP 527 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process 528 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS 529 S ZVFN=9000010 ; VISIT FILE NUMBER 530 K ZARY1,ZARY2 531 N ZI S ZI="" 532 S COUNT=0 533 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 534 . S COUNT=COUNT+1 535 . N ZA,ZD 536 . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR 537 . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 538 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE 539 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 540 . ; THE COMMENT IS THE TIME XXYY 541 . N OK,TMP 542 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER 543 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 544 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3 545 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER 546 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 547 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD 548 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3 549 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME 550 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME 551 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME 552 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME 553 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES 554 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1) 555 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC) 556 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4)) 557 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4)) 558 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60) 559 . S GTOT=G1-G2 560 . W !,"TIME: ",GTOT," ESTIMATED" 561 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES 562 . W !,"COMPUTED MINUTES: ",ZT 563 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG 564 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES 565 . . W !,"****EXCLUDED****" 566 . I ZT>400000 D Q ; THESE ARE ERRORS 567 . . W !,"****EXCLUDED****" 568 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS 569 N ZY,ZZ S ZY="" S ZZ="" 570 N ZCOUNT S ZCOUNT=0 571 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME 572 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME 573 . . S ZCOUNT=ZCOUNT+1 574 . . S ZARY2(ZCOUNT,ZY,ZZ)="" 575 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY 576 N ZMID 577 S ZMID=$P(ZCOUNT/2,".") 578 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT 579 W !,"ED ARRIVAL TIME UNTIL ",ZHF 580 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,"")) 581 Q 582 ; 583 DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE 584 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE 585 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED 586 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME 587 N ZP 588 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process 589 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS 590 S ZVFN=9000010 ; VISIT FILE NUMBER 591 K ZARY1,ZARY2 592 N ZI S ZI="" 593 S COUNT=0 594 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 595 . S COUNT=COUNT+1 596 . N ZA,ZD 597 . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR 598 . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 599 . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 600 . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR 601 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE 602 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 603 . ; THE COMMENT IS THE TIME XXYY 604 . N OK,TMP 605 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER 606 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 607 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3 608 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER 609 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 610 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD 611 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3 612 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME 613 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME 614 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME 615 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME 616 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES 617 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1) 618 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC) 619 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4)) 620 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4)) 621 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60) 622 . S GTOT=G1-G2 623 . W !,"TIME: ",GTOT," ESTIMATED" 624 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES 625 . W !,"COMPUTED MINUTES: ",ZT 626 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG 627 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES 628 . . W !,"****EXCLUDED****" 629 . I ZT>400000 D Q ; THESE ARE ERRORS 630 . . W !,"****EXCLUDED****" 631 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS 632 N ZY,ZZ S ZY="" S ZZ="" 633 N ZCOUNT S ZCOUNT=0 634 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME 635 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME 636 . . S ZCOUNT=ZCOUNT+1 637 . . S ZARY2(ZCOUNT,ZY,ZZ)="" 638 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY 639 N ZMID 640 S ZMID=$P(ZCOUNT/2,".") 641 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT 642 W !,"ED ARRIVAL TIME UNTIL ",ZHF 643 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,"")) 314 D DOTIME2^C0QMU121("TIME DECISION TO ADMIT MADE") 644 315 Q 645 316 ; … … 665 336 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST 666 337 Q ZR 667 ;668 ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL669 PRINT ; PRINT TO SCREEN670 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "671 I $D(EXDTE) D ;672 . W !,"Discharge Date: ",EXDTE673 . W !,DFN," ",PTNAME674 W !,"DOB: ",PTDOB," HRN: ",PTHRN675 W !,"Language Spoken: ",$G(PTLANG)676 W !,"Race: ",RACEDSC677 W !,"Ethnicity: ",$G(ETHNDSC)678 W !,"Problems: "679 W !,PBDESC680 W !,"Allergies: "681 W !,ALDESC682 W !,"Medications: "683 W !684 Q685 ;686 SS ; CREATE SPREADSHEET ARRAY687 S G1("Patient")=DFN688 I $D(WARD) D ;689 . S G1("WardName")=WARDNAME690 . S G1("RoomAndBed")=RB691 I $D(EXDTE) D ;692 . S G1("DischargeDate")=EXDTE693 S G1("PatientName")=PTNAME694 S G1("Gender")=PTSEX695 S G1("DateOfBirth")=PTDOB696 S G1("HealthRecordNumber")=PTHRN697 S G1("LanguageSpoken")=$G(PTLANG)698 S G1("Race")=RACEDSC699 S G1("Ehtnicity")=$G(ETHNDSC)700 S G1("Problem")=PBDESC701 I PBDESC["No problems found" S G1("HasProblem")=0702 E S G1("HasProblem")=1703 S G1("Allergies")=ALDESC704 I ALDESC["No Allergy" S G1("HasAllergy")=0705 E S G1("HasAllergy")=1706 I $D(MDITEM) D ;707 . S G1("HasMed")=1708 E S G1("HasMed")=0709 S G1("MedDescription")=$G(MDDESC)710 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC711 D RNF1TO2B^C0CRNF("GRSLT","G1")712 K G1713 Q ; DON'T WANT TO DO THE NHIN STUFF NOW714 ;715 PATLIST ; CREATE PATIENT LISTS716 ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL717 S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST718 N DEMOYN S DEMOYN=1719 I $G(PTSEX)="" S DEMOYN=0720 I $G(PTDOB)="" S DEMOYN=0721 I $G(PTHRN)="" S DEMOYN=0722 I $G(PTLANG)="" S DEMOYN=0723 I $G(RACEDSC)="" S DEMOYN=0724 I $G(ETHNDSC)="" S DEMOYN=0725 ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""726 ;E S C0QLIST("FailedDemographics",DFN)=""727 ;S G1("Gender")=PTSEX728 ;S G1("DateOfBirth")=PTDOB729 ;S G1("HealthRecordNumber")=PTHRN730 ;S G1("LanguageSpoken")=$G(PTLANG)731 ;S G1("Race")=RACEDSC732 ;S G1("Ehtnicity")=$G(ETHNDSC)733 S G1("Problem")=PBDESC734 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""735 E S C0QLIST(ZYR_"HasProblem",DFN)=""736 ;S G1("Allergies")=ALDESC737 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""738 E S C0QLIST(ZYR_"HasAllergy",DFN)=""739 ;I $D(MDITEM) D ;740 ;. S C0QLIST("HasMed",DFN)=""741 ;E S G1("NoMed",DFN)=""742 ;S G1("MedDescription")=$G(MDDESC)743 Q744 ;745 NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT746 Q:DFN=137!14747 D EN^C0CNHIN(.G,DFN,"")748 ZWRITE G749 K G750 ;751 QUIT ;end of WARD752 338 ; 753 339 LOCPAT(PREFIX,LOC) ;retrieve active outpatients … … 799 385 . S PRE=ZYR_"EP-"_C0QCLNC_"-" 800 386 . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS 801 . I $D(DEBUG) ZWRITE C0QLIST387 . I $D(DEBUG) D ZWRITE^C0QUTIL("C0QLIST") 802 388 . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient") 803 389 S DFN="" 804 390 S ZYR=ZYR_"EP-" 805 391 F S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT 806 . D DEMO 392 . D DEMO^C0QMU122 807 393 . D PROBLEM 808 394 . D ALLERGY … … 812 398 . D VITALS 813 399 D FILE ; FILE THE PATIENT LISTS 814 ;815 ; Now process eRx MU measures for these patients816 ; Check for eRx template and code first; if they exist, run the code817 ; I $D(^C0PX("B","GETMEDS6")),$L($T(SOAP^C0PWS2)) DO ; smh -cmm for now818 . N C0QDEBUG S C0QDEBUG=1 ; This causes the code to print out data;819 . D EN^C0QMUERX($$PATLN^C0QMU12(ZYR_"HasERX")) ; Pass the eRx patient list820 . K C0QDEBUG ; remove debug variable821 ;822 400 N C0QCIEN 823 401 S ZI="" … … 841 419 . . S DFN=$P(^DGPM(PTFM,0),U,3) 842 420 . . S C0QLIST(ZYR_"Patient",DFN)="" 843 . . D DEMO 421 . . D DEMO^C0QMU122 844 422 . . D PROBLEM 845 423 . . D ALLERGY … … 853 431 . . D COD 854 432 . . D EDTIME 855 . . I C0QPR D PRINT 856 . . I C0QSS D SS 857 . . I C0QPL D PATLIST 433 . . I C0QPR D PRINT^C0QMU121 434 . . I C0QSS D SS^C0QMU121 435 . . I C0QPL D PATLIST^C0QMU121 858 436 Q 859 437 ; … … 941 519 D UPDATE^DIE("","C0QFDA","","ZERR") 942 520 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED 943 ;. W "ERROR",!944 ;. ZWR ZERR945 ;. B946 521 K C0QFDA 947 522 Q 948 523 ; 949 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS950 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)951 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth952 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex953 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility954 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number955 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file956 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl957 ;. . S RACE=""958 ;. . F D Q:RACE=""959 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))960 ;. . . Q:'RACE961 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)962 ;. . N ETHNDSC963 ;. . N ETHNDSC S ETHNDSC=""964 ;. . S ETHN=""965 ;. . F D Q:ETHN=""966 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))967 ;. . . Q:'ETHN968 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)969 ;. . D LIST^ORQQPL(.PROBL,DFN,"A")970 ;. . S PBCNT=""971 ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D972 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description973 ;. . K PROBL974 ;. . D LIST^ORQQAL(.ALRGYL,DFN)975 ;. . S ALCNT=""976 ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D977 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description978 ;. . K ALRGYL979 ;. . D COVER^ORWPS(.MEDSL,DFN)980 ;. . S MDCNT=""981 ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D982 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only983 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description984 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)985 ;. . K MEDSL986 ;. . W !,"Discharge Date: ",EXDTE987 ;. . W !,DFN," ",PTNAME988 ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN989 ;. . W !,"Language Spoken: ",$G(PTLANG)990 ;. . W !,"Race: ",RACEDSC991 ;. . W !,"Ethnicity: ",ETHNDSC992 ;. . W !,"Problems: "993 ;. . W !,PBDESC994 ;. . W !,"Allergies: "995 ;. . W !,ALDESC996 ;. . W !,"Medications: "997 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC998 ;. . W !999 ;Q1000 ;1001 ;1002 ;1003 ;1004 524 END ;end of C0QPRML; -
qrda/C0Q/trunk/p/C0QNOTES.m
r1438 r1501 1 C0QNOTES ;GPL - Utility to look up patient notes ; 5/23/12 5:44pm2 ;;1.0;C0Q;;May 21, 2012;Build 431 C0QNOTES ;GPL - Utility to look up patient notes ; 7/31/12 8:17am 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ;2011 George Lilly <glilly@glilly.net> - Licensed under the terms of the GNU … … 112 112 S GT(5,"HasMedRecon","Medication Reconcilation Complete")="" 113 113 W $$TXTALL(.G,.GT,2) ; CHECK ALL PATIENT 2'S NOTEST FOR SMOKING 114 ZWRITE G114 D ZWRITE^C0QUTIL("G") 115 115 Q 116 116 ; -
qrda/C0Q/trunk/p/C0QPQRI.m
r1438 r1501 1 1 C0QPQRI ; GPL - GENERATES A PQRI XML FILE ; 5/23/12 2:42pm 2 ;;1.0;C0Q;;May 21, 2012;Build 432 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QSET.m
r1438 r1501 1 C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm ; 5/23/12 5:46pm2 ;;1.0;C0Q;;May 21, 2012;Build 431 C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm ; 7/31/12 8:19am 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ;2011 George Lilly glilly@glilly.net - Licensed under the terms of the GNU … … 29 29 S B(4)="" 30 30 D UNITY("C","A","B") 31 ZWRITE C31 D ZWRITE^C0QUTIL("C") 32 32 Q 33 33 ; … … 38 38 D UNITY("DELTA",PATS,MEDS) 39 39 W !,"PATIENTS WITH NO MEDS",! 40 ZWRITE DELTA(0,*)40 D ZWRITE^C0QUTIL("DELTA(0,*)") 41 41 W !,"BAD POINTERS IN THE MEDS FILE",! 42 ZWRITE DELTA(2,*)42 D ZWRITE^C0QUTIL("DELTA(2,*)") 43 43 Q 44 44 ; -
qrda/C0Q/trunk/p/C0QUTIL.m
r1438 r1501 1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ; 9/2/11 4:30pm2 ;;1.0;C0Q;;May 21, 2012;Build 431 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ; 7/31/12 7:42am 2 ;;1.0;C0Q;;May 21, 2012;Build 63 3 3 ; 4 4 ;2011 Licensed under the terms of the GNU General Public License … … 77 77 Q Y 78 78 ; 79 ZWRITE(NAME) ; Replacement for ZWRITE ; Public Proc 80 ; Pass NAME by name as a closed reference. lvn and gvn are both supported. 81 ; : syntax is not supported (yet) 82 N L S L=$L(NAME) ; Name length 83 I $E(NAME,L-2,L)=",*)" S NAME=$E(NAME,1,L-3)_")" ; If last sub is *, remove it and close the ref 84 N ORIGLAST S ORIGLAST=$QS(NAME,$QL(NAME)) ; Get last subscript upon which we can't loop further 85 N ORIGQL S ORIGQL=$QL(NAME) ; Number of subscripts in the original name 86 I $D(@NAME)#2 W NAME,"=",$$FORMAT(@NAME),! ; Write base if it exists 87 ; $QUERY through the name. 88 ; Stop when we are out. 89 ; Stop when the last subscript of the original name isn't the same as 90 ; the last subscript of the Name. 91 F S NAME=$Q(@NAME) Q:NAME="" Q:$QS(NAME,ORIGQL)'=ORIGLAST W NAME,"=",$$FORMAT(@NAME),! 92 QUIT 93 FORMAT(V) ; Add quotes, replace control characters if necessary; Public $$ 94 ;If numeric, nothing to do. 95 ;If no encoding required, then return as quoted string. 96 ;Otherwise, return as an expression with $C()'s and strings. 97 I +V=V Q V ; If numeric, just return the value. 98 N QT S QT="""" ; Quote 99 I $F(V,QT) D ;chk if V contains any Quotes 100 . S P=0 ;position pointer into V 101 . F S P=$F(V,QT,P) Q:'P D ;find next " 102 . . S $E(V,P-1)=QT_QT ;double each " 103 . . S P=P+1 ;skip over new " 104 I $$CCC(V) D Q V ; If control character is present do this and quit 105 . S V=$$RCC(QT_V_QT) ; Replace control characters in "V" 106 . S:$E(V,1,3)="""""_" $E(V,1,3)="" ; Replace doubled up quotes at start 107 . S L=$L(V) S:$E(V,L-2,L)="_""""" $E(V,L-2,L)="" ; Replace doubled up quotes at end 108 Q QT_V_QT ; If no control charactrrs, quit with "V" 109 ; 110 CCC(S) ;test if S Contains a Control Character or $C(255); Public $$ 111 Q:S?.E1C.E 1 112 Q:$F(S,$C(255)) 1 113 Q 0 114 RCC(NA) ;Replace control chars in NA with $C( ). Returns encoded string; Public $$ 115 Q:'$$CCC(NA) NA ;No embedded ctrl chars 116 N OUT S OUT="" ;holds output name 117 N CC S CC=0 ;count ctrl chars in $C( 118 N C ;temp hold each char 119 F I=1:1:$L(NA) S C=$E(NA,I) D ;for each char C in NA 120 . I C'?1C,C'=C255 D S OUT=OUT_C Q ;not a ctrl char 121 . . I CC S OUT=OUT_")_""",CC=0 ;close up $C(... if one is open 122 . I CC D 123 . . I CC=256 S OUT=OUT_")_$C("_$A(C),CC=0 ;max args in one $C( 124 . . E S OUT=OUT_","_$A(C) ;add next ctrl char to $C( 125 . E S OUT=OUT_"""_$C("_$A(C) 126 . S CC=CC+1 127 . Q 128 Q OUT 79 129 END ;end of C0QUTIL
Note:
See TracChangeset
for help on using the changeset viewer.
