C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List for 2012 ;7/5/11 8:50pm
 ;;1.0;MU PACKAGE;;;Build 20
 ;
 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
 ;General Public License See attached copy of the License.
 ;
 ;This program is free software; you can redistribute it and/or modify
 ;it under the terms of the GNU General Public License as published by
 ;the Free Software Foundation; either version 2 of the License, or
 ;(at your option) any later version.
 ;
 ;This program is distributed in the hope that it will be useful,
 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;GNU General Public License for more details.
 ;
 ;You should have received a copy of the GNU General Public License along
 ;with this program; if not, write to the Free Software Foundation, Inc.,
 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 ;
 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
 ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
 ;
BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
 ; patient lists
 ;N GRSLT ; ARRAY FOR RESULTS
 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
 I '$D(C0QPR) S C0QPR=0 ;default don't print out results
 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
 S ZYR="MU12-"
 N G1 ; ONE SET OF VALUES - RNF1 FORMAT
 ; INITIALIZE LISTS
 ; this is done so that if there are no matching patients, the patient list
 ; will be zeroed out
 S C0QLIST(ZYR_"HasDemographics")=""
 S C0QLIST(ZYR_"Patient")=""
 S C0QLIST(ZYR_"HasProblem")=""
 S C0QLIST(ZYR_"HasAllergy")=""
 S C0QLIST(ZYR_"HasMed")=""
 S C0QLIST(ZYR_"HasVitalSigns")=""
 S C0QLIST(ZYR_"HasMedOrders")=""
 S C0QLIST(ZYR_"HasSmokingStatus")=""
 D ALL ; all currently admitted patients in the hospital
 D DIS ; all patients discharged since the reporting period began
 I C0QSS ZWR GRSLT
 D ICUPAT ; GENERATE ICU PATIENT LIST
 I C0QPL D  ;
 . D FILE ; FILE THE PATIENT LISTS
 . D UPDATE^C0QUPDT(.G,10) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
 . D UPDATE^C0QUPDT(.G,11) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
 Q
 ;
ALL ;retrieve active inpatients
 N WARD S WARD=""
 F  D  Q:WARD=""
 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
 . Q:WARD=""
 . N WIEN S WIEN=""
 . F  S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN  D  ;wards IEN
 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
 . . N DFN,RB S DFN=""
 . . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
 . . . D DEMO
 . . . D PROBLEM
 . . . D ALLERGY
 . . . D MEDS4
 . . . D RECON2
 . . . D ADVDIR
 . . . D SMOKING
 . . . D VITALS
 . . . D VTE1
 . . . D COD
 . . . D EDTIME
 . . . I C0QPR D PRINT
 . . . I C0QSS D SS
 . . . I C0QPL D PATLIST
 Q
 ;
DEMO ; patient demographics
 K PTDOB
 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
 S PTNAME=$P(^DPT(DFN,0),U) ;patient name
 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
 S PTHRN=$P($G(VA("PID")),U) ;health record number
 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
 S RACE=""
 F  D  Q:RACE=""
 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
 . Q:'RACE
 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
 S ETHN=""
 F  D  Q:ETHN=""
 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
 . Q:'ETHN
 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
 N DEMOYN S DEMOYN=1
 I $G(PTSEX)="" S DEMOYN=0
 I $G(PTDOB)="" S DEMOYN=0
 I $G(PTHRN)="" S DEMOYN=0
 I $G(PTLANG)="" S DEMOYN=0
 I $G(RACEDSC)="" S DEMOYN=0
 I $G(ETHNDSC)="" S DEMOYN=0
 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
 E  S C0QLIST(ZYR_"FailedDemographics",DFN)=""
 Q
 ;
PROBLEM ; PATIENT PROBLEMS
 D LIST^ORQQPL(.PROBL,DFN,"A")
 S PBCNT=""
 F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
 E  S C0QLIST(ZYR_"HasProblem",DFN)=""
 K PROBL
 Q
 ; 
ALLERGY ; ALLERGY LIST
 ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
 D LIST^ORQQAL(.ALRGYL,DFN)
 S ALCNT=""
 F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
 E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
 K ALRGYL
 Q
 ;
MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
 N BEG,END
 S BEG=$$DT^C0PCUR("JULY 3,2011")
 S END=$$DT^C0PCUR("NOW")
 D OCL^PSOORRL(DFN,BEG,END)  ;DBIA #2400
 N C0QMEDS
 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
 N FOUND
 N ZI
 I '$D(C0QMEDS(1)) D  Q  ; QUIT IF NO MEDS
 . S C0QLIST(ZYR_"NoMed",DFN)=""
 E  D  ; HAS MEDS
 . S C0QLIST(ZYR_"HasMed",DFN)=""  
 S ZI="" S FOUND=0
 F  S ZI=$O(C0QMEDS(ZI)) Q:ZI=""  D  ; FOR EACH MED
 . N ZM
 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
 . I $P($P(ZM,"^",1),";",2)="I" D  ; IE 1U;I FOR AN INPATIENT UNIT DOSE
 . . S FOUND=1
 I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
 E  S C0QLIST(ZYR_"NoMedOrders",DFN)=""
 Q
 ;
RECON ; MEDICATIONS RECONCILIATION
 ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
 ; 
 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
 N HASRECON S HASRECON=0
 N GT,G
 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D  ; SEARCH ALL NOTES FOR MED RECON
 . S HASRECON=1
 ;N ZT
 ;S ZT="MEDICATION RECONCILIATION COMPLET"
 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D  ;
 ;. S HASRECON=1
 ;E  D  ;
 ;. S ZT="Medication Reconcilation Complete"
 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D  ;
 ;. . S HASRECON=1
 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
 I HASRECON D  ;
 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
 E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
 Q
 ;
RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D  ;
 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
 E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
 Q
 ;
ERX ; FOR EP, WE LOOK AT ERX MEDS
 N ZI S ZI=""
 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
 F  S ZI=$O(@ZERX@(ZI)) Q:ZI=""  D  ;
 . ;B
 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D  ;
 . . S C0QLIST(ZYR_"HasMed",DFN)=""
 . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
 . . S C0QLIST(ZYR_"HasERX",DFN)=""
 . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
 . E  D  ;
 . . S C0QLIST(ZYR_"NoMed",DFN)=""
 . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
 . . S C0QLIST(ZYR_"NoERX",DFN)=""
 . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
 Q
 ;
ADVDIR ; ADVANCE DIRECTIVE
 ;
 I $$AGE^C0QUTIL(DFN)>64 D  ; ONLY FOR PATIENTS 65 AND OLDER
 . S C0QLIST(ZYR_"Over65",DFN)=""
 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D  ;
 . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
 . E  D  ;
 . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
 Q
 ;
SMOKING ;
 ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF
 ; HEALTH FACTORS. GPL
 I $$INLIST(ZYR_"HasSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STAT CHECK
 . S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
 . S C0QLIST(ZYR_"Over12",DFN)=""
 I $$INLIST(ZYR_"NoSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STATUS CHECK
 . S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
 . S C0QLIST(ZYR_"Over12",DFN)=""
 N C0QSMOKE,C0QSYN
 S C0QSYN=0
 I $$AGE^C0QUTIL(DFN)<13 Q  ; DON'T CHECK UNDER AGE 13
 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
 ; PATIENT IN THE CATEGORY OF TOBACCO
 I $D(C0QSMOKE) S C0QSYN=1
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No")
 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes")
 S C0QLIST(ZYR_"Over12",DFN)=""
 ;N GT
 ;S GT(1,"HasSmokingStatus","SMOK")=""
 ;S GT(2,"HasSmokingStatus","Smok")=""
 ;S GT(3,"HasSmokingStatus","smok")=""
 ;I 'C0QSYN D  ;
 ;. N G
 ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
 ;. I $D(G) S C0QSYN=1
 I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
 E  S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
 Q
 ;
VITALS ;
 ;
 N C0QSDT,C0QEDT
 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
 I $D(VITRSLT) D  ;ZWR VITRSLT B  ;
 . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
 . E  S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
 Q
 ;
VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
 ;
 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D  ;
 . S C0QLIST(ZYR_"HasVTE24",DFN)=""
 E  S C0QLIST(ZYR_"NoVTE24",DFN)="" 
 Q
 ;
COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
 I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D  ;
 . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
 Q
 ;
EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
 N FOUND
 S FOUND=0
 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
 I FOUND D  ; 
 . S C0QLIST(ZYR_"HasEDtime",DFN)=""
 E  S C0QLIST(ZYR_"NoEDtime",DFN)=""
 Q
 ;
ICUPAT ; CREATE LIST OF ICU PATIENTS
 N ZICU
 S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
 N ZI,ZJ,ZP
 S ZI=""
 F  S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI=""  D  ; EACH DATE
 . S ZJ=""
 . F  S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ=""  D  ; EACH VISIT
 . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
 . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
 Q
 ;
FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
 ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
 K C0QLIST
 N ZPAT
 S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
 ; during the reporting period. used to filter other lists
 ;
 ; filter ICU patients against ZPAT
 N GN,GO,GF
 S GN=ZPAT
 S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
 S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
 ; 
 ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
 ;
 S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
 S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
 S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
 ;
 S GN=ZPAT
 S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
 S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
 ;
 S GN=ZPAT
 S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
 S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
 ;
 S GN=ZPAT
 S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
 S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
 ;
 D FILE ; FILE ALL THE PATIENT LISTS
 D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
 Q
 ;
ED1 ;
 S ZYR="MU12-"
 D DOTIME("ED DEPARTURE TIME")
 Q
 ;
ED2 ;
 S ZYR="MU12-"
 D DOTIME2("TIME DECISION TO ADMIT MADE")
 Q
 ;
DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
 N ZP
 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
 S ZVFN=9000010 ; VISIT FILE NUMBER
 K ZARY1,ZARY2
 N ZI S ZI=""
 S COUNT=0
 F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
 . S COUNT=COUNT+1
 . N ZA,ZD
 . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
 . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
 . ; THE COMMENT IS THE TIME XXYY
 . N OK,TMP
 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
 . S GTOT=G1-G2
 . W !,"TIME: ",GTOT," ESTIMATED"
 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
 . W !,"COMPUTED MINUTES: ",ZT
 . ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
 . I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
 . . W !,"****EXCLUDED****"
 . I ZT>400000 D  Q  ; THESE ARE ERRORS
 . . W !,"****EXCLUDED****"
 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
 N ZY,ZZ S ZY="" S ZZ=""
 N ZCOUNT S ZCOUNT=0
 F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
 . F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
 . . S ZCOUNT=ZCOUNT+1
 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
 N ZMID
 S ZMID=$P(ZCOUNT/2,".")
 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
 W !,"ED ARRIVAL TIME UNTIL ",ZHF
 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
 Q
 ;
DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
 N ZP
 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
 S ZVFN=9000010 ; VISIT FILE NUMBER
 K ZARY1,ZARY2
 N ZI S ZI=""
 S COUNT=0
 F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
 . S COUNT=COUNT+1
 . N ZA,ZD
 . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
 . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
 . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
 . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR
 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
 . ; THE COMMENT IS THE TIME XXYY
 . N OK,TMP
 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
 . S GTOT=G1-G2
 . W !,"TIME: ",GTOT," ESTIMATED"
 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
 . W !,"COMPUTED MINUTES: ",ZT
 . ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
 . I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
 . . W !,"****EXCLUDED****"
 . I ZT>400000 D  Q  ; THESE ARE ERRORS
 . . W !,"****EXCLUDED****"
 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
 N ZY,ZZ S ZY="" S ZZ=""
 N ZCOUNT S ZCOUNT=0
 F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
 . F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
 . . S ZCOUNT=ZCOUNT+1
 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
 N ZMID
 S ZMID=$P(ZCOUNT/2,".")
 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
 W !,"ED ARRIVAL TIME UNTIL ",ZHF
 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
 Q
 ;
RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
 ; WHOSE NAME IS ZLST
 N ZIEN,ZN
 S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
 S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
 Q ZN
 ;
PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
 ; THE ATTRIBUTE ZATTR
 N ZIEN,ZN
 S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
 S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
 Q ZN
 ;
INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
 N ZL,ZR
 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
 I ZL="" Q 0 ; LIST DOES NOT EXIST
 S ZR=0 ; ASSUME NOT IN LIST
 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
 Q ZR
 ;
 ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
PRINT ; PRINT TO SCREEN 
 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
 I $D(EXDTE) D  ;
 . W !,"Discharge Date: ",EXDTE
 . W !,DFN," ",PTNAME
 W !,"DOB: ",PTDOB," HRN: ",PTHRN
 W !,"Language Spoken: ",$G(PTLANG)
 W !,"Race: ",RACEDSC
 W !,"Ethnicity: ",$G(ETHNDSC)
 W !,"Problems: "
 W !,PBDESC
 W !,"Allergies: "
 W !,ALDESC
 W !,"Medications: "
 W !
 Q
 ;
SS ; CREATE SPREADSHEET ARRAY
 S G1("Patient")=DFN
 I $D(WARD) D  ;
 . S G1("WardName")=WARDNAME
 . S G1("RoomAndBed")=RB
 I $D(EXDTE) D ; 
 . S G1("DischargeDate")=EXDTE
 S G1("PatientName")=PTNAME
 S G1("Gender")=PTSEX
 S G1("DateOfBirth")=PTDOB
 S G1("HealthRecordNumber")=PTHRN
 S G1("LanguageSpoken")=$G(PTLANG)
 S G1("Race")=RACEDSC
 S G1("Ehtnicity")=$G(ETHNDSC)
 S G1("Problem")=PBDESC
 I PBDESC["No problems found" S G1("HasProblem")=0
 E  S G1("HasProblem")=1
 S G1("Allergies")=ALDESC
 I ALDESC["No Allergy" S G1("HasAllergy")=0
 E  S G1("HasAllergy")=1
 I $D(MDITEM) D  ;
 . S G1("HasMed")=1
 E  S G1("HasMed")=0
 S G1("MedDescription")=$G(MDDESC)
 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E  W !,MDDESC
 D RNF1TO2B^C0CRNF("GRSLT","G1")
 K G1
 Q  ; DON'T WANT TO DO THE NHIN STUFF NOW
 ;
PATLIST ; CREATE PATIENT LISTS
 ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
 S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
 N DEMOYN S DEMOYN=1
 I $G(PTSEX)="" S DEMOYN=0
 I $G(PTDOB)="" S DEMOYN=0
 I $G(PTHRN)="" S DEMOYN=0
 I $G(PTLANG)="" S DEMOYN=0
 I $G(RACEDSC)="" S DEMOYN=0
 I $G(ETHNDSC)="" S DEMOYN=0
 ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
 ;E  S C0QLIST("FailedDemographics",DFN)=""
 ;S G1("Gender")=PTSEX
 ;S G1("DateOfBirth")=PTDOB
 ;S G1("HealthRecordNumber")=PTHRN
 ;S G1("LanguageSpoken")=$G(PTLANG)
 ;S G1("Race")=RACEDSC
 ;S G1("Ehtnicity")=$G(ETHNDSC)
 S G1("Problem")=PBDESC
 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
 E  S C0QLIST(ZYR_"HasProblem",DFN)=""
 ;S G1("Allergies")=ALDESC
 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
 E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
 ;I $D(MDITEM) D  ;
        ;. S C0QLIST("HasMed",DFN)=""
 ;E  S G1("NoMed",DFN)=""
 ;S G1("MedDescription")=$G(MDDESC)
 Q
 ;
NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
 Q:DFN=137!14
 D EN^C0CNHIN(.G,DFN,"")
 ZWR G
 K G
 ;
 QUIT  ;end of WARD
 ;
LOCPAT(PREFIX,LOC)   ;retrieve active outpatients
 ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
 ; LOC IS HOSPITAL LOCATION
 S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
 I ULOC="" D  Q  ; OOPS
 . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
 S IDTE=9999999-DTE ; INVERSE DATE
 N ZI
 S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
 F  S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE)  D  ; FOR EACH DATE
 . W !,$$FMTE^XLFDT(9999999-ZI) ;B  ;
 . I ZI="" Q  ;
 . N ZJ S ZJ=""
 . F  S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH VISIT
 . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
 . . S C0QLIST(PREFIX_"Patient",DFN)=""
 Q
 ;
EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
 ;
 S DTE=3111000
 S MUYR=ZYR
 N ZC,ZN
 S ZN=0
 N ZI S ZI=0
 F  S ZI=$O(^SC(ZI)) Q:+ZI=0  D  ; FOR EVERY HOSPITAL LOCATION
 . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q   ; NOT A CLINIC
 . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
 . S ZCIEN=ZI ; IEN OF CLINIC
 . S ZN=ZN+1 ; COUNT OF CLINICS
 . S PRE=MUYR_"-EP-"_ZC_"-"
 . D LOCPAT(PRE,ZC)
 W !,"NUMBER OF CLINICS: ",ZN
 D FILE ; CREATE ALL THE EP PATIENT LISTS
 Q
 ;
DOEP ; DO EP COMPUTATIONS
 S DTE=3111000
 K C0QLIST ; CLEAR THE LIST
 S PRE="MU12-EP-OIM-BOWEN-"
 S ZYR=PRE
 D LOCPAT(PRE,"OIM-BOWEN") ; GET THE PATIENTS
 ZWR C0QLIST
 ;B
 S DFN=""
 F  S DFN=$O(C0QLIST(PRE_"Patient",DFN)) Q:DFN=""  D  ; FOR EACH PATIENT
 . D DEMO
 . D PROBLEM
 . D ALLERGY
 . ;D MEDS
 . D ERX
 . D SMOKING
 . D VITALS
 D FILE ; FILE THE PATIENT LISTS
 D UPDATE^C0QUPDT(.G,12) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
 Q
 ;
DIS; 
 N DFN,DTE,EXDTE S DTE=""
 F  D  Q:DTE=""
 . S DTE=$O(^DGPM("B",DTE))
 . Q:'DTE
 . ;Q:$P(DTE,".")<3110703
 . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
 . S EXDTE=$$FMTE^XLFDT(DTE)
 . N PTFM S PTFM=""
 . D
 . . S PTFM=$O(^DGPM("B",DTE,PTFM))
 . . Q:'PTFM
 . . S DFN=$P(^DGPM(PTFM,0),U,3)
 . . S C0QLIST(ZYR_"Patient",DFN)=""
 . . D DEMO
 . . D PROBLEM
 . . D ALLERGY
 . . D MEDS4
 . . D RECON2
 . . D ADVDIR
 . . D SMOKING
 . . D VITALS
 . . ;D:$P(DTE,".")>3110912 VTE1
 . . D VTE1
 . . D COD
 . . D EDTIME
 . . I C0QPR D PRINT
 . . I C0QSS D SS
 . . I C0QPL D PATLIST
 Q
 ;
C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
 ;
 I '$D(C0QLIST) Q  ;
 N LFN S LFN=$$C0QALFN()
 N ZI,ZN
 S ZI=""
 F  S ZI=$O(C0QLIST(ZI)) Q:ZI=""  D  ;
 . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
 . I ZN="" D  ; LIST NOT FOUND, CREATE IT
 . . K C0QFDA
 . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
 . . S C0QFDA(FN,"+1,",.01)=ZI
 . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
 . . W !,"CREATING ",ZI
 . . D UPDIE ; ADD THE RECORD
 . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
 . ;I ZN="" D  Q  ; OOPS
 . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
 . N C0QNEW,C0QOLD,C0QRSLT
 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
 . N ZJ,ZK
 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
 . K C0QFDA
 . S ZJ=""
 . F  S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ=""  D  ; MARKED WITH A 2 FROM UNITY
 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
 . . I ZK="" D  Q  ; OOPS SHOULDN'T HAPPEN
 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
 . . . B
 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
 . ; SECOND, PROCESS THE ADDITIONS
 . K C0QFDA
 . S ZJ="" S ZK=1
 . F  S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ=""  D  ; PATIENTS TO ADD ARE MARKED WITH 0
 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
 . . S ZK=ZK+1
 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
 ;. Q
 ;. K C0QFDA
 ;. N ZJ,ZC
 ;. S ZJ="" S ZC=1
 ;. F  S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH PAT IN LIST
 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
 ;. . S ZC=ZC+1
 ;. D UPDIE
 ;. W !,"FOUND:"_ZI
 Q
 ;
KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
 ;
 N C0QFDA,ZFN,LIST,ATTR
 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
 D CLEAN^DILF
 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ;  MEASURE NAME
 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
 D CLEAN^DILF
 K ZERR
 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
 ;. W "ERROR",!
 ;. ZWR ZERR
 ;. B
 K C0QFDA
 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
 D UPDIE ; CREATE THE SUBFILE
 N ZR ; NEW IEN FOR THE RECORD
 S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
 ;
 Q ZR
 ;
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
 K ZERR
 D CLEAN^DILF
 D UPDATE^DIE("","C0QFDA","","ZERR")
 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
 ;. W "ERROR",!
 ;. ZWR ZERR
 ;. B
 K C0QFDA
 Q
 ;
 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
 ;. . S RACE=""
 ;. . F  D  Q:RACE=""
 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
 ;. . . Q:'RACE
 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
 ;. . N ETHNDSC
 ;. . N ETHNDSC S ETHNDSC=""
 ;. . S ETHN=""
 ;. . F  D  Q:ETHN=""
 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
 ;. . . Q:'ETHN
 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
 ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
 ;. . S PBCNT=""
 ;. . F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
 ;. . K PROBL
 ;. . D LIST^ORQQAL(.ALRGYL,DFN)
 ;. . S ALCNT=""
 ;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
 ;. . K ALRGYL
 ;. . D COVER^ORWPS(.MEDSL,DFN)
 ;. . S MDCNT=""
 ;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
 ;. . K MEDSL
 ;. . W !,"Discharge Date: ",EXDTE
 ;. . W !,DFN," ",PTNAME
 ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
 ;. . W !,"Language Spoken: ",$G(PTLANG)
 ;. . W !,"Race: ",RACEDSC
 ;. . W !,"Ethnicity: ",ETHNDSC
 ;. . W !,"Problems: "
 ;. . W !,PBDESC
 ;. . W !,"Allergies: "
 ;. . W !,ALDESC
 ;. . W !,"Medications: "
 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
 ;. . W !
 ;Q
 ;
 ;
 ;
 ;
END ;end of C0QPRML;