Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMDF10

BDMDF10.m

Go to the documentation of this file. 
  1. BDMDF10 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT 19 Dec 2016 1:31 PM ; 17 Jan 2018  1:34 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
  1.  ;
  1.  ;
  1. EN ; - ENTRY POINT - from ^BDMASK
  1.  ;D UNFOLDTX^BDMUTL(2018)  ;cmi/maw 05/14/2014 patch 8 lets store all tax up front for checking call
  1.  D BUILDSML^BDMUTL(2018)
  1.  K ^BDMDATA("BDMEPI",$J)
  1.  S ^XTMP("BDMDM18",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^DM AUDIT 2018"
  1.  S ^XTMP("BDMDM18 ERRORS",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^DM AUDIT 2018 DATA QUALITY CHECK"
  1.  S BDMEPIN=0,BDMECNT=0
  1.  S BDMPD=0 F  S BDMPD=$O(^XTMP("BDMDM18",BDMJOB,BDMBTH,"PATS",BDMPD)) Q:'BDMPD  D
  1.  .I BDMTYPE'="P" I $$DEMO^BDMUTL(BDMPD,$G(BDMDEMO)) Q
  1.  .I BDMPREP=2 D EPIREC Q
  1.  .I BDMPREP=7 D EPICHK^BDMDF1J Q
  1.  .D GATHER
  1.  I BDMPREP=2 D WRITEF^BDMDF1 Q
  1.  I BDMPREP=3!(BDMPREP=4) D CUML^BDMDF15
  1.  I BDMPREP=5 D SDPI^BDMDF1S
  1.  I BDMPREP=6 D SDPI16^BDMDF1R
  1.  Q
  1. S(P,I,V) ;
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",P,I)=V
  1.  Q
  1. REC(DFN,BDMRTYP,BDMRBD,BDMRED,BDMED,BDMDMRG,BDMBDAT) ;EP - called to send back a visit record as
  1.  NEW BDMX,BDMREC
  1.  S BDMREC=""
  1.  S BDMRTYP("IEN")=$O(^BDMRECD("B",BDMRTYP,0))
  1.  I 'BDMRTYP("IEN") Q BDMREC
  1. PROC ;
  1.  S BDMEPIX=0
  1.  F  S BDMEPIX=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX)) Q:BDMEPIX'=+BDMEPIX!(BDMREC=-1)  S BDMTTT=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX,0))  D
  1.  .S X="" X:$D(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)) ^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)
  1.  .I X="" S X=" "
  1.  .S $P(BDMREC,U,$P(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U,2))=X  ;I DUZ=2881 W !,BDMTTT,?5,$P(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U),?40,X
  1.  ;W !!,BDMREC
  1.  Q BDMREC
  1. EPIREC ;create epi info record in ^BDMDATA("BDMEPI",$J,n)
  1.  ;skip this patient if dodx is greater than the audit date
  1.  S X=$$DODX^BDMDF16(BDMPD,BDMDMRG,"I")
  1.  I X>BDMADAT Q
  1.  S BDMEPIR="",BDMTHER=""
  1.  S BDMEPIR=$$REC(BDMPD,"DM AUDIT 2018 EXPORT RECORD",BDMRBD,BDMRED,BDMADAT,BDMDMRG,BDMBDAT),BDMEPIN=BDMEPIN+1,^BDMDATA("BDMEPI",$J,BDMEPIN)=BDMEPIR
  1.  Q
  1. GATHER ;gather data for 1 patient
  1.  S BDMER=0
  1.  ;set report dates
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,1)=BDMRBD_" - "_BDMRED
  1.  ;set audit date to DT
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,2)=$$FMTE^XLFDT(DT)
  1.  ;reviewer
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,14)=$P(^VA(200,DUZ,0),U,2)  ;reviewer initials
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,122)=$$COMM(BDMPD)
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,121)=$S($P($G(^DPT(BDMPD,.11)),U,5):$P($G(^DIC(5,$P(^DPT(BDMPD,.11),U,5),0)),U,2),1:"")  ;state of residence
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,15)=$$VAL^XBDIQ1(9000001,BDMPD,.14)  ;primary care provider
  1. DEMO ;pat demographics
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,16)=$$HRN^AUPNPAT(BDMPD,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)))  ;hrn
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,18)=$$DOB^AUPNPAT(BDMPD,"E")  ;dob
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,20)=$$VAL^XBDIQ1(2,BDMPD,.02)  ;sex
  1. DXDT ;dates of and dm dxs
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,22)=$S(BDMDMRG:$$CMSFDX^BDMDF13(BDMPD,BDMDMRG,"D"),1:"")
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)=$S(BDMDMRG:$$CMSFDX^BDMDF13(BDMPD,BDMDMRG,"DX"),1:"")
  1.  S ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,23)=$$PLDMDOO^BDMDF13(BDMPD)
  1.  D S(BDMPD,25,$$PLDMDXS^BDMDF13(BDMPD))
  1.  D S(BDMPD,21,$$FRSTDMDX^BDMDF13(BDMPD))
  1.  D S(BDMPD,26,$$LASTDMDX^BDMDF13(BDMPD,BDMRED))
  1.  I $$DODX^BDMDF16(BDMPD,BDMDMRG,"I")>BDMADAT D S(BDMPD,26.5,"*** Patient's Date of Onset is after the audit date.") D
  1.  .D S(BDMPD,26.6,"**** This patient will not be included in the cumulative audit.")
  1.  S BDMTYDM="" D TYPEDM,S(BDMPD,29,BDMTYDM)
  1.  D S(BDMPD,27,$$TOBACCO^BDMDF1T(BDMPD,$$DOB^AUPNPAT(BDMPD),BDMADAT))
  1.  D S(BDMPD,215,$$TOBACCO^BDMDF1T(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,28,$$CESS^BDMDF11(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,31,$$ENDS^BDMDF1T(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,33,$$LASTENDS^BDMDF1T(BDMPD,$$DOB^AUPNPAT(BDMPD),BDMADAT))
  1.  ;
  1. VITAL ;
  1.  D S(BDMPD,30,$$LASTHT^BDMDF13(BDMPD,BDMRED))
  1.  D S(BDMPD,32,$$LASTWT^BDMDF13(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,112,$$BMI^BDMDF18(BDMPD,BDMRBD,BDMRED))
  1.  ;htn dx
  1.  D S(BDMPD,34,$$HTNDX^BDMDF13(BDMPD,BDMADAT))
  1.  ;last 3 BPs
  1.  D S(BDMPD,36,$$BPS^BDMDF13(BDMPD,BDMRBD,BDMRED))
  1. EXAMS ;
  1.  D S(BDMPD,38,$$DFE^BDMDF17(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,40,$$EYE^BDMDF17(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,42,$$DENTAL^BDMDF17(BDMPD,BDMBDAT,BDMADAT))
  1. MH ;MH
  1.  D S(BDMPD,200,$$DEPDX^BDMDF12(BDMPD,BDMBDAT,BDMADAT))
  1.  S BDMDFP=$E($G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,200)))
  1.  D S(BDMPD,210,$S(BDMDFP="1":"",1:$$DEPSCR^BDMDF12(BDMPD,BDMBDAT,BDMADAT)))
  1.  ;EDUC
  1.  D S(BDMPD,44,$$DIETEDUC^BDMDF17(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,46,$$EXEDUC^BDMDF17(BDMPD,BDMRBD,BDMRED))
  1.  D S(BDMPD,48,$$OTHEDUC^BDMDF17(BDMPD,BDMRBD,BDMRED))
  1. THERAPY ;
  1.  S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31)) ;,BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
  1.  D S(BDMPD,52,$$INSULIN^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,53,$$SULF^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,98,$$SULFLIKE^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,54,$$MET^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,55,$$ACAR^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,56,$$TROG^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  ;D S(BDMPD,58,$$INCR^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,59,$$DPP4^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,99,$$AMYLIN^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,100,$$GLP1^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,101,$$BROM^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,102,$$COLE^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  D S(BDMPD,103,$$SGLT2^BDMDF12(BDMPD,BDM6MBD,BDMRED))
  1.  S Z="" F X=52:1:56,59,98,99,100,101,102,103 I $E($G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)))="X" S Z=1  ;ANY MED AT ALL?
  1.  ;S Y=$$REFMED^BDMDF12(BDMPD,BDMRBD,BDMRED) S Y=$S(Z:"",Y="":"",1:"X"_U_$P(Y,U,2)) D S(BDMPD,57,Y)  ;REFUSAL OF A MED
  1.  S Y="" F X=52:1:56,59,98,99,100,101,102,103 I $E($G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)))="X" S Y=1  ;cmi/maw 6/17/2014 per gary
  1.  D S(BDMPD,51,$S(Y:"",1:"X"))
  1.  D S(BDMPD,60,$$ACE^BDMDF16(BDMPD,BDM6MBD,BDMADAT))
  1.  D S(BDMPD,62,$$ASPIRIN^BDMDF16(BDMPD,BDM6MBD,BDMADAT))
  1.  D S(BDMPD,300,$$STATIN^BDMDF16(BDMPD,BDM6MBD,BDMADAT))
  1.  D S(BDMPD,116,$$CVD^BDMDF12(BDMPD,BDMADAT))
  1.  ;
  1. PPD ;
  1.  D S(BDMPD,70,$$PPD^BDMDF18(BDMPD,BDMADAT))
  1.  D S(BDMPD,114,$$LASTNP^BDMDF18(BDMPD,BDMADAT))
  1.  D S(BDMPD,72,$$TBTX^BDMDF12(BDMPD))
  1. HEPC ;
  1.  D S(BDMPD,222,$$HEPCDX^BDMDF1D(BDMPD,BDMADAT))
  1.  D S(BDMPD,223,$$HEPSCR^BDMDF1D(BDMPD,BDMADAT))
  1.  D S(BDMPD,224,$$DMRETDX^BDMDF1D(BDMPD,BDMADAT))
  1.  ;
  1. IMM ;
  1.  D S(BDMPD,64,$$FLU^BDMDF13(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,66,$$PNEU^BDMDF13(BDMPD,BDMADAT))
  1.  D S(BDMPD,68,$$TD^BDMDF1B(BDMPD,BDMADAT))
  1.  D S(BDMPD,216,$$TDAP^BDMDF1B(BDMPD,BDMADAT))
  1.  D S(BDMPD,115,$$HEP^BDMDF13(BDMPD,BDMADAT))
  1. LABS ;
  1.  D S(BDMPD,78,$$HGBA1C^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,79,$$GFR^BDMDF1C(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,84,$$CREAT^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,86,$$CHOL^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,88,$$LDL^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,89,$$HDL^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,90,$$TRIG^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  ;D S(BDMPD,117,$$NONHDL^BDMDF1C(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,92,$$URIN^BDMDF18(BDMPD,BDMBDAT,BDMADAT))
  1.  D S(BDMPD,118,$$COMBINED^BDMDF1C(BDMPD,BDMBDAT,BDMADAT,BDM6MBD))
  1.  D S(BDMPD,119,$$EGFRUACR^BDMDF1C(BDMPD,BDMBDAT,BDMADAT))
  1.  ;
  1.  Q
  1. TYPEDM ;return type of DM in BDMTYDM
  1.  NEW X
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="NIDDM" S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="TYPE II" S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)[2 S BDMTYDM="2  Type 2" Q
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="IDDM" S BDMTYDM="1  Type 1" Q
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)[1 S BDMTYDM="1  Type 1" Q
  1.  I ^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,24)="TYPE I" S BDMTYDM="1  Type 1" Q
  1.  S X=^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,25)
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(BDMTYDM]"")  S J=$P($$CODEN^BDMUTL(C,80),"~") I J>0,$$ICD^BDMUTL(J,"DM AUDIT TYPE II DXS",9) S BDMTYDM="2  Type 2"
  1.  Q:BDMTYDM]""
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(BDMTYDM]"")  S J=$P($$CODEN^BDMUTL(C,80),"~") I J>0,$$ICD^BDMUTL(J,"DM AUDIT TYPE I DXS",9) S BDMTYDM="1  Type 1"
  1.  Q:BDMTYDM]""
  1.  S X=^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,26)
  1.  I X[2 S BDMTYDM="2  Type 2" Q
  1.  I X[1 S BDMTYDM="1  Type 1" Q
  1.  Q
  1. DATE(D) ;EP
  1.  I $G(D)="" Q ""
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+($E(D,1,3)))
  1. TRIBE(P) ;EP
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNPAT(P,11)) Q ""
  1.  Q $$TRIBE^AUPNPAT(P,"C")_"^"_$$TRIBE^AUPNPAT(P,"E")
  1. COMM(P) ;EP
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNPAT(P,11)) Q ""
  1.  Q $$COMMRES^AUPNPAT(P,"E")
  1. EAUDIT ;EP
  1.  ;D UNFOLDTX^BDMUTL(2017)  ;cmi/maw 05/14/2014 patch 8 lets store all tax up front for checking call
  1.  K ^BDMDATA("BDMEPI",$J)
  1.  S ^XTMP("BDMDM18",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^DM AUDIT 2018"
  1.  S BDMEPIN=0
  1.  S BDMBEGD=$$FMADD^XLFDT(BDMADAT,-365)
  1.  S BDM3YE=$$FMADD^XLFDT(BDMADAT,-1096)
  1.  I BDMACTI=1 D
  1.  .S BDMEAUT=0 F  S BDMEAUT=$O(^ACM(41,"B",BDMDMRG,BDMEAUT)) Q:BDMEAUT'=+BDMEAUT  D
  1.  ..I $P($G(^ACM(41,BDMEAUT,"DT")),U,1)'="A" Q
  1.  ..S BDMPD=$P(^ACM(41,BDMEAUT,0),U,2)
  1.  ..Q:$$DEMO^BDMUTL(BDMPD,$G(BDMDEMO))
  1.  ..S BDMX=$$ACTDMPT^BDMDF1G(BDMPD,BDMBEGD,BDMADAT,BDMTAXI,BDMBEN,BDM3YE)
  1.  ..I 'BDMX Q  ;not active diabetic
  1.  ..I BDMPREG,$$PREG^BDMDF1B(P,BDMBDAT,BDMADAT,1,1) Q
  1.  ..I BDMPREP=2 D EPIREC Q
  1.  ..I BDMPREP=7 D EPICHK^BDMDF1J Q
  1.  ..D GATHER
  1.  .Q
  1.  I BDMACTI=0 S BDMPD=0 F  S BDMPD=$O(^AUPNPAT(BDMPD)) Q:'BDMPD  D
  1.  .Q:$$DEMO^BDMUTL(BDMPD,$G(BDMDEMO))
  1.  .S BDMX=$$ACTDMPT^BDMDF1G(BDMPD,BDMBEGD,BDMADAT,BDMTAXI,BDMBEN,BDM3YE)
  1.  .I 'BDMX Q  ;not active diabetic
  1.  .I BDMACTI,'$$ACTONREG(BDMPD,BDMDMRG) Q
  1.  .I BDMPREG,$$PREG^BDMDF1B(P,BDMBDAT,BDMADAT,1,1) Q
  1.  .I BDMPREP=2 D EPIREC Q
  1.  .I BDMPREP=7 D EPICHK^BDMDF1J Q
  1.  .D GATHER
  1.  I BDMPREP=2 D WRITEF^BDMDF1 Q
  1.  I BDMPREP=3!(BDMPREP=4) D CUML^BDMDF15
  1.  I BDMPREP=5 D SDPI^BDMDF1S
  1.  I BDMPREP=6 D SDPI16^BDMDF1R
  1.  Q
  1. ACTONREG(P,R) ;
  1.  I $G(R)="" Q ""
  1.  I $G(P)="" Q ""
  1.  I '$D(^ACM(41,"AC",P,R)) Q 0
  1.  S X=^ACM(41,"AC",P,R)
  1.  I $P($G(^ACM(41,X,"DT")),U,1)'="A" Q 0
  1.  Q 1
  1.  ;
  1. LOCN(P,R) ;EP
  1.  I $G(R)="" Q ""
  1.  I $G(P)="" Q ""
  1.  I '$D(^ACM(41,"AC",P,R)) Q 0
  1.  S X=^ACM(41,"AC",P,R)
  1.  I 'X Q ""
  1.  Q $$VAL^XBDIQ1(9002241,X,1101)
  1.  ;
  1. LOCT(P,R) ;EP
  1.  I $G(R)="" Q ""
  1.  I $G(P)="" Q ""
  1.  I '$D(^ACM(41,"AC",P,R)) Q 0
  1.  S X=^ACM(41,"AC",P,R)
  1.  I 'X Q ""
  1.  Q $$VAL^XBDIQ1(9002241,X,1102)
  1.  ;