BDMPG10 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ; 15 Dec 2016 3:48 PM
;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
;
;
EN ; - ENTRY POINT - from ^BDMASK
;D UNFOLDTX^BDMUTL(2019)
;D BUILDSML^BDMUTL(2019)
K ^BDMDATA("BDMEPI",$J)
S ^XTMP("BDMPG1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^PRE DM AUDIT 2019"
S BDMEPIN=0
S BDMPG=0 F S BDMPG=$O(^XTMP("BDMPG1",BDMJOB,BDMBTH,"PATS",BDMPG)) Q:'BDMPG D
.I BDMTYPE'="P",BDMTYPE'="S" Q:$$DEMO^BDMUTL(BDMPG,$G(BDMDGMO))
.D GATHER
I BDMPREP=2!(BDMPREP=3) D CUML^BDMPG15
Q
S(P,I,V) ;
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",P,I)=V
Q
GATHER ;gather data for 1 patient
S BDMER=0
;set report dates
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,1)=$S($G(BDMFISC)]"":BDMFISC,1:BDMRBD_" - "_BDMRED)
;set audit date to DT
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,2)=$$FMTE^XLFDT(DT)
;set area, su, facility code and name
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,4)=$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,6)=$E($P(^AUTTLOC($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),1,2)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,8)=$E($P(^AUTTLOC($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),3,4)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,10)=$E($P(^AUTTLOC($S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),5,6)
;# pats in register
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,12)=$S(BDMDMRG:$$RSTAT^BDMDM6(BDMDMRG,"A"),1:"")
;reviewer
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,14)=$P(^VA(200,DUZ,0),U,2)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,15)=$$VAL^XBDIQ1(9000001,BDMPG,.14)
DEMO ;pat demographics
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,16)=$$HRN^AUPNPAT(BDMPG,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)))
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,18)=$$DOB^AUPNPAT(BDMPG,"E")
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,20)=$$VAL^XBDIQ1(2,BDMPG,.02)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,120)=$$TRIBE(BDMPG)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,121)=$$COMM(BDMPG)
DXDT ;dates of and dm dxs
K BDMDGTA D IFG^BDMPG13(BDMPG,.BDMDGTA)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,200)=$S($D(BDMDGTA):"Yes",1:"No")
S X=0 F S X=$O(BDMDGTA(X)) Q:X'=+X D
.S Y=200_"."_X
.S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
K BDMDGTA D IGT^BDMPG13(BDMPG,.BDMDGTA)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,210)=$S($D(BDMDGTA):"Yes",1:"No")
S X=0 F S X=$O(BDMDGTA(X)) Q:X'=+X D
.S Y=210_"."_X
.S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
K BDMDGTA D MS^BDMPG13(BDMPG,.BDMDGTA)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,220)=$S($D(BDMDGTA):"Yes",1:"No")
S X=0 F S X=$O(BDMDGTA(X)) Q:X'=+X D
.S Y=220_"."_X
.S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
K BDMDGTA D ABNG^BDMPG13(BDMPG,.BDMDGTA)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,230)=$S($D(BDMDGTA):"Yes",1:"No")
S X=0 F S X=$O(BDMDGTA(X)) Q:X'=+X D
.S Y=230_"."_X
.S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,22)=$S(BDMDMRG:$$CMSFDX^BDMDG13(BDMPG,BDMDMRG,"D"),1:"")
S ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,24)=$S(BDMDMRG:$$CMSFDX^BDMDG13(BDMPG,BDMDMRG,"DX"),1:"")
I $$PLDMDXS^BDMDG13(BDMPG)]"" D S(BDMPG,25,"PLEASE NOTE: Diabetes is on the Problem list for this patient")
S X=$$FRSTDMDX^BDMDG13(BDMPG,"E") I X]"" D S(BDMPG,26,"PLEASE NOTE: Diabetes has been used as a diagnosis in PCC: "_X)
D S(BDMPG,27,$P($$TOBACCO^BDMDG1T(BDMPG,$$DOB^AUPNPAT(BDMPG),BDMADAT),U,2))
D S(BDMPG,28,$$CESS^BDMDG11(BDMPG,BDMBDAT,BDMADAT))
VITAL ;
D S(BDMPG,30,$$LASTHT^BDMDG13(BDMPG,BDMADAT))
D S(BDMPG,32,$$LASTWT^BDMPG13(BDMPG,BDMADAT))
D S(BDMPG,33,$$LASTWC^BDMPG13(BDMPG,BDMADAT))
;htn dx
S X=$$HTNDX^BDMDG13(BDMPG,BDMADAT) D S(BDMPG,34,$S($E(X)=1:"Yes",1:"No"))
;last 3 BPs
D S(BDMPG,36,$$BPS^BDMDG13(BDMPG,BDMRBD,BDMRED))
EXAMS ;
S X=$$DIETEDUC^BDMDG17(BDMPG,BDMRBD,BDMRED),X=$P(X,U),X=$P(X," ",2) D S(BDMPG,44,X)
D S(BDMPG,46,$$EXEDUC^BDMDG17(BDMPG,BDMBDAT,BDMADAT))
THERAPY ;
S BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31)),BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
D S(BDMPG,53,$$SULF^BDMDG12(BDMPG,BDM6MBD,BDMRED))
D S(BDMPG,54,$$MET^BDMDG12(BDMPG,BDM6MBD,BDMRED))
D S(BDMPG,55,$$ACAR^BDMDG12(BDMPG,BDM6MBD,BDMRED))
D S(BDMPG,56,$$TROG^BDMDG12(BDMPG,BDM6MBD,BDMRED))
S Y="" F X=53:1:56 I ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,X)="X" S Y=1
D S(BDMPG,51,$S(Y:"",1:"X"))
D S(BDMPG,60,$$ACE^BDMDG16(BDMPG,BDM6MBD,BDMRED))
IMM ;
D S(BDMPG,62,$$ASPIRIN^BDMPG16(BDMPG,BDMRBD,BDMRED))
D S(BDMPG,61,$$LIPID^BDMPG16(BDMPG,BDM6MBD,BDMRED))
D S(BDMPG,76,$$EKG^BDMPG12(BDMPG,BDMRED))
LABS ;
D S(BDMPG,90,$$FGLUCOSE^BDMDG18(BDMPG,$P(^DPT(BDMPG,0),U,3),BDMADAT))
D S(BDMPG,91,$$G75^BDMDG18(BDMPG,$P(^DPT(BDMPG,0),U,3),BDMADAT))
D S(BDMPG,86,$$CHOL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
D S(BDMPG,88,$$LDL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
D S(BDMPG,89,$$HDL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
D S(BDMPG,190,$$TRIG^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
;
D S(BDMPG,112,$$BMI^BDMDG18(BDMPG,BDMRBD,BDMRED))
Q
DATE(D) ;EP
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+($E(D,1,3)))
TRIBE(P) ;EP
I '$G(P) Q ""
I '$D(^AUPNPAT(P,11)) Q ""
Q $$TRIBE^AUPNPAT(P,"C")_"^"_$$TRIBE^AUPNPAT(P,"E")
COMM(P) ;EP
I '$G(P) Q ""
I '$D(^AUPNPAT(P,11)) Q ""
Q $$COMMRES^AUPNPAT(P,"C")_"^"_$$COMMRES^AUPNPAT(P,"E")
BDMPG10 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ; 15 Dec 2016 3:48 PM
+1 ;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
+2 ;
+3 ;
EN ; - ENTRY POINT - from ^BDMASK
+1 ;D UNFOLDTX^BDMUTL(2019)
+2 ;D BUILDSML^BDMUTL(2019)
+3 KILL ^BDMDATA("BDMEPI",$JOB)
+4 SET ^XTMP("BDMPG1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^PRE DM AUDIT 2019"
+5 SET BDMEPIN=0
+6 SET BDMPG=0
FOR
SET BDMPG=$ORDER(^XTMP("BDMPG1",BDMJOB,BDMBTH,"PATS",BDMPG))
IF 'BDMPG
QUIT
Begin DoDot:1
+7 IF BDMTYPE'="P"
IF BDMTYPE'="S"
IF $$DEMO^BDMUTL(BDMPG,$GET(BDMDGMO))
QUIT
+8 DO GATHER
End DoDot:1
+9 IF BDMPREP=2!(BDMPREP=3)
DO CUML^BDMPG15
+10 QUIT
S(P,I,V) ;
+1 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",P,I)=V
+2 QUIT
GATHER ;gather data for 1 patient
+1 SET BDMER=0
+1 ;set report dates
+2 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,1)=$SELECT($GET(BDMFISC)]"":BDMFISC,1:BDMRBD_" - "_BDMRED)
+3 ;set audit date to DT
+4 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,2)=$$FMTE^XLFDT(DT)
+5 ;set area, su, facility code and name
+6 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,4)=$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U)
+7 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,6)=$EXTRACT($PIECE(^AUTTLOC($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),1,2)
+8 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,8)=$EXTRACT($PIECE(^AUTTLOC($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),3,4)
+9 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,10)=$EXTRACT($PIECE(^AUTTLOC($SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U,10),5,6)
+10 ;# pats in register
+11 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,12)=$SELECT(BDMDMRG:$$RSTAT^BDMDM6(BDMDMRG,"A"),1:"")
+12 ;reviewer
+13 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,14)=$PIECE(^VA(200,DUZ,0),U,2)
+14 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,15)=$$VAL^XBDIQ1(9000001,BDMPG,.14)
DEMO ;pat demographics
+1 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,16)=$$HRN^AUPNPAT(BDMPG,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)))
+2 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,18)=$$DOB^AUPNPAT(BDMPG,"E")
+3 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,20)=$$VAL^XBDIQ1(2,BDMPG,.02)
+4 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,120)=$$TRIBE(BDMPG)
+5 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,121)=$$COMM(BDMPG)
DXDT ;dates of and dm dxs
+1 KILL BDMDGTA
DO IFG^BDMPG13(BDMPG,.BDMDGTA)
+2 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,200)=$SELECT($DATA(BDMDGTA):"Yes",1:"No")
+3 SET X=0
FOR
SET X=$ORDER(BDMDGTA(X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET Y=200_"."_X
+5 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
End DoDot:1
+6 KILL BDMDGTA
DO IGT^BDMPG13(BDMPG,.BDMDGTA)
+7 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,210)=$SELECT($DATA(BDMDGTA):"Yes",1:"No")
+8 SET X=0
FOR
SET X=$ORDER(BDMDGTA(X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET Y=210_"."_X
+10 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
End DoDot:1
+11 KILL BDMDGTA
DO MS^BDMPG13(BDMPG,.BDMDGTA)
+12 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,220)=$SELECT($DATA(BDMDGTA):"Yes",1:"No")
+13 SET X=0
FOR
SET X=$ORDER(BDMDGTA(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 SET Y=220_"."_X
+15 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
End DoDot:1
+16 KILL BDMDGTA
DO ABNG^BDMPG13(BDMPG,.BDMDGTA)
+17 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,230)=$SELECT($DATA(BDMDGTA):"Yes",1:"No")
+18 SET X=0
FOR
SET X=$ORDER(BDMDGTA(X))
IF X'=+X
QUIT
Begin DoDot:1
+19 SET Y=230_"."_X
+20 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,Y)=BDMDGTA(X)
End DoDot:1
+21 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,22)=$SELECT(BDMDMRG:$$CMSFDX^BDMDG13(BDMPG,BDMDMRG,"D"),1:"")
+22 SET ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,24)=$SELECT(BDMDMRG:$$CMSFDX^BDMDG13(BDMPG,BDMDMRG,"DX"),1:"")
+23 IF $$PLDMDXS^BDMDG13(BDMPG)]""
DO S(BDMPG,25,"PLEASE NOTE: Diabetes is on the Problem list for this patient")
+24 SET X=$$FRSTDMDX^BDMDG13(BDMPG,"E")
IF X]""
DO S(BDMPG,26,"PLEASE NOTE: Diabetes has been used as a diagnosis in PCC: "_X)
+25 DO S(BDMPG,27,$PIECE($$TOBACCO^BDMDG1T(BDMPG,$$DOB^AUPNPAT(BDMPG),BDMADAT),U,2))
+26 DO S(BDMPG,28,$$CESS^BDMDG11(BDMPG,BDMBDAT,BDMADAT))
VITAL ;
+1 DO S(BDMPG,30,$$LASTHT^BDMDG13(BDMPG,BDMADAT))
+2 DO S(BDMPG,32,$$LASTWT^BDMPG13(BDMPG,BDMADAT))
+3 DO S(BDMPG,33,$$LASTWC^BDMPG13(BDMPG,BDMADAT))
+4 ;htn dx
+5 SET X=$$HTNDX^BDMDG13(BDMPG,BDMADAT)
DO S(BDMPG,34,$SELECT($EXTRACT(X)=1:"Yes",1:"No"))
+6 ;last 3 BPs
+7 DO S(BDMPG,36,$$BPS^BDMDG13(BDMPG,BDMRBD,BDMRED))
EXAMS ;
+1 SET X=$$DIETEDUC^BDMDG17(BDMPG,BDMRBD,BDMRED)
SET X=$PIECE(X,U)
SET X=$PIECE(X," ",2)
DO S(BDMPG,44,X)
+2 DO S(BDMPG,46,$$EXEDUC^BDMDG17(BDMPG,BDMBDAT,BDMADAT))
THERAPY ;
+1 SET BDM6MBD=$$FMADD^XLFDT(BDMADAT,-(6*31))
SET BDM6MBD=$$FMTE^XLFDT(BDM6MBD)
+2 DO S(BDMPG,53,$$SULF^BDMDG12(BDMPG,BDM6MBD,BDMRED))
+3 DO S(BDMPG,54,$$MET^BDMDG12(BDMPG,BDM6MBD,BDMRED))
+4 DO S(BDMPG,55,$$ACAR^BDMDG12(BDMPG,BDM6MBD,BDMRED))
+5 DO S(BDMPG,56,$$TROG^BDMDG12(BDMPG,BDM6MBD,BDMRED))
+6 SET Y=""
FOR X=53:1:56
IF ^XTMP("BDMPG1",BDMJOB,BDMBTH,"AUDIT",BDMPG,X)="X"
SET Y=1
+7 DO S(BDMPG,51,$SELECT(Y:"",1:"X"))
+8 DO S(BDMPG,60,$$ACE^BDMDG16(BDMPG,BDM6MBD,BDMRED))
IMM ;
+1 DO S(BDMPG,62,$$ASPIRIN^BDMPG16(BDMPG,BDMRBD,BDMRED))
+2 DO S(BDMPG,61,$$LIPID^BDMPG16(BDMPG,BDM6MBD,BDMRED))
+3 DO S(BDMPG,76,$$EKG^BDMPG12(BDMPG,BDMRED))
LABS ;
+1 DO S(BDMPG,90,$$FGLUCOSE^BDMDG18(BDMPG,$PIECE(^DPT(BDMPG,0),U,3),BDMADAT))
+2 DO S(BDMPG,91,$$G75^BDMDG18(BDMPG,$PIECE(^DPT(BDMPG,0),U,3),BDMADAT))
+3 DO S(BDMPG,86,$$CHOL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
+4 DO S(BDMPG,88,$$LDL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
+5 DO S(BDMPG,89,$$HDL^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
+6 DO S(BDMPG,190,$$TRIG^BDMDG18(BDMPG,BDMBDAT,BDMADAT))
+7 ;
+8 DO S(BDMPG,112,$$BMI^BDMDG18(BDMPG,BDMRBD,BDMRED))
+9 QUIT
DATE(D) ;EP
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+($EXTRACT(D,1,3)))
TRIBE(P) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNPAT(P,11))
QUIT ""
+3 QUIT $$TRIBE^AUPNPAT(P,"C")_"^"_$$TRIBE^AUPNPAT(P,"E")
COMM(P) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNPAT(P,11))
QUIT ""
+3 QUIT $$COMMRES^AUPNPAT(P,"C")_"^"_$$COMMRES^AUPNPAT(P,"E")
