Ignore:
Timestamp:
May 25, 2012, 5:55:11 PM (13 years ago)
Author:
Sam Habiel
Message:

Updated routines after many small fixes; added C0QKIDS as well

File:
1 edited

Legend:

Unmodified
Added
Removed
  • qrda/C0Q/trunk/p/C0QMU12.m

    r1364 r1438  
    1 C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
    2  ;;1.0;MU PACKAGE;;;Build 27
    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  ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
    22  ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
    23  ;
    24 C0QPFN() Q 1130580001.401 ; PARAMETER FILE
    25 C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE
    26 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
    27 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
    28 INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
    29  ; ZARY IS PASSED BY NAME
    30  ; ZTYP IS "INP" OR "EP"
    31  N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
    32  ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
    33  K @ZARY ; CLEAR RETURN ARRAY
    34  N ZIEN,ZCNT,ZX
    35  I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D  Q  ; OOPS NO RECORD THERE
    36  . W !,"ERROR, NO PARAMETERS AVAILABLE"
    37  S ZIEN=""
    38  S ZCNT=0
    39  F  S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN=""  D  ;
    40  . S ZCNT=ZCNT+1
    41  . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
    42  . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
    43  . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
    44  . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
    45  . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
    46  . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
    47  . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
    48  . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
    49  . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
    50  . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
    51  . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
    52  . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
    53  . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
    54  . D CLEAN^DILF
    55  . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
    56  . I $D(^TMP("DIERR",$J)) D  Q  ; ERROR READING CLINIC LIST
    57  . . W !,"ERROR READING CLINIC PARAMETER LIST"
    58  . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
    59  ;
    60  Q
    61  ;
    62 BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
    63  ; patient lists
    64  ;N GRSLT ; ARRAY FOR RESULTS
    65  I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
    66  I '$D(C0QPR) S C0QPR=0 ;default don't print out results
    67  I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
    68  S ZYR="MU12-"
    69  D INITCLST ; initialize C0QLIST
    70  N G1 ; ONE SET OF VALUES - RNF1 FORMAT
    71  N C0QPARM
    72  D INIT("C0QPARM","INP") ; initialize inpatient parms
    73  I $O(C0QPARM(""))="" D  Q  ; no parms for inpatient
    74  . W !,"No inpatient parameters"
    75  N ZDIV S ZDIV=""
    76  F  S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV=""  D  ; for each inpatient division
    77  . D ALL ; all currently admitted patients in the hospital
    78  . D DIS ; all patients discharged since the reporting period began
    79  . I C0QSS ZWR GRSLT
    80  . ;D ICUPAT ; GENERATE ICU PATIENT LIST
    81  . I C0QPL D  ;
    82  . . D FILE ; FILE THE PATIENT LISTS
    83  . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ;
    84  . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ;
    85  . K C0QLIST
    86  Q
    87  ;
    88 INITCLST ; initialize C0QLIST
    89  ; INITIALIZE LISTS
    90  ; this is done so that if there are no matching patients, the patient list
    91  ; will be zeroed out
    92  K C0QLIST
    93  S C0QLIST(ZYR_"HasDemographics")=""
    94  S C0QLIST(ZYR_"Patient")=""
    95  S C0QLIST(ZYR_"HasProblem")=""
    96  S C0QLIST(ZYR_"HasAllergy")=""
    97  S C0QLIST(ZYR_"HasMed")=""
    98  S C0QLIST(ZYR_"HasVitalSigns")=""
    99  S C0QLIST(ZYR_"HasMedOrders")=""
    100  S C0QLIST(ZYR_"HasSmokingStatus")=""
    101  Q
    102  ;
    103 ALL ;retrieve active inpatients
    104  N WARD S WARD=""
    105  F  D  Q:WARD=""
    106  . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
    107  . Q:WARD=""
    108  . N WIEN S WIEN=""
    109  . F  S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN  D  ;wards IEN
    110  . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
    111  . . N DFN,RB S DFN=""
    112  . . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
    113  . . . D DEMO
    114  . . . D PROBLEM
    115  . . . D ALLERGY
    116  . . . D MEDS4
    117  . . . D RECON2
    118  . . . D ADVDIR
    119  . . . D SMOKING
    120  . . . D VITALS
    121  . . . D VTE1
    122  . . . D COD
    123  . . . 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)=""
    159  Q
    160  ;
    161 PROBLEM ; PATIENT PROBLEMS
    162  D LIST^ORQQPL(.PROBL,DFN,"A")
    163  S PBCNT=""
    164  F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
    165  . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
    166  I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
    167  E  S C0QLIST(ZYR_"HasProblem",DFN)=""
    168  K PROBL
    169  Q
    170  ;
    171 ALLERGY ; ALLERGY LIST
    172  ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
    173  D LIST^ORQQAL(.ALRGYL,DFN)
    174  S ALCNT=""
    175  F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
    176  . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
    177  I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
    178  E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
    179  K ALRGYL
    180  Q
    181  ;
    182 MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
    183  ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
    184  N BEG,END
    185  S BEG=$$DT^C0QUTIL("JULY 3,2011")
    186  S END=$$DT^C0QUTIL("NOW")
    187  D OCL^PSOORRL(DFN,BEG,END)  ;DBIA #2400
    188  N C0QMEDS
    189  M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
    190  N FOUND
    191  N ZI
    192  I '$D(C0QMEDS(1)) D  Q  ; QUIT IF NO MEDS
    193  . S C0QLIST(ZYR_"NoMed",DFN)=""
    194  E  D  ; HAS MEDS
    195  . S C0QLIST(ZYR_"HasMed",DFN)="" 
    196  S ZI="" S FOUND=0
    197  F  S ZI=$O(C0QMEDS(ZI)) Q:ZI=""  D  ; FOR EACH MED
    198  . N ZM
    199  . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
    200  . I $P($P(ZM,"^",1),";",2)="I" D  ; IE 1U;I FOR AN INPATIENT UNIT DOSE
    201  . . S FOUND=1
    202  I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
    203  E  S C0QLIST(ZYR_"NoMedOrders",DFN)=""
    204  Q
    205  ;
    206 RECON ; MEDICATIONS RECONCILIATION
    207  ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
    208  ;
    209  I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
    210  . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
    211  N HASRECON S HASRECON=0
    212  N GT,G
    213  S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
    214  S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
    215  I $$TXTALL^C0QNOTES(.G,.GT,DFN) D  ; SEARCH ALL NOTES FOR MED RECON
    216  . S HASRECON=1
    217  ;N ZT
    218  ;S ZT="MEDICATION RECONCILIATION COMPLET"
    219  ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D  ;
    220  ;. S HASRECON=1
    221  ;E  D  ;
    222  ;. S ZT="Medication Reconcilation Complete"
    223  ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D  ;
    224  ;. . S HASRECON=1
    225  ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
    226  I HASRECON D  ;
    227  . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
    228  E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
    229  Q
    230  ;
    231 RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
    232  I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
    233  . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
    234  I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D  ;
    235  . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
    236  E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
    237  Q
    238  ;
    239 ERX ; FOR EP, WE LOOK AT ERX MEDS
    240  N ZI S ZI=""
    241  N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
    242  F  S ZI=$O(@ZERX@(ZI)) Q:ZI=""  D  ;
    243  . ;B
    244  . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D  ;
    245  . . S C0QLIST(ZYR_"HasMed",DFN)=""
    246  . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
    247  . . S C0QLIST(ZYR_"HasERX",DFN)=""
    248  . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
    249  . E  D  ;
    250  . . S C0QLIST(ZYR_"NoMed",DFN)=""
    251  . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
    252  . . S C0QLIST(ZYR_"NoERX",DFN)=""
    253  . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
    254  Q
    255  ;
    256 ADVDIR ; ADVANCE DIRECTIVE
    257  ;
    258  I $$AGE^C0QUTIL(DFN)>64 D  ; ONLY FOR PATIENTS 65 AND OLDER
    259  . S C0QLIST(ZYR_"Over65",DFN)=""
    260  . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D  ;
    261  . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
    262  . E  D  ;
    263  . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
    264  Q
    265  ;
    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  ;
    426 VITALS ;
    427  ;
    428  N C0QSDT,C0QEDT
    429  D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
    430  D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
    431  D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
    432  I $D(VITRSLT) D  ;ZWR VITRSLT B  ;
    433  . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
    434  . E  S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
    435  Q
    436  ;
    437 VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
    438  ;
    439  I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D  ;
    440  . S C0QLIST(ZYR_"HasVTE24",DFN)=""
    441  E  S C0QLIST(ZYR_"NoVTE24",DFN)=""
    442  Q
    443  ;
    444 COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
    445  I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D  ;
    446  . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
    447  Q
    448  ;
    449 EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
    450  N FOUND
    451  S FOUND=0
    452  I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
    453  I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
    454  I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
    455  I FOUND D  ;
    456  . S C0QLIST(ZYR_"HasEDtime",DFN)=""
    457  E  S C0QLIST(ZYR_"NoEDtime",DFN)=""
    458  Q
    459  ;
    460 ICUPAT ; CREATE LIST OF ICU PATIENTS
    461  N ZICU
    462  S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
    463  N ZI,ZJ,ZP
    464  S ZI=""
    465  F  S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI=""  D  ; EACH DATE
    466  . S ZJ=""
    467  . F  S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ=""  D  ; EACH VISIT
    468  . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
    469  . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
    470  Q
    471  ;
    472 FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
    473  ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
    474  K C0QLIST
    475  N ZPAT
    476  S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
    477  ; during the reporting period. used to filter other lists
    478  ;
    479  ; filter ICU patients against ZPAT
    480  N GN,GO,GF
    481  S GN=ZPAT
    482  S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
    483  S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
    484  D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
    485  ;
    486  ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
    487  ;
    488  S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
    489  S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
    490  S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
    491  D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
    492  ;
    493  S GN=ZPAT
    494  S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
    495  S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
    496  D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
    497  ;
    498  S GN=ZPAT
    499  S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
    500  S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
    501  D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
    502  ;
    503  S GN=ZPAT
    504  S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
    505  S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
    506  D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
    507  ;
    508  D FILE ; FILE ALL THE PATIENT LISTS
    509  D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
    510  Q
    511  ;
    512 ED1 ;
    513  S ZYR="MU12-"
    514  D DOTIME("ED DEPARTURE TIME")
    515  Q
    516  ;
    517 ED2 ;
    518  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,""))
    644  Q
    645  ;
    646 RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
    647  ; WHOSE NAME IS ZLST
    648  N ZIEN,ZN
    649  S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
    650  S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
    651  Q ZN
    652  ;
    653 PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
    654  ; THE ATTRIBUTE ZATTR
    655  N ZIEN,ZN
    656  S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
    657  S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
    658  Q ZN
    659  ;
    660 INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
    661  N ZL,ZR
    662  S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
    663  I ZL="" Q 0 ; LIST DOES NOT EXIST
    664  S ZR=0 ; ASSUME NOT IN LIST
    665  I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
    666  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  ZWR G
    749  K G
    750  ;
    751  QUIT  ;end of WARD
    752  ;
    753 LOCPAT(PREFIX,LOC)   ;retrieve active outpatients
    754  ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
    755  ; LOC IS HOSPITAL LOCATION
    756  S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
    757  I ULOC="" D  Q  ; OOPS
    758  . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
    759  S IDTE=9999999-DTE ; INVERSE DATE
    760  N ZI
    761  S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
    762  F  S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE)  D  ; FOR EACH DATE
    763  . W !,$$FMTE^XLFDT(9999999-ZI) ;B  ;
    764  . I ZI="" Q  ;
    765  . N ZJ S ZJ=""
    766  . F  S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH VISIT
    767  . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
    768  . . S C0QLIST(PREFIX_"Patient",DFN)=""
    769  Q
    770  ;
    771 EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
    772  ;
    773  S DTE=3111000
    774  S MUYR=ZYR
    775  N ZC,ZN
    776  S ZN=0
    777  N ZI S ZI=0
    778  F  S ZI=$O(^SC(ZI)) Q:+ZI=0  D  ; FOR EVERY HOSPITAL LOCATION
    779  . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q   ; NOT A CLINIC
    780  . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
    781  . S ZCIEN=ZI ; IEN OF CLINIC
    782  . S ZN=ZN+1 ; COUNT OF CLINICS
    783  . S PRE=MUYR_"-EP-"_ZC_"-"
    784  . D LOCPAT(PRE,ZC)
    785  W !,"NUMBER OF CLINICS: ",ZN
    786  D FILE ; CREATE ALL THE EP PATIENT LISTS
    787  Q
    788  ;
    789 DOEP ; DO EP COMPUTATIONS
    790  S ZYR="MU12-"
    791  N C0QPARM,C0QCLNC
    792  D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
    793  K C0QLIST ; CLEAR THE LIST
    794  N ZI S ZI=""
    795  F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ; FOR EACH EP
    796  . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
    797  . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
    798  . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
    799  . S PRE=ZYR_"EP-"_C0QCLNC_"-"
    800  . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
    801  . I $D(DEBUG) ZWR C0QLIST
    802  . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
    803  S DFN=""
    804  S ZYR=ZYR_"EP-"
    805  F  S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN=""  D  ; EACH PATIENT
    806  . D DEMO
    807  . D PROBLEM
    808  . D ALLERGY
    809  . ;D MEDS
    810  . D ERX
    811  . D SMOKING
    812  . D VITALS
    813  D FILE ; FILE THE PATIENT LISTS
    814  N C0QCIEN
    815  S ZI=""
    816  F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ;
    817  . S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set
    818  . D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET
    819  Q
    820  ;
    821 DIS;
    822  N DFN,DTE,EXDTE S DTE=""
    823  F  D  Q:DTE=""
    824  . S DTE=$O(^DGPM("B",DTE))
    825  . Q:'DTE
    826  . ;Q:$P(DTE,".")<3110703
    827  . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
    828  . S EXDTE=$$FMTE^XLFDT(DTE)
    829  . N PTFM S PTFM=""
    830  . D
    831  . . S PTFM=$O(^DGPM("B",DTE,PTFM))
    832  . . Q:'PTFM
    833  . . S DFN=$P(^DGPM(PTFM,0),U,3)
    834  . . S C0QLIST(ZYR_"Patient",DFN)=""
    835  . . D DEMO
    836  . . D PROBLEM
    837  . . D ALLERGY
    838  . . D MEDS4
    839  . . D RECON2
    840  . . D ADVDIR
    841  . . D SMOKING
    842  . . D VITALS
    843  . . ;D:$P(DTE,".")>3110912 VTE1
    844  . . D VTE1
    845  . . D COD
    846  . . D EDTIME
    847  . . I C0QPR D PRINT
    848  . . I C0QSS D SS
    849  . . I C0QPL D PATLIST
    850  Q
    851  ;
    852 C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
    853 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
    854 FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
    855  ;
    856  I '$D(C0QLIST) Q  ;
    857  N LFN S LFN=$$C0QALFN()
    858  N ZI,ZN
    859  S ZI=""
    860  F  S ZI=$O(C0QLIST(ZI)) Q:ZI=""  D  ;
    861  . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
    862  . I ZN="" D  ; LIST NOT FOUND, CREATE IT
    863  . . K C0QFDA
    864  . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
    865  . . S C0QFDA(FN,"+1,",.01)=ZI
    866  . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
    867  . . W !,"CREATING ",ZI
    868  . . D UPDIE ; ADD THE RECORD
    869  . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
    870  . ;I ZN="" D  Q  ; OOPS
    871  . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
    872  . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
    873  . N C0QNEW,C0QOLD,C0QRSLT
    874  . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
    875  . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
    876  . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
    877  . N ZJ,ZK
    878  . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
    879  . K C0QFDA
    880  . S ZJ=""
    881  . F  S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ=""  D  ; MARKED WITH A 2 FROM UNITY
    882  . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
    883  . . I ZK="" D  Q  ; OOPS SHOULDN'T HAPPEN
    884  . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
    885  . . . B
    886  . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
    887  . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
    888  . ; SECOND, PROCESS THE ADDITIONS
    889  . K C0QFDA
    890  . S ZJ="" S ZK=1
    891  . F  S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ=""  D  ; PATIENTS TO ADD ARE MARKED WITH 0
    892  . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
    893  . . S ZK=ZK+1
    894  . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
    895  ;. Q
    896  ;. K C0QFDA
    897  ;. N ZJ,ZC
    898  ;. S ZJ="" S ZC=1
    899  ;. F  S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH PAT IN LIST
    900  ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
    901  ;. . S ZC=ZC+1
    902  ;. D UPDIE
    903  ;. W !,"FOUND:"_ZI
    904  Q
    905  ;
    906 KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
    907  ;
    908  N C0QFDA,ZFN,LIST,ATTR
    909  S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
    910  D CLEAN^DILF
    911  S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ;  MEASURE NAME
    912  S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
    913  D CLEAN^DILF
    914  K ZERR
    915  S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
    916  D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
    917  I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
    918  ;. W "ERROR",!
    919  ;. ZWR ZERR
    920  ;. B
    921  K C0QFDA
    922  S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
    923  S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
    924  D UPDIE ; CREATE THE SUBFILE
    925  N ZR ; NEW IEN FOR THE RECORD
    926  S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
    927  ;
    928  Q ZR
    929  ;
    930 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    931  K ZERR
    932  D CLEAN^DILF
    933  D UPDATE^DIE("","C0QFDA","","ZERR")
    934  I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
    935  ;. W "ERROR",!
    936  ;. ZWR ZERR
    937  ;. B
    938  K C0QFDA
    939  Q
    940  ;
    941  ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
    942  ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
    943  ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
    944  ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
    945  ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
    946  ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
    947  ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
    948  ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
    949  ;. . S RACE=""
    950  ;. . F  D  Q:RACE=""
    951  ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
    952  ;. . . Q:'RACE
    953  ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
    954  ;. . N ETHNDSC
    955  ;. . N ETHNDSC S ETHNDSC=""
    956  ;. . S ETHN=""
    957  ;. . F  D  Q:ETHN=""
    958  ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
    959  ;. . . Q:'ETHN
    960  ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
    961  ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
    962  ;. . S PBCNT=""
    963  ;. . F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
    964  ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
    965  ;. . K PROBL
    966  ;. . D LIST^ORQQAL(.ALRGYL,DFN)
    967  ;. . S ALCNT=""
    968  ;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
    969  ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
    970  ;. . K ALRGYL
    971  ;. . D COVER^ORWPS(.MEDSL,DFN)
    972  ;. . S MDCNT=""
    973  ;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
    974  ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
    975  ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
    976  ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
    977  ;. . K MEDSL
    978  ;. . W !,"Discharge Date: ",EXDTE
    979  ;. . W !,DFN," ",PTNAME
    980  ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
    981  ;. . W !,"Language Spoken: ",$G(PTLANG)
    982  ;. . W !,"Race: ",RACEDSC
    983  ;. . W !,"Ethnicity: ",ETHNDSC
    984  ;. . W !,"Problems: "
    985  ;. . W !,PBDESC
    986  ;. . W !,"Allergies: "
    987  ;. . W !,ALDESC
    988  ;. . W !,"Medications: "
    989  ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
    990  ;. . W !
    991  ;Q
    992  ;
    993  ;
    994  ;
    995  ;
    996 END ;end of C0QPRML;
     1C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 5/23/12 5:43pm
     2        ;;1.0;C0Q;;May 21, 2012;Build 43
     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        ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
     22        ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
     23        ;
     24C0QPFN()        Q 1130580001.401 ; PARAMETER FILE
     25C0QPCFN()       Q 1130580001.411 ; CLINIC SUBFILE
     26C0QMFN()        Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
     27C0QMMFN()       Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
     28INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
     29        ; ZARY IS PASSED BY NAME
     30        ; ZTYP IS "INP" OR "EP"
     31        N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
     32        ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
     33        K @ZARY ; CLEAR RETURN ARRAY
     34        N ZIEN,ZCNT,ZX
     35        I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D  Q  ; OOPS NO RECORD THERE
     36        . W !,"ERROR, NO PARAMETERS AVAILABLE"
     37        S ZIEN=""
     38        S ZCNT=0
     39        F  S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN=""  D  ;
     40        . S ZCNT=ZCNT+1
     41        . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
     42        . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
     43        . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
     44        . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
     45        . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
     46        . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
     47        . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
     48        . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
     49        . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
     50        . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
     51        . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
     52        . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
     53        . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
     54        . D CLEAN^DILF
     55        . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
     56        . I $D(^TMP("DIERR",$J)) D  Q  ; ERROR READING CLINIC LIST
     57        . . W !,"ERROR READING CLINIC PARAMETER LIST"
     58        . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
     59        ;
     60        Q
     61        ;
     62BUILD   ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
     63        ; patient lists
     64        ;N GRSLT ; ARRAY FOR RESULTS
     65        I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
     66        I '$D(C0QPR) S C0QPR=0 ;default don't print out results
     67        I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
     68        S ZYR="MU12-"
     69        D INITCLST ; initialize C0QLIST
     70        N G1 ; ONE SET OF VALUES - RNF1 FORMAT
     71        N C0QPARM
     72        D INIT("C0QPARM","INP") ; initialize inpatient parms
     73        I $O(C0QPARM(""))="" D  Q  ; no parms for inpatient
     74        . W !,"No inpatient parameters"
     75        N ZDIV S ZDIV=""
     76        F  S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV=""  D  ; for each inpatient division
     77        . D ALL ; all currently admitted patients in the hospital
     78        . D DIS ; all patients discharged since the reporting period began
     79        . I C0QSS ZWRITE GRSLT
     80        . ;D ICUPAT ; GENERATE ICU PATIENT LIST
     81        . I C0QPL D  ;
     82        . . D FILE ; FILE THE PATIENT LISTS
     83        . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ;
     84        . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ;
     85        . K C0QLIST
     86        Q
     87        ;
     88INITCLST        ; initialize C0QLIST
     89        ; INITIALIZE LISTS
     90        ; this is done so that if there are no matching patients, the patient list
     91        ; will be zeroed out
     92        K C0QLIST
     93        S C0QLIST(ZYR_"HasDemographics")=""
     94        S C0QLIST(ZYR_"Patient")=""
     95        S C0QLIST(ZYR_"HasProblem")=""
     96        S C0QLIST(ZYR_"HasAllergy")=""
     97        S C0QLIST(ZYR_"HasMed")=""
     98        S C0QLIST(ZYR_"HasVitalSigns")=""
     99        S C0QLIST(ZYR_"HasMedOrders")=""
     100        S C0QLIST(ZYR_"HasSmokingStatus")=""
     101        Q
     102        ;
     103ALL     ;retrieve active inpatients
     104        N WARD S WARD=""
     105        F  D  Q:WARD=""
     106        . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
     107        . Q:WARD=""
     108        . N WIEN S WIEN=""
     109        . F  S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN  D  ;wards IEN
     110        . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
     111        . . N DFN,RB S DFN=""
     112        . . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
     113        . . . D DEMO
     114        . . . D PROBLEM
     115        . . . D ALLERGY
     116        . . . D MEDS4
     117        . . . D RECON2
     118        . . . D ADVDIR
     119        . . . D SMOKING
     120        . . . D VITALS
     121        . . . D VTE1
     122        . . . D COD
     123        . . . D EDTIME
     124        . . . I C0QPR D PRINT
     125        . . . I C0QSS D SS
     126        . . . I C0QPL D PATLIST
     127        Q
     128        ;
     129DEMO    ; 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)=""
     159        Q
     160        ;
     161PROBLEM ; PATIENT PROBLEMS
     162        D LIST^ORQQPL(.PROBL,DFN,"A")
     163        S PBCNT=""
     164        F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
     165        . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
     166        I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
     167        E  S C0QLIST(ZYR_"HasProblem",DFN)=""
     168        K PROBL
     169        Q
     170        ;
     171ALLERGY ; ALLERGY LIST
     172        ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
     173        D LIST^ORQQAL(.ALRGYL,DFN)
     174        S ALCNT=""
     175        F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
     176        . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
     177        I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
     178        E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
     179        K ALRGYL
     180        Q
     181        ;
     182MEDS4   ; USE OCL^PSOORRL TO GET ALL MEDS
     183        ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
     184        N BEG,END
     185        S BEG=$$DT^C0QUTIL("JULY 3,2011")
     186        S END=$$DT^C0QUTIL("NOW")
     187        D OCL^PSOORRL(DFN,BEG,END)  ;DBIA #2400
     188        N C0QMEDS
     189        M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
     190        N FOUND
     191        N ZI
     192        I '$D(C0QMEDS(1)) D  Q  ; QUIT IF NO MEDS
     193        . S C0QLIST(ZYR_"NoMed",DFN)=""
     194        E  D  ; HAS MEDS
     195        . S C0QLIST(ZYR_"HasMed",DFN)=""
     196        S ZI="" S FOUND=0
     197        F  S ZI=$O(C0QMEDS(ZI)) Q:ZI=""  D  ; FOR EACH MED
     198        . N ZM
     199        . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
     200        . I $P($P(ZM,"^",1),";",2)="I" D  ; IE 1U;I FOR AN INPATIENT UNIT DOSE
     201        . . S FOUND=1
     202        I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
     203        E  S C0QLIST(ZYR_"NoMedOrders",DFN)=""
     204        Q
     205        ;
     206RECON   ; MEDICATIONS RECONCILIATION
     207        ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
     208        ;
     209        I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
     210        . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
     211        N HASRECON S HASRECON=0
     212        N GT,G
     213        S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
     214        S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
     215        I $$TXTALL^C0QNOTES(.G,.GT,DFN) D  ; SEARCH ALL NOTES FOR MED RECON
     216        . S HASRECON=1
     217        ;N ZT
     218        ;S ZT="MEDICATION RECONCILIATION COMPLET"
     219        ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D  ;
     220        ;. S HASRECON=1
     221        ;E  D  ;
     222        ;. S ZT="Medication Reconcilation Complete"
     223        ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D  ;
     224        ;. . S HASRECON=1
     225        ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
     226        I HASRECON D  ;
     227        . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
     228        E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
     229        Q
     230        ;
     231RECON2  ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
     232        I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
     233        . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
     234        I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D  ;
     235        . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
     236        E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
     237        Q
     238        ;
     239ERX     ; FOR EP, WE LOOK AT ERX MEDS
     240        N ZI S ZI=""
     241        N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
     242        F  S ZI=$O(@ZERX@(ZI)) Q:ZI=""  D  ;
     243        . ;B
     244        . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D  ;
     245        . . S C0QLIST(ZYR_"HasMed",DFN)=""
     246        . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
     247        . . S C0QLIST(ZYR_"HasERX",DFN)=""
     248        . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
     249        . E  D  ;
     250        . . S C0QLIST(ZYR_"NoMed",DFN)=""
     251        . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
     252        . . S C0QLIST(ZYR_"NoERX",DFN)=""
     253        . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
     254        Q
     255        ;
     256ADVDIR  ; ADVANCE DIRECTIVE
     257        ;
     258        I $$AGE^C0QUTIL(DFN)>64 D  ; ONLY FOR PATIENTS 65 AND OLDER
     259        . S C0QLIST(ZYR_"Over65",DFN)=""
     260        . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D  ;
     261        . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
     262        . E  D  ;
     263        . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
     264        Q
     265        ;
     266SMOKING ;
     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        ;
     426VITALS  ;
     427        ;
     428        N C0QSDT,C0QEDT
     429        D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
     430        D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
     431        D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
     432        I $D(VITRSLT) D  ;ZWR VITRSLT B  ;
     433        . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
     434        . E  S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
     435        Q
     436        ;
     437VTE1    ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
     438        ;
     439        I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D  ;
     440        . S C0QLIST(ZYR_"HasVTE24",DFN)=""
     441        E  S C0QLIST(ZYR_"NoVTE24",DFN)=""
     442        Q
     443        ;
     444COD     ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
     445        I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D  ;
     446        . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
     447        Q
     448        ;
     449EDTIME  ; CHECK FOR EMERGENCY DEPT TIME FACTORS
     450        N FOUND
     451        S FOUND=0
     452        I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
     453        I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
     454        I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
     455        I FOUND D  ;
     456        . S C0QLIST(ZYR_"HasEDtime",DFN)=""
     457        E  S C0QLIST(ZYR_"NoEDtime",DFN)=""
     458        Q
     459        ;
     460ICUPAT  ; CREATE LIST OF ICU PATIENTS
     461        N ZICU
     462        S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
     463        N ZI,ZJ,ZP
     464        S ZI=""
     465        F  S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI=""  D  ; EACH DATE
     466        . S ZJ=""
     467        . F  S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ=""  D  ; EACH VISIT
     468        . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
     469        . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
     470        Q
     471        ;
     472FILTER  ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
     473        ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
     474        K C0QLIST
     475        N ZPAT
     476        S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
     477        ; during the reporting period. used to filter other lists
     478        ;
     479        ; filter ICU patients against ZPAT
     480        N GN,GO,GF
     481        S GN=ZPAT
     482        S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
     483        S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
     484        D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
     485        ;
     486        ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
     487        ;
     488        S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
     489        S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
     490        S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
     491        D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
     492        ;
     493        S GN=ZPAT
     494        S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
     495        S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
     496        D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
     497        ;
     498        S GN=ZPAT
     499        S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
     500        S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
     501        D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
     502        ;
     503        S GN=ZPAT
     504        S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
     505        S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
     506        D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
     507        ;
     508        D FILE ; FILE ALL THE PATIENT LISTS
     509        D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
     510        Q
     511        ;
     512ED1     ;
     513        S ZYR="MU12-"
     514        D DOTIME("ED DEPARTURE TIME")
     515        Q
     516        ;
     517ED2     ;
     518        S ZYR="MU12-"
     519        D DOTIME2("TIME DECISION TO ADMIT MADE")
     520        Q
     521        ;
     522DOTIME(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        ;
     583DOTIME2(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,""))
     644        Q
     645        ;
     646RPATLN(ZLST)    ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
     647        ; WHOSE NAME IS ZLST
     648        N ZIEN,ZN
     649        S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
     650        S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
     651        Q ZN
     652        ;
     653PATLN(ZATTR)    ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
     654        ; THE ATTRIBUTE ZATTR
     655        N ZIEN,ZN
     656        S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
     657        S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
     658        Q ZN
     659        ;
     660INLIST(ZLIST,DFN)       ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
     661        N ZL,ZR
     662        S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
     663        I ZL="" Q 0 ; LIST DOES NOT EXIST
     664        S ZR=0 ; ASSUME NOT IN LIST
     665        I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
     666        Q ZR
     667        ;
     668        ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
     669PRINT   ; 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        ;
     686SS      ; 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        ;
     715PATLIST ; 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        ;
     745NHIN    ; 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
     752        ;
     753LOCPAT(PREFIX,LOC)        ;retrieve active outpatients
     754        ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
     755        ; LOC IS HOSPITAL LOCATION
     756        S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
     757        I ULOC="" D  Q  ; OOPS
     758        . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
     759        S IDTE=9999999-DTE ; INVERSE DATE
     760        N ZI
     761        S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
     762        F  S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE)  D  ; FOR EACH DATE
     763        . W !,$$FMTE^XLFDT(9999999-ZI) ;B  ;
     764        . I ZI="" Q  ;
     765        . N ZJ S ZJ=""
     766        . F  S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH VISIT
     767        . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
     768        . . S C0QLIST(PREFIX_"Patient",DFN)=""
     769        Q
     770        ;
     771EPPAT(ZYR)      ; BUILD ALL PATIENT LISTS FOR CLINICS
     772        ;
     773        S DTE=3111000
     774        S MUYR=ZYR
     775        N ZC,ZN
     776        S ZN=0
     777        N ZI S ZI=0
     778        F  S ZI=$O(^SC(ZI)) Q:+ZI=0  D  ; FOR EVERY HOSPITAL LOCATION
     779        . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q   ; NOT A CLINIC
     780        . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
     781        . S ZCIEN=ZI ; IEN OF CLINIC
     782        . S ZN=ZN+1 ; COUNT OF CLINICS
     783        . S PRE=MUYR_"-EP-"_ZC_"-"
     784        . D LOCPAT(PRE,ZC)
     785        W !,"NUMBER OF CLINICS: ",ZN
     786        D FILE ; CREATE ALL THE EP PATIENT LISTS
     787        Q
     788        ;
     789DOEP    ; DO EP COMPUTATIONS
     790        S ZYR="MU12-"
     791        N C0QPARM,C0QCLNC
     792        D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
     793        K C0QLIST ; CLEAR THE LIST
     794        N ZI S ZI=""
     795        F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ; FOR EACH EP
     796        . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
     797        . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
     798        . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
     799        . S PRE=ZYR_"EP-"_C0QCLNC_"-"
     800        . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
     801        . I $D(DEBUG) ZWRITE C0QLIST
     802        . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
     803        S DFN=""
     804        S ZYR=ZYR_"EP-"
     805        F  S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN=""  D  ; EACH PATIENT
     806        . D DEMO
     807        . D PROBLEM
     808        . D ALLERGY
     809        . ;D MEDS
     810        . D ERX
     811        . D SMOKING
     812        . D VITALS
     813        D FILE ; FILE THE PATIENT LISTS
     814        N C0QCIEN
     815        S ZI=""
     816        F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ;
     817        . S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set
     818        . D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET
     819        Q
     820        ;
     821DIS     ;
     822        N DFN,DTE,EXDTE S DTE=""
     823        F  D  Q:DTE=""
     824        . S DTE=$O(^DGPM("B",DTE))
     825        . Q:'DTE
     826        . ;Q:$P(DTE,".")<3110703
     827        . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
     828        . S EXDTE=$$FMTE^XLFDT(DTE)
     829        . N PTFM S PTFM=""
     830        . D
     831        . . S PTFM=$O(^DGPM("B",DTE,PTFM))
     832        . . Q:'PTFM
     833        . . S DFN=$P(^DGPM(PTFM,0),U,3)
     834        . . S C0QLIST(ZYR_"Patient",DFN)=""
     835        . . D DEMO
     836        . . D PROBLEM
     837        . . D ALLERGY
     838        . . D MEDS4
     839        . . D RECON2
     840        . . D ADVDIR
     841        . . D SMOKING
     842        . . D VITALS
     843        . . ;D:$P(DTE,".")>3110912 VTE1
     844        . . D VTE1
     845        . . D COD
     846        . . D EDTIME
     847        . . I C0QPR D PRINT
     848        . . I C0QSS D SS
     849        . . I C0QPL D PATLIST
     850        Q
     851        ;
     852C0QPLF()        Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
     853C0QALFN()       Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
     854FILE    ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
     855        ;
     856        I '$D(C0QLIST) Q  ;
     857        N LFN S LFN=$$C0QALFN()
     858        N ZI,ZN
     859        S ZI=""
     860        F  S ZI=$O(C0QLIST(ZI)) Q:ZI=""  D  ;
     861        . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
     862        . I ZN="" D  ; LIST NOT FOUND, CREATE IT
     863        . . K C0QFDA
     864        . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
     865        . . S C0QFDA(FN,"+1,",.01)=ZI
     866        . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
     867        . . W !,"CREATING ",ZI
     868        . . D UPDIE ; ADD THE RECORD
     869        . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
     870        . ;I ZN="" D  Q  ; OOPS
     871        . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
     872        . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
     873        . N C0QNEW,C0QOLD,C0QRSLT
     874        . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
     875        . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
     876        . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
     877        . N ZJ,ZK
     878        . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
     879        . K C0QFDA
     880        . S ZJ=""
     881        . F  S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ=""  D  ; MARKED WITH A 2 FROM UNITY
     882        . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
     883        . . I ZK="" D  Q  ; OOPS SHOULDN'T HAPPEN
     884        . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
     885        . . . S $EC=",U1130580001,"  ; smh - instead of a BREAK
     886        . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
     887        . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
     888        . ; SECOND, PROCESS THE ADDITIONS
     889        . K C0QFDA
     890        . S ZJ="" S ZK=1
     891        . F  S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ=""  D  ; PATIENTS TO ADD ARE MARKED WITH 0
     892        . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
     893        . . S ZK=ZK+1
     894        . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
     895        ;. Q
     896        ;. K C0QFDA
     897        ;. N ZJ,ZC
     898        ;. S ZJ="" S ZC=1
     899        ;. F  S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH PAT IN LIST
     900        ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
     901        ;. . S ZC=ZC+1
     902        ;. D UPDIE
     903        ;. W !,"FOUND:"_ZI
     904        Q
     905        ;
     906KLNCR(ZREC)     ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
     907        ;
     908        N C0QFDA,ZFN,LIST,ATTR
     909        S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
     910        D CLEAN^DILF
     911        S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ;  MEASURE NAME
     912        S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
     913        D CLEAN^DILF
     914        K ZERR
     915        S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
     916        D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
     917        I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
     918        ;. W "ERROR",!
     919        ;. ZWR ZERR
     920        ;. B
     921        K C0QFDA
     922        S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
     923        S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
     924        D UPDIE ; CREATE THE SUBFILE
     925        N ZR ; NEW IEN FOR THE RECORD
     926        S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
     927        ;
     928        Q ZR
     929        ;
     930UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     931        K ZERR
     932        D CLEAN^DILF
     933        D UPDATE^DIE("","C0QFDA","","ZERR")
     934        I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
     935        ;. W "ERROR",!
     936        ;. ZWR ZERR
     937        ;. B
     938        K C0QFDA
     939        Q
     940        ;
     941        ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
     942        ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
     943        ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
     944        ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
     945        ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
     946        ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
     947        ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
     948        ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
     949        ;. . S RACE=""
     950        ;. . F  D  Q:RACE=""
     951        ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
     952        ;. . . Q:'RACE
     953        ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
     954        ;. . N ETHNDSC
     955        ;. . N ETHNDSC S ETHNDSC=""
     956        ;. . S ETHN=""
     957        ;. . F  D  Q:ETHN=""
     958        ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
     959        ;. . . Q:'ETHN
     960        ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
     961        ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
     962        ;. . S PBCNT=""
     963        ;. . F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
     964        ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
     965        ;. . K PROBL
     966        ;. . D LIST^ORQQAL(.ALRGYL,DFN)
     967        ;. . S ALCNT=""
     968        ;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
     969        ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
     970        ;. . K ALRGYL
     971        ;. . D COVER^ORWPS(.MEDSL,DFN)
     972        ;. . S MDCNT=""
     973        ;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
     974        ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
     975        ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
     976        ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
     977        ;. . K MEDSL
     978        ;. . W !,"Discharge Date: ",EXDTE
     979        ;. . W !,DFN," ",PTNAME
     980        ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
     981        ;. . W !,"Language Spoken: ",$G(PTLANG)
     982        ;. . W !,"Race: ",RACEDSC
     983        ;. . W !,"Ethnicity: ",ETHNDSC
     984        ;. . W !,"Problems: "
     985        ;. . W !,PBDESC
     986        ;. . W !,"Allergies: "
     987        ;. . W !,ALDESC
     988        ;. . W !,"Medications: "
     989        ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
     990        ;. . W !
     991        ;Q
     992        ;
     993        ;
     994        ;
     995        ;
     996END     ;end of C0QPRML;
Note: See TracChangeset for help on using the changeset viewer.