Ignore:
Timestamp:
Aug 2, 2012, 8:59:21 PM (12 years ago)
Author:
Sam Habiel
Message:

Latest routines; T11 copy

File:
1 edited

Legend:

Unmodified
Added
Removed

  • qrda/C0Q/trunk/p/C0QMU12.m

    r1445 r1501  
    1 C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 5/30/12 11:28am
    2         ;;1.0;C0Q;;May 21, 2012;Build 44
     1C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 7/31/12 12:34pm
     2        ;;1.0;C0Q;;May 21, 2012;Build 63
    33        ;
    44        ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
    55        ;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.
    206        ;
    217        ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
    … …  
    7763        . D ALL ; all currently admitted patients in the hospital
    7864        . D DIS ; all patients discharged since the reporting period began
    79         . I C0QSS ZWRITE GRSLT
     65        . I C0QSS D ZWRITE^C0QUTIL("GRSLT")
    8066        . ;D ICUPAT ; GENERATE ICU PATIENT LIST
    8167        . I C0QPL D  ;
    … …  
    11197        . . N DFN,RB S DFN=""
    11298        . . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
    113         . . . D DEMO
     99        . . . D DEMO^C0QMU122
    114100        . . . D PROBLEM
    115101        . . . D ALLERGY
    … …  
    122108        . . . D COD
    123109        . . . 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
    159113        Q
    160114        ;
    … …  
    264218        Q
    265219        ;
    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         ;
     220SMOKING G SMOKING^C0QMU121
    426221VITALS  ;
    427222        ;
    … …  
    512307ED1     ;
    513308        S ZYR="MU12-"
    514         D DOTIME("ED DEPARTURE TIME")
     309        D DOTIME^C0QMU121("ED DEPARTURE TIME")
    515310        Q
    516311        ;
    517312ED2     ;
    518313        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")
    644315        Q
    645316        ;
    … …  
    665336        I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
    666337        Q ZR
    667         ;
    668         ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
    669 PRINT   ; PRINT TO SCREEN
    670         I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
    671         I $D(EXDTE) D  ;
    672         . W !,"Discharge Date: ",EXDTE
    673         . W !,DFN," ",PTNAME
    674         W !,"DOB: ",PTDOB," HRN: ",PTHRN
    675         W !,"Language Spoken: ",$G(PTLANG)
    676         W !,"Race: ",RACEDSC
    677         W !,"Ethnicity: ",$G(ETHNDSC)
    678         W !,"Problems: "
    679         W !,PBDESC
    680         W !,"Allergies: "
    681         W !,ALDESC
    682         W !,"Medications: "
    683         W !
    684         Q
    685         ;
    686 SS      ; CREATE SPREADSHEET ARRAY
    687         S G1("Patient")=DFN
    688         I $D(WARD) D  ;
    689         . S G1("WardName")=WARDNAME
    690         . S G1("RoomAndBed")=RB
    691         I $D(EXDTE) D  ;
    692         . S G1("DischargeDate")=EXDTE
    693         S G1("PatientName")=PTNAME
    694         S G1("Gender")=PTSEX
    695         S G1("DateOfBirth")=PTDOB
    696         S G1("HealthRecordNumber")=PTHRN
    697         S G1("LanguageSpoken")=$G(PTLANG)
    698         S G1("Race")=RACEDSC
    699         S G1("Ehtnicity")=$G(ETHNDSC)
    700         S G1("Problem")=PBDESC
    701         I PBDESC["No problems found" S G1("HasProblem")=0
    702         E  S G1("HasProblem")=1
    703         S G1("Allergies")=ALDESC
    704         I ALDESC["No Allergy" S G1("HasAllergy")=0
    705         E  S G1("HasAllergy")=1
    706         I $D(MDITEM) D  ;
    707         . S G1("HasMed")=1
    708         E  S G1("HasMed")=0
    709         S G1("MedDescription")=$G(MDDESC)
    710         I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E  W !,MDDESC
    711         D RNF1TO2B^C0CRNF("GRSLT","G1")
    712         K G1
    713         Q  ; DON'T WANT TO DO THE NHIN STUFF NOW
    714         ;
    715 PATLIST ; CREATE PATIENT LISTS
    716         ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
    717         S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
    718         N DEMOYN S DEMOYN=1
    719         I $G(PTSEX)="" S DEMOYN=0
    720         I $G(PTDOB)="" S DEMOYN=0
    721         I $G(PTHRN)="" S DEMOYN=0
    722         I $G(PTLANG)="" S DEMOYN=0
    723         I $G(RACEDSC)="" S DEMOYN=0
    724         I $G(ETHNDSC)="" S DEMOYN=0
    725         ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
    726         ;E  S C0QLIST("FailedDemographics",DFN)=""
    727         ;S G1("Gender")=PTSEX
    728         ;S G1("DateOfBirth")=PTDOB
    729         ;S G1("HealthRecordNumber")=PTHRN
    730         ;S G1("LanguageSpoken")=$G(PTLANG)
    731         ;S G1("Race")=RACEDSC
    732         ;S G1("Ehtnicity")=$G(ETHNDSC)
    733         S G1("Problem")=PBDESC
    734         I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
    735         E  S C0QLIST(ZYR_"HasProblem",DFN)=""
    736         ;S G1("Allergies")=ALDESC
    737         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         Q
    744         ;
    745 NHIN    ; SHOW THE NHIN ARRAY FOR THIS PATIENT
    746         Q:DFN=137!14
    747         D EN^C0CNHIN(.G,DFN,"")
    748         ZWRITE G
    749         K G
    750         ;
    751         QUIT  ;end of WARD
    752338        ;
    753339LOCPAT(PREFIX,LOC)        ;retrieve active outpatients
    … …  
    799385        . S PRE=ZYR_"EP-"_C0QCLNC_"-"
    800386        . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
    801         . I $D(DEBUG) ZWRITE C0QLIST
     387        . I $D(DEBUG) D ZWRITE^C0QUTIL("C0QLIST")
    802388        . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
    803389        S DFN=""
    804390        S ZYR=ZYR_"EP-"
    805391        F  S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN=""  D  ; EACH PATIENT
    806         . D DEMO
     392        . D DEMO^C0QMU122
    807393        . D PROBLEM
    808394        . D ALLERGY
    … …  
    812398        . D VITALS
    813399        D FILE ; FILE THE PATIENT LISTS
    814         ;
    815         ; Now process eRx MU measures for these patients
    816         ; Check for eRx template and code first; if they exist, run the code
    817         ; I $D(^C0PX("B","GETMEDS6")),$L($T(SOAP^C0PWS2)) DO  ; smh -cmm for now
    818         . 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 list
    820         . K C0QDEBUG ; remove debug variable
    821         ;
    822400        N C0QCIEN
    823401        S ZI=""
    … …  
    841419        . . S DFN=$P(^DGPM(PTFM,0),U,3)
    842420        . . S C0QLIST(ZYR_"Patient",DFN)=""
    843         . . D DEMO
     421        . . D DEMO^C0QMU122
    844422        . . D PROBLEM
    845423        . . D ALLERGY
    … …  
    853431        . . D COD
    854432        . . 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
    858436        Q
    859437        ;
    … …  
    941519        D UPDATE^DIE("","C0QFDA","","ZERR")
    942520        I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
    943         ;. W "ERROR",!
    944         ;. ZWR ZERR
    945         ;. B
    946521        K C0QFDA
    947522        Q
    948523        ;
    949         ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
    950         ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
    951         ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
    952         ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
    953         ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
    954         ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
    955         ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
    956         ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
    957         ;. . S RACE=""
    958         ;. . F  D  Q:RACE=""
    959         ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
    960         ;. . . Q:'RACE
    961         ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
    962         ;. . N ETHNDSC
    963         ;. . N ETHNDSC S ETHNDSC=""
    964         ;. . S ETHN=""
    965         ;. . F  D  Q:ETHN=""
    966         ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
    967         ;. . . Q:'ETHN
    968         ;. . . 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=""  D
    972         ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
    973         ;. . K PROBL
    974         ;. . D LIST^ORQQAL(.ALRGYL,DFN)
    975         ;. . S ALCNT=""
    976         ;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
    977         ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
    978         ;. . K ALRGYL
    979         ;. . D COVER^ORWPS(.MEDSL,DFN)
    980         ;. . S MDCNT=""
    981         ;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
    982         ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
    983         ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
    984         ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
    985         ;. . K MEDSL
    986         ;. . W !,"Discharge Date: ",EXDTE
    987         ;. . W !,DFN," ",PTNAME
    988         ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
    989         ;. . W !,"Language Spoken: ",$G(PTLANG)
    990         ;. . W !,"Race: ",RACEDSC
    991         ;. . W !,"Ethnicity: ",ETHNDSC
    992         ;. . W !,"Problems: "
    993         ;. . W !,PBDESC
    994         ;. . W !,"Allergies: "
    995         ;. . W !,ALDESC
    996         ;. . W !,"Medications: "
    997         ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
    998         ;. . W !
    999         ;Q
    1000         ;
    1001         ;
    1002         ;
    1003         ;
    1004524END     ;end of C0QPRML;
Note: See TracChangeset for help on using the changeset viewer.