Routine: APCLP810

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

S(P,I,V) ;

 S ^XTMP("APCLP81",APCLJOB,APCLBTH,"AUDIT",P,I)=V

GATHER ;gather data for 1 patient

 S APCLER=0

HEADER ; Set node with report header info

 ;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))

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

HEADER    ; Set node with report header info

 +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")

APCLP810.m