APCLP810 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
EN ; - ENTRY POINT - from ^APCLASK
K ^APCLDATA("APCLEPI",$J)
S ^XTMP("APCLP81",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^PRE DM AUDIT 2007"
S APCLEPIN=0
S APCLPD=0 F S APCLPD=$O(^XTMP("APCLP81",APCLJOB,APCLBTH,"PATS",APCLPD)) Q:'APCLPD D
.I APCLTYPE'="P",APCLTYPE'="S" Q:$$DEMO^APCLUTL(APCLPD,$G(APCLDEMO))
.;I APCLPREP=2 D EPIREC Q
.D GATHER
;I APCLPREP=2 D WRITEF^APCLP81 Q
I APCLPREP=2!(APCLPREP=3) D CUML^APCLP815
Q
S(P,I,V) ;
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",P,I)=V
Q
GATHER ;gather data for 1 patient
S APCLER=0
;set report dates
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,1)=$S($G(APCLFISC)]"":APCLFISC,1:APCLRBD_" - "_APCLRED)
;set audit date to DT
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,2)=$$FMTE^XLFDT(DT)
;set area, su, facility code and name
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,4)=$P(^DIC(4,DUZ(2),0),U)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,6)=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,8)=$E($P(^AUTTLOC(DUZ(2),0),U,10),3,4)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,10)=$E($P(^AUTTLOC(DUZ(2),0),U,10),5,6)
;# pats in register
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,12)=$S(APCLDMRG:$$RSTAT^APCLDM6(APCLDMRG,"A"),1:"")
;reviewer
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,14)=$P(^VA(200,DUZ,0),U,2)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,15)=$$VAL^XBDIQ1(9000001,APCLPD,.14)
DEMO ;pat demographics
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,16)=$$HRN^AUPNPAT(APCLPD,DUZ(2))
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,18)=$$DOB^AUPNPAT(APCLPD,"E")
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,20)=$$VAL^XBDIQ1(2,APCLPD,.02)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,120)=$$TRIBE(APCLPD)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,121)=$$COMM(APCLPD)
DXDT ;dates of and dm dxs
K APCLDATA D IFG^APCLP813(APCLPD,.APCLDATA)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,200)=$S($D(APCLDATA):"Yes",1:"No")
S X=0 F S X=$O(APCLDATA(X)) Q:X'=+X D
.S Y=200_"."_X
.S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
K APCLDATA D IGT^APCLP813(APCLPD,.APCLDATA)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,210)=$S($D(APCLDATA):"Yes",1:"No")
S X=0 F S X=$O(APCLDATA(X)) Q:X'=+X D
.S Y=210_"."_X
.S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
K APCLDATA D MS^APCLP813(APCLPD,.APCLDATA)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,220)=$S($D(APCLDATA):"Yes",1:"No")
S X=0 F S X=$O(APCLDATA(X)) Q:X'=+X D
.S Y=220_"."_X
.S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
K APCLDATA D ABNG^APCLP813(APCLPD,.APCLDATA)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,230)=$S($D(APCLDATA):"Yes",1:"No")
S X=0 F S X=$O(APCLDATA(X)) Q:X'=+X D
.S Y=230_"."_X
.S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,22)=$S(APCLDMRG:$$CMSFDX^APCLP813(APCLPD,APCLDMRG,"D"),1:"")
S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,24)=$S(APCLDMRG:$$CMSFDX^APCLP813(APCLPD,APCLDMRG,"DX"),1:"")
I $$PLDMDXS^APCLP813(APCLPD)]"" D S(APCLPD,25,"PLEASE NOTE: Diabetes is on the Problem list for this patient")
S X=$$FRSTDMDX^APCLP813(APCLPD,"E") I X]"" D S(APCLPD,26,"PLEASE NOTE: Diabetes has been used as a diagnosis in PCC: "_X)
D S(APCLPD,27,$$TOBACCO^APCLP816(APCLPD,APCLRED))
D S(APCLPD,28,$$CESS^APCLP811(APCLPD,APCLRBD,APCLRED))
VITAL ;
D S(APCLPD,30,$$LASTHT^APCLP813(APCLPD,APCLRED))
D S(APCLPD,32,$$LASTWT^APCLP813(APCLPD,APCLRED))
D S(APCLPD,33,$$LASTWC^APCLP813(APCLPD,APCLRED))
;htn dx
D S(APCLPD,34,$$HTNDX^APCLP813(APCLPD,APCLRED))
;last 3 BPs
D S(APCLPD,36,$$BPS^APCLP813(APCLPD,APCLRBD,APCLRED))
EXAMS ;
D S(APCLPD,44,$$DIETEDUC^APCLP817(APCLPD,APCLRBD,APCLRED))
D S(APCLPD,46,$$EXEDUC^APCLP817(APCLPD,APCLRBD,APCLRED))
THERAPY ;
S APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31)),APCL6MBD=$$FMTE^XLFDT(APCL6MBD)
D S(APCLPD,53,$$SULF^APCLP812(APCLPD,APCL6MBD,APCLRED))
D S(APCLPD,54,$$MET^APCLP812(APCLPD,APCL6MBD,APCLRED))
D S(APCLPD,55,$$ACAR^APCLP812(APCLPD,APCL6MBD,APCLRED))
D S(APCLPD,56,$$TROG^APCLP812(APCLPD,APCL6MBD,APCLRED))
S Y="" F X=53:1:56 I ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,X)="X" S Y=1
D S(APCLPD,51,$S(Y:"",1:"X"))
D S(APCLPD,60,$$ACE^APCLP816(APCLPD,APCL6MBD,APCLRED))
IMM ;
D S(APCLPD,62,$$ASPIRIN^APCLP816(APCLPD,APCLRBD,APCLRED))
D S(APCLPD,61,$$LIPID^APCLP816(APCLPD,APCL6MBD,APCLRED))
D S(APCLPD,76,$$EKG^APCLP812(APCLPD,APCLRED))
LABS ;
D S(APCLPD,90,$$FGLUCOSE^APCLD718(APCLPD,$P(^DPT(APCLPD,0),U,3),APCLADAT))
D S(APCLPD,91,$$G75^APCLD718(APCLPD,$P(^DPT(APCLPD,0),U,3),APCLADAT))
D S(APCLPD,86,$$CHOL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
D S(APCLPD,88,$$LDL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
D S(APCLPD,89,$$HDL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
D S(APCLPD,90,$$TRIG^APCLD718(APCLPD,APCLBDAT,APCLADAT))
;
D S(APCLPD,112,$$BMI^APCLD718(APCLPD,APCLRBD,APCLRED))
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")
APCLP810 ; IHS/CMI/LAB -IHS -GETS DATA FOR DIABETES QA REPORT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
EN ; - ENTRY POINT - from ^APCLASK
+1 KILL ^APCLDATA("APCLEPI",$JOB)
+2 SET ^XTMP("APCLP81",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^PRE DM AUDIT 2007"
+3 SET APCLEPIN=0
+4 SET APCLPD=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLP81",APCLJOB,APCLBTH,"PATS",APCLPD))
IF 'APCLPD
QUIT
Begin DoDot:1
+5 IF APCLTYPE'="P"
IF APCLTYPE'="S"
IF $$DEMO^APCLUTL(APCLPD,$GET(APCLDEMO))
QUIT
+6 ;I APCLPREP=2 D EPIREC Q
+7 DO GATHER
End DoDot:1
+8 ;I APCLPREP=2 D WRITEF^APCLP81 Q
+9 IF APCLPREP=2!(APCLPREP=3)
DO CUML^APCLP815
+10 QUIT
S(P,I,V) ;
+1 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",P,I)=V
+2 QUIT
GATHER ;gather data for 1 patient
+1 SET APCLER=0
+1 ;set report dates
+2 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,1)=$SELECT($GET(APCLFISC)]"":APCLFISC,1:APCLRBD_" - "_APCLRED)
+3 ;set audit date to DT
+4 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,2)=$$FMTE^XLFDT(DT)
+5 ;set area, su, facility code and name
+6 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,4)=$PIECE(^DIC(4,DUZ(2),0),U)
+7 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,6)=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
+8 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,8)=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),3,4)
+9 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,10)=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),5,6)
+10 ;# pats in register
+11 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,12)=$SELECT(APCLDMRG:$$RSTAT^APCLDM6(APCLDMRG,"A"),1:"")
+12 ;reviewer
+13 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,14)=$PIECE(^VA(200,DUZ,0),U,2)
+14 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,15)=$$VAL^XBDIQ1(9000001,APCLPD,.14)
DEMO ;pat demographics
+1 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,16)=$$HRN^AUPNPAT(APCLPD,DUZ(2))
+2 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,18)=$$DOB^AUPNPAT(APCLPD,"E")
+3 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,20)=$$VAL^XBDIQ1(2,APCLPD,.02)
+4 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,120)=$$TRIBE(APCLPD)
+5 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,121)=$$COMM(APCLPD)
DXDT ;dates of and dm dxs
+1 KILL APCLDATA
DO IFG^APCLP813(APCLPD,.APCLDATA)
+2 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,200)=$SELECT($DATA(APCLDATA):"Yes",1:"No")
+3 SET X=0
FOR
SET X=$ORDER(APCLDATA(X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET Y=200_"."_X
+5 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
End DoDot:1
+6 KILL APCLDATA
DO IGT^APCLP813(APCLPD,.APCLDATA)
+7 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,210)=$SELECT($DATA(APCLDATA):"Yes",1:"No")
+8 SET X=0
FOR
SET X=$ORDER(APCLDATA(X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET Y=210_"."_X
+10 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
End DoDot:1
+11 KILL APCLDATA
DO MS^APCLP813(APCLPD,.APCLDATA)
+12 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,220)=$SELECT($DATA(APCLDATA):"Yes",1:"No")
+13 SET X=0
FOR
SET X=$ORDER(APCLDATA(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 SET Y=220_"."_X
+15 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
End DoDot:1
+16 KILL APCLDATA
DO ABNG^APCLP813(APCLPD,.APCLDATA)
+17 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,230)=$SELECT($DATA(APCLDATA):"Yes",1:"No")
+18 SET X=0
FOR
SET X=$ORDER(APCLDATA(X))
IF X'=+X
QUIT
Begin DoDot:1
+19 SET Y=230_"."_X
+20 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,Y)=APCLDATA(X)
End DoDot:1
+21 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,22)=$SELECT(APCLDMRG:$$CMSFDX^APCLP813(APCLPD,APCLDMRG,"D"),1:"")
+22 SET ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,24)=$SELECT(APCLDMRG:$$CMSFDX^APCLP813(APCLPD,APCLDMRG,"DX"),1:"")
+23 IF $$PLDMDXS^APCLP813(APCLPD)]""
DO S(APCLPD,25,"PLEASE NOTE: Diabetes is on the Problem list for this patient")
+24 SET X=$$FRSTDMDX^APCLP813(APCLPD,"E")
IF X]""
DO S(APCLPD,26,"PLEASE NOTE: Diabetes has been used as a diagnosis in PCC: "_X)
+25 DO S(APCLPD,27,$$TOBACCO^APCLP816(APCLPD,APCLRED))
+26 DO S(APCLPD,28,$$CESS^APCLP811(APCLPD,APCLRBD,APCLRED))
VITAL ;
+1 DO S(APCLPD,30,$$LASTHT^APCLP813(APCLPD,APCLRED))
+2 DO S(APCLPD,32,$$LASTWT^APCLP813(APCLPD,APCLRED))
+3 DO S(APCLPD,33,$$LASTWC^APCLP813(APCLPD,APCLRED))
+4 ;htn dx
+5 DO S(APCLPD,34,$$HTNDX^APCLP813(APCLPD,APCLRED))
+6 ;last 3 BPs
+7 DO S(APCLPD,36,$$BPS^APCLP813(APCLPD,APCLRBD,APCLRED))
EXAMS ;
+1 DO S(APCLPD,44,$$DIETEDUC^APCLP817(APCLPD,APCLRBD,APCLRED))
+2 DO S(APCLPD,46,$$EXEDUC^APCLP817(APCLPD,APCLRBD,APCLRED))
THERAPY ;
+1 SET APCL6MBD=$$FMADD^XLFDT(APCLADAT,-(6*31))
SET APCL6MBD=$$FMTE^XLFDT(APCL6MBD)
+2 DO S(APCLPD,53,$$SULF^APCLP812(APCLPD,APCL6MBD,APCLRED))
+3 DO S(APCLPD,54,$$MET^APCLP812(APCLPD,APCL6MBD,APCLRED))
+4 DO S(APCLPD,55,$$ACAR^APCLP812(APCLPD,APCL6MBD,APCLRED))
+5 DO S(APCLPD,56,$$TROG^APCLP812(APCLPD,APCL6MBD,APCLRED))
+6 SET Y=""
FOR X=53:1:56
IF ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",APCLPD,X)="X"
SET Y=1
+7 DO S(APCLPD,51,$SELECT(Y:"",1:"X"))
+8 DO S(APCLPD,60,$$ACE^APCLP816(APCLPD,APCL6MBD,APCLRED))
IMM ;
+1 DO S(APCLPD,62,$$ASPIRIN^APCLP816(APCLPD,APCLRBD,APCLRED))
+2 DO S(APCLPD,61,$$LIPID^APCLP816(APCLPD,APCL6MBD,APCLRED))
+3 DO S(APCLPD,76,$$EKG^APCLP812(APCLPD,APCLRED))
LABS ;
+1 DO S(APCLPD,90,$$FGLUCOSE^APCLD718(APCLPD,$PIECE(^DPT(APCLPD,0),U,3),APCLADAT))
+2 DO S(APCLPD,91,$$G75^APCLD718(APCLPD,$PIECE(^DPT(APCLPD,0),U,3),APCLADAT))
+3 DO S(APCLPD,86,$$CHOL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
+4 DO S(APCLPD,88,$$LDL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
+5 DO S(APCLPD,89,$$HDL^APCLD718(APCLPD,APCLBDAT,APCLADAT))
+6 DO S(APCLPD,90,$$TRIG^APCLD718(APCLPD,APCLBDAT,APCLADAT))
+7 ;
+8 DO S(APCLPD,112,$$BMI^APCLD718(APCLPD,APCLRBD,APCLRED))
+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")
