BDMDG1U.m

BDMDG1U ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 22 Feb 2014 3:43 PM ; 

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51

 ;

 ;

SDPI16 ;EP

 ;print aggregate audit

 ;

 ;

PRINT ;

 ;S BDMPG=0

 S BDMQUIT=0

 D HEADER

 D PRINT1 ;print each indicator

 D EXIT

 Q

 ;

PRINT1 ;

 I BDMNOGO D

 .W !!,"***NOTE:  ",BDMNOGO," Patients were not included in this report because ",!,"their date of onset was after the Audit end period date.",!

 W !!,$P(BDMCUML(10),U,1)

 W !?5,$P(BDMCUML(10,1),U),?49,$$C($P(BDMCUML(10,1),U,2)),?61,$$C($P(BDMCUML(10,1),U,3)),?73,$$P($P(BDMCUML(10,1),U,3),$P(BDMCUML(10,1),U,2))

 W !?5,$P(BDMCUML(10,2),U)

 W !?5,$P(BDMCUML(10,3),U)

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(20),U)

 W !?5,$P(BDMCUML(20,1),U),?49,$$C($P(BDMCUML(20,1),U,2)),?61,$$C($P(BDMCUML(20,1),U,3)),?73,$$P($P(BDMCUML(20,1),U,3),$P(BDMCUML(20,1),U,2))

 W !?5,$P(BDMCUML(20,2),U)

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(30),U)

 W !?5,$P(BDMCUML(30,1),U),?49,$$C($P(BDMCUML(30,1),U,2)),?61,$$C($P(BDMCUML(30,1),U,3)),?73,$$P($P(BDMCUML(30,1),U,3),$P(BDMCUML(30,1),U,2))

 ;dental

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(40),U)

 W !?5,$P(BDMCUML(40,1),U),?49,$$C($P(BDMCUML(40,1),U,2)),?61,$$C($P(BDMCUML(40,1),U,3)),?73,$$P($P(BDMCUML(40,1),U,3),$P(BDMCUML(40,1),U,2))

 ;depression screening

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(50),U)

 W !?5,$P(BDMCUML(50,1),U),?49,$$C($P(BDMCUML(50,1),U,2)),?61,$$C($P(BDMCUML(50,1),U,3)),?73,$$P($P(BDMCUML(50,1),U,3),$P(BDMCUML(50,1),U,2))

 W !?5,BDMCUML(50,2)

 ;diab educ

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(60),U)

 W !?5,$P(BDMCUML(60,1),U),?49,$$C($P(BDMCUML(60,1),U,2)),?61,$$C($P(BDMCUML(60,1),U,3)),?73,$$P($P(BDMCUML(60,1),U,3),$P(BDMCUML(60,1),U,2))

 W !?5,$P(BDMCUML(60,2),U)

 ;EYE

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(70),U)

 W !?5,$P(BDMCUML(70,1),U),?49,$$C($P(BDMCUML(70,1),U,2)),?61,$$C($P(BDMCUML(70,1),U,3)),?73,$$P($P(BDMCUML(70,1),U,3),$P(BDMCUML(70,1),U,2))

 ;foot

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(80),U)

 W !?5,$P(BDMCUML(80,1),U),?49,$$C($P(BDMCUML(80,1),U,2)),?61,$$C($P(BDMCUML(80,1),U,3)),?73,$$P($P(BDMCUML(80,1),U,3),$P(BDMCUML(80,1),U,2))

 ;glycemic control

 I $Y>(BDMIOSL-9) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(90),U)

 W !?5,$P(BDMCUML(90,1),U),?49,$$C($P(BDMCUML(90,1),U,2)),?61,$$C($P(BDMCUML(90,1),U,3)),?73,$$P($P(BDMCUML(90,1),U,3),$P(BDMCUML(90,1),U,2))

IMM ;

 ;HEP C

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(95),U)

 W !?5,$P(BDMCUML(95,1),U),?49,$$C($P(BDMCUML(95,1),U,2)),?61,$$C($P(BDMCUML(95,1),U,3)),?73,$$P($P(BDMCUML(95,1),U,3),$P(BDMCUML(95,1),U,2))

 ;HEP B

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(100),U)

 W !?5,$P(BDMCUML(100,1),U),?49,$$C($P(BDMCUML(100,1),U,2)),?61,$$C($P(BDMCUML(100,1),U,3)),?73,$$P($P(BDMCUML(100,1),U,3),$P(BDMCUML(100,1),U,2))

 ;FLU

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(110),U)

 W !?5,$P(BDMCUML(110,1),U),?49,$$C($P(BDMCUML(110,1),U,2)),?61,$$C($P(BDMCUML(110,1),U,3)),?73,$$P($P(BDMCUML(110,1),U,3),$P(BDMCUML(110,1),U,2))

 ;PNEU

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(120),U)

 W !?5,$P(BDMCUML(120,1),U),?49,$$C($P(BDMCUML(120,1),U,2)),?61,$$C($P(BDMCUML(120,1),U,3)),?73,$$P($P(BDMCUML(120,1),U,3),$P(BDMCUML(120,1),U,2))

 ;TD

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(130),U)

 W !?5,$P(BDMCUML(130,1),U),?49,$$C($P(BDMCUML(130,1),U,2)),?61,$$C($P(BDMCUML(130,1),U,3)),?73,$$P($P(BDMCUML(130,1),U,3),$P(BDMCUML(130,1),U,2))

LIPID ;

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(140),U)

 W !?5,$P(BDMCUML(140,1),U),?49,$$C($P(BDMCUML(140,1),U,2)),?61,$$C($P(BDMCUML(140,1),U,3)),?73,$$P($P(BDMCUML(140,1),U,3),$P(BDMCUML(140,1),U,2))

 W !?5,$P(BDMCUML(140,2),U)

NUTR ;

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(150),U)

 W !?5,$P(BDMCUML(150,1),U),?49,$$C($P(BDMCUML(150,1),U,2)),?61,$$C($P(BDMCUML(150,1),U,3)),?73,$$P($P(BDMCUML(150,1),U,3),$P(BDMCUML(150,1),U,2)),!?5,$P(BDMCUML(150,2),U,1)

PHY ;

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(160),U)

 W !?5,$P(BDMCUML(160,1),U),?49,$$C($P(BDMCUML(160,1),U,2)),?61,$$C($P(BDMCUML(160,1),U,3)),?73,$$P($P(BDMCUML(160,1),U,3),$P(BDMCUML(160,1),U,2))

TOB ;

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(170),U)

 W !?5,$P(BDMCUML(170,1),U),?49,$$C($P(BDMCUML(170,1),U,2)),?61,$$C($P(BDMCUML(170,1),U,3)),?73,$$P($P(BDMCUML(170,1),U,3),$P(BDMCUML(170,1),U,2))

 W !?5,$P(BDMCUML(170,2),U)

TB ;

 I $Y>(BDMIOSL-5) D HEADER Q:BDMQUIT

 W !!,$P(BDMCUML(180),U)

 W !?5,$P(BDMCUML(180,1),U),?49,$$C($P(BDMCUML(180,1),U,2)),?61,$$C($P(BDMCUML(180,1),U,3)),?73,$$P($P(BDMCUML(180,1),U,3),$P(BDMCUML(180,1),U,2))

 Q

EXIT ;

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO",DIR("A")="End of report.  Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

CALC(N,O) ;ENTRY POINT

 ;N is new

 ;O is old

 NEW Z

 I O=0!(N=0) Q "**"

 NEW X,X2,X3

 S X=N,X2=1,X3=0 D COMMA^%DTC S N=X

 S X=O,X2=1,X3=0 D COMMA^%DTC S O=X

 S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)

 Q Z

P(D,N) ;return %

 I 'D Q ""

 I 'N Q "  0%"

 NEW X S X=N/D,X=X*100,X=$J(X,3,0)

 Q X_"%"

C(X,X2,X3) ;

 I '$G(X2) S X2=0

 I '$G(X3) S X3=6

 D COMMA^%DTC

 Q X

HEADER ;EP

 G:'BDMPG HEADER1

 W !

 K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT=1 Q

HEADER1 ;

 I BDMPG W:$D(IOF) @IOF

 S BDMPG=BDMPG+1

 I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"

 I $G(BDMGUI) W !!

 W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!

 W !,$$CTR("IHS Diabetes Care and Outcomes Audit - RPMS ",80),!

 N BDMDHDR

 S BDMDHDR="SDPI Required Key Measures Report for 2019 ("_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"

 W $$CTR(BDMDHDR,80),!

 ;W $$CTR("AUDIT REPORT FOR 2019 (Audit Period "_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"),!

 S X="Facility: "_$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U) W $$CTR(X,80),!

 S X="Annual Audit" W $$CTR(X,80),!

 S X=$P(BDMCUML(20,1),U,3)_" patients were audited" W !,$$CTR(X),!

 W $TR($J("",80)," ","-"),!

 W ?45,"# of ",?57,"#",?70,"Percent",!

 W ?45,"Patients",?57,"Considered",!

 W ?45,"(Numerator)",?57,"(Denominator)",!

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR

 Q

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

BDMDG1U   ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 22 Feb 2014 3:43 PM ; 

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51

 +2       ;

 +3       ;

SDPI16    ;EP

 +1       ;print aggregate audit

 +2       ;

 +3       ;

PRINT     ;

 +1       ;S BDMPG=0

 +2        SET BDMQUIT=0

 +3        DO HEADER

 +4       ;print each indicator

           DO PRINT1

 +5        DO EXIT

 +6        QUIT 

 +7       ;

PRINT1    ;

 +1        IF BDMNOGO

               Begin DoDot:1

 +2                WRITE !!,"***NOTE:  ",BDMNOGO," Patients were not included in this report because ",!,"their date of onset was after the Audit end period date.",!

               End DoDot:1

 +3        WRITE !!,$PIECE(BDMCUML(10),U,1)

 +4        WRITE !?5,$PIECE(BDMCUML(10,1),U),?49,$$C($PIECE(BDMCUML(10,1),U,2)),?61,$$C($PIECE(BDMCUML(10,1),U,3)),?73,$$P($PIECE(BDMCUML(10,1),U,3),$PIECE(BDMCUML(10,1),U,2))

 +5        WRITE !?5,$PIECE(BDMCUML(10,2),U)

 +6        WRITE !?5,$PIECE(BDMCUML(10,3),U)

 +7        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +8        WRITE !!,$PIECE(BDMCUML(20),U)

 +9        WRITE !?5,$PIECE(BDMCUML(20,1),U),?49,$$C($PIECE(BDMCUML(20,1),U,2)),?61,$$C($PIECE(BDMCUML(20,1),U,3)),?73,$$P($PIECE(BDMCUML(20,1),U,3),$PIECE(BDMCUML(20,1),U,2))

 +10       WRITE !?5,$PIECE(BDMCUML(20,2),U)

 +11       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +12       WRITE !!,$PIECE(BDMCUML(30),U)

 +13       WRITE !?5,$PIECE(BDMCUML(30,1),U),?49,$$C($PIECE(BDMCUML(30,1),U,2)),?61,$$C($PIECE(BDMCUML(30,1),U,3)),?73,$$P($PIECE(BDMCUML(30,1),U,3),$PIECE(BDMCUML(30,1),U,2))

 +14      ;dental

 +15       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +16       WRITE !!,$PIECE(BDMCUML(40),U)

 +17       WRITE !?5,$PIECE(BDMCUML(40,1),U),?49,$$C($PIECE(BDMCUML(40,1),U,2)),?61,$$C($PIECE(BDMCUML(40,1),U,3)),?73,$$P($PIECE(BDMCUML(40,1),U,3),$PIECE(BDMCUML(40,1),U,2))

 +18      ;depression screening

 +19       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +20       WRITE !!,$PIECE(BDMCUML(50),U)

 +21       WRITE !?5,$PIECE(BDMCUML(50,1),U),?49,$$C($PIECE(BDMCUML(50,1),U,2)),?61,$$C($PIECE(BDMCUML(50,1),U,3)),?73,$$P($PIECE(BDMCUML(50,1),U,3),$PIECE(BDMCUML(50,1),U,2))

 +22       WRITE !?5,BDMCUML(50,2)

 +23      ;diab educ

 +24       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +25       WRITE !!,$PIECE(BDMCUML(60),U)

 +26       WRITE !?5,$PIECE(BDMCUML(60,1),U),?49,$$C($PIECE(BDMCUML(60,1),U,2)),?61,$$C($PIECE(BDMCUML(60,1),U,3)),?73,$$P($PIECE(BDMCUML(60,1),U,3),$PIECE(BDMCUML(60,1),U,2))

 +27       WRITE !?5,$PIECE(BDMCUML(60,2),U)

 +28      ;EYE

 +29       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +30       WRITE !!,$PIECE(BDMCUML(70),U)

 +31       WRITE !?5,$PIECE(BDMCUML(70,1),U),?49,$$C($PIECE(BDMCUML(70,1),U,2)),?61,$$C($PIECE(BDMCUML(70,1),U,3)),?73,$$P($PIECE(BDMCUML(70,1),U,3),$PIECE(BDMCUML(70,1),U,2))

 +32      ;foot

 +33       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +34       WRITE !!,$PIECE(BDMCUML(80),U)

 +35       WRITE !?5,$PIECE(BDMCUML(80,1),U),?49,$$C($PIECE(BDMCUML(80,1),U,2)),?61,$$C($PIECE(BDMCUML(80,1),U,3)),?73,$$P($PIECE(BDMCUML(80,1),U,3),$PIECE(BDMCUML(80,1),U,2))

 +36      ;glycemic control

 +37       IF $Y>(BDMIOSL-9)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +38       WRITE !!,$PIECE(BDMCUML(90),U)

 +39       WRITE !?5,$PIECE(BDMCUML(90,1),U),?49,$$C($PIECE(BDMCUML(90,1),U,2)),?61,$$C($PIECE(BDMCUML(90,1),U,3)),?73,$$P($PIECE(BDMCUML(90,1),U,3),$PIECE(BDMCUML(90,1),U,2))

IMM       ;

 +1       ;HEP C

 +2        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +3        WRITE !!,$PIECE(BDMCUML(95),U)

 +4        WRITE !?5,$PIECE(BDMCUML(95,1),U),?49,$$C($PIECE(BDMCUML(95,1),U,2)),?61,$$C($PIECE(BDMCUML(95,1),U,3)),?73,$$P($PIECE(BDMCUML(95,1),U,3),$PIECE(BDMCUML(95,1),U,2))

 +5       ;HEP B

 +6        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +7        WRITE !!,$PIECE(BDMCUML(100),U)

 +8        WRITE !?5,$PIECE(BDMCUML(100,1),U),?49,$$C($PIECE(BDMCUML(100,1),U,2)),?61,$$C($PIECE(BDMCUML(100,1),U,3)),?73,$$P($PIECE(BDMCUML(100,1),U,3),$PIECE(BDMCUML(100,1),U,2))

 +9       ;FLU

 +10       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +11       WRITE !!,$PIECE(BDMCUML(110),U)

 +12       WRITE !?5,$PIECE(BDMCUML(110,1),U),?49,$$C($PIECE(BDMCUML(110,1),U,2)),?61,$$C($PIECE(BDMCUML(110,1),U,3)),?73,$$P($PIECE(BDMCUML(110,1),U,3),$PIECE(BDMCUML(110,1),U,2))

 +13      ;PNEU

 +14       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +15       WRITE !!,$PIECE(BDMCUML(120),U)

 +16       WRITE !?5,$PIECE(BDMCUML(120,1),U),?49,$$C($PIECE(BDMCUML(120,1),U,2)),?61,$$C($PIECE(BDMCUML(120,1),U,3)),?73,$$P($PIECE(BDMCUML(120,1),U,3),$PIECE(BDMCUML(120,1),U,2))

 +17      ;TD

 +18       IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +19       WRITE !!,$PIECE(BDMCUML(130),U)

 +20       WRITE !?5,$PIECE(BDMCUML(130,1),U),?49,$$C($PIECE(BDMCUML(130,1),U,2)),?61,$$C($PIECE(BDMCUML(130,1),U,3)),?73,$$P($PIECE(BDMCUML(130,1),U,3),$PIECE(BDMCUML(130,1),U,2))

LIPID     ;

 +1        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +2        WRITE !!,$PIECE(BDMCUML(140),U)

 +3        WRITE !?5,$PIECE(BDMCUML(140,1),U),?49,$$C($PIECE(BDMCUML(140,1),U,2)),?61,$$C($PIECE(BDMCUML(140,1),U,3)),?73,$$P($PIECE(BDMCUML(140,1),U,3),$PIECE(BDMCUML(140,1),U,2))

 +4        WRITE !?5,$PIECE(BDMCUML(140,2),U)

NUTR      ;

 +1        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +2        WRITE !!,$PIECE(BDMCUML(150),U)

 +3        WRITE !?5,$PIECE(BDMCUML(150,1),U),?49,$$C($PIECE(BDMCUML(150,1),U,2)),?61,$$C($PIECE(BDMCUML(150,1),U,3)),?73,$$P($PIECE(BDMCUML(150,1),U,3),$PIECE(BDMCUML(150,1),U,2)),!?5,$PIECE(BDMCUML(150,2),U,1)

PHY       ;

 +1        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +2        WRITE !!,$PIECE(BDMCUML(160),U)

 +3        WRITE !?5,$PIECE(BDMCUML(160,1),U),?49,$$C($PIECE(BDMCUML(160,1),U,2)),?61,$$C($PIECE(BDMCUML(160,1),U,3)),?73,$$P($PIECE(BDMCUML(160,1),U,3),$PIECE(BDMCUML(160,1),U,2))

TOB       ;

 +1        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +2        WRITE !!,$PIECE(BDMCUML(170),U)

 +3        WRITE !?5,$PIECE(BDMCUML(170,1),U),?49,$$C($PIECE(BDMCUML(170,1),U,2)),?61,$$C($PIECE(BDMCUML(170,1),U,3)),?73,$$P($PIECE(BDMCUML(170,1),U,3),$PIECE(BDMCUML(170,1),U,2))

 +4        WRITE !?5,$PIECE(BDMCUML(170,2),U)

TB        ;

 +1        IF $Y>(BDMIOSL-5)

               DO HEADER

               IF BDMQUIT

                   QUIT 

 +2        WRITE !!,$PIECE(BDMCUML(180),U)

 +3        WRITE !?5,$PIECE(BDMCUML(180,1),U),?49,$$C($PIECE(BDMCUML(180,1),U,2)),?61,$$C($PIECE(BDMCUML(180,1),U,3)),?73,$$P($PIECE(BDMCUML(180,1),U,3),$PIECE(BDMCUML(180,1),U,2))

 +4        QUIT 

EXIT      ;

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   SET DIR("A")="End of report.  Press ENTER"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +2        QUIT 

CALC(N,O) ;ENTRY POINT

 +1       ;N is new

 +2       ;O is old

 +3        NEW Z

 +4        IF O=0!(N=0)

               QUIT "**"

 +5        NEW X,X2,X3

 +6        SET X=N

           SET X2=1

           SET X3=0

           DO COMMA^%DTC

           SET N=X

 +7        SET X=O

           SET X2=1

           SET X3=0

           DO COMMA^%DTC

           SET O=X

 +8        SET Z=(((N-O)/O)*100)

           SET Z=$FNUMBER(Z,"+,",1)

 +9        QUIT Z

P(D,N)    ;return %

 +1        IF 'D

               QUIT ""

 +2        IF 'N

               QUIT "  0%"

 +3        NEW X

           SET X=N/D

           SET X=X*100

           SET X=$JUSTIFY(X,3,0)

 +4        QUIT X_"%"

C(X,X2,X3) ;

 +1        IF '$GET(X2)

               SET X2=0

 +2        IF '$GET(X3)

               SET X3=6

 +3        DO COMMA^%DTC

 +4        QUIT X

HEADER    ;EP

 +1        IF 'BDMPG

               GOTO HEADER1

 +2        WRITE !

 +3        KILL DIR

           IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BDMQUIT=1

                       QUIT 

HEADER1   ;

 +1        IF BDMPG

               IF $DATA(IOF)

                   WRITE @IOF

 +2        SET BDMPG=BDMPG+1

 +3        IF $GET(BDMGUI)

               IF BDMPG'=1

                   WRITE !,"ZZZZZZZ"

 +4        IF $GET(BDMGUI)

               WRITE !!

 +5        WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!

 +6        WRITE !,$$CTR("IHS Diabetes Care and Outcomes Audit - RPMS ",80),!

 +7        NEW BDMDHDR

 +8        SET BDMDHDR="SDPI Required Key Measures Report for 2019 ("_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"

 +9        WRITE $$CTR(BDMDHDR,80),!

 +10      ;W $$CTR("AUDIT REPORT FOR 2019 (Audit Period "_$$DATE^BDMS9B1(BDMBDAT)_" to "_$$DATE^BDMS9B1(BDMADAT)_")"),!

 +11       SET X="Facility: "_$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U)

           WRITE $$CTR(X,80),!

 +12       SET X="Annual Audit"

           WRITE $$CTR(X,80),!

 +13       SET X=$PIECE(BDMCUML(20,1),U,3)_" patients were audited"

           WRITE !,$$CTR(X),!

 +14       WRITE $TRANSLATE($JUSTIFY("",80)," ","-"),!

 +15       WRITE ?45,"# of ",?57,"#",?70,"Percent",!

 +16       WRITE ?45,"Patients",?57,"Considered",!

 +17       WRITE ?45,"(Numerator)",?57,"(Denominator)",!

 +18       QUIT 

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

EOP       ;EP - End of page.

 +1        IF $EXTRACT(IOST)'="C"

               QUIT 

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT 

 +3        NEW DIR

 +4        KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR(0)="E"

           DO ^DIR

 +6        QUIT 

 +7       ;----------

USR()     ;EP - Return name of current user from ^VA(200.

 +1        QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 +2       ;----------

LOC()     ;EP - Return location name from file 4 based on DUZ(2).

 +1        QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 +2       ;----------