BUDBRP71 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
PRINT ;EP
S BUDPG=0
;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
S BUDQUIT=0
S BUDTELB="Hispanic/Latino",BUDTELN=1
D P71
Q:BUDQUIT
S BUDTELB="Non-Hispanic/Latino",BUDTELN=2
D P71
Q:BUDQUIT
;D R
W "Unreported/Refused to Report Ethnicity",!
W $$REPEAT^XLFSTR("_",80),!
W "h",?5,"|Unreported/" D R1
W ?5,"| Refused" D R1
W ?5,"| to Report Race" D R1
W ?5,"| and Ethnicity" D R1
D R
W "i",?5,"| Total" D R1
D R ;W $$REPEAT^XLFSTR("_",80),!
Q:BUDQUIT
B7 ;
S BUDTELB="Hispanic/Latino",BUDTELL=1,BUDTELN=1
D P7B
Q:BUDQUIT
S BUDTELB="Non-Hispanic/Latino",BUDTELL=2,BUDTELN=2
D P7B
Q:BUDQUIT
W "Unreported/Refused to Report Ethnicity",!
W $$REPEAT^XLFSTR("_",80),!
W "h",?5,"|Unreported/" D R2B
W ?5,"| Refused" D R2B
W ?5,"| to Report Race" D R2B
W ?5,"| and Ethnicity" S BUDTELL=3,X=1 D R1B
D RB
W "i",?5,"| Total" W ?23,"|",?28,$$C($P($G(BUDSECTB(4)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(4)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(4)),U,3),8),!
D RB ;W $$REPEAT^XLFSTR("_",80),!
Q:BUDQUIT
;section c
C7 ;
S BUDTELB="Hispanic/Latino",BUDTELL=1,BUDTELN=1
D P7C
Q:BUDQUIT
S BUDTELB="Non-Hispanic/Latino",BUDTELL=2,BUDTELN=2
D P7C
Q:BUDQUIT
W "Unreported/Refused to Report Ethnicity",!
W $$REPEAT^XLFSTR("_",80),!
W "h",?5,"|Unreported/" D R2C
W ?5,"| Refused" D R2C
W ?5,"| to Report Race" D R2C
W ?5,"| and Ethnicity" S BUDTELL=3,X=1 D R1C
D RC
W "i",?5,"| Total" D
.W ?23,"|",?24,$$C($P($G(BUDSECTC(4)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(4)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(4)),U,4),7)
.W ?50,"|",?51,$$C($P($G(BUDSECTC(4)),U,5),7),?59,"|",?60,$$C($P($G(BUDSECTC(4)),U,6),7),!
D RC ;W $$REPEAT^XLFSTR("_",80),!
Q:BUDQUIT
D LISTS
Q
P71 ;
D HEADER^BUDBRPTP Q:BUDQUIT D T7H
W $$CTR("SECTION A: DELIVERIES AND BIRTH WEIGHT BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
W $$REPEAT^XLFSTR("_",80),!
I BUDTELB'="Hispanic/Latino" G P71A
W !,"0",?5,"HIV Positive Pregnant Women",$$REPEAT^XLFSTR("*",(67-$X)),?67,"| ",$P($G(BUDSECTH(1)),U,18),!
W $$REPEAT^XLFSTR("_",80),!
W "2",?5,"Deliveries Performed by Grantee's Providers",$$REPEAT^XLFSTR("*",(67-$X)),?67,"|",!
W $$REPEAT^XLFSTR("_",80),!
;D R
P71A ;W !!,$$REPEAT^XLFSTR("_",80),!
W ?5,"|",?23,"|Prenatal Care",?37,"| Live Births:",?51,"| Live Births:",?65,"| Live Births:",!
W ?5,"|",?23,"| Patients Who",?37,"| <1500 grams",?51,"| 1500-2499",?65,"| =>2500 grams",!
W "Line",?5,"| Race and ",?23,"| Delivered",?37,"|",?51,"| grams",?65,"|",!
W " #",?5,"| Ethnicity",?23,"| During the",?37,"|",?51,"|",?65,"|",!
W ?5,"|",?23,"| Year",?37,"|",?51,"|",?65,"|",!
W ?5,"|",?23,"| (1a)",?37,"| (1b)",?51,"| (1c)",?65,"| (1d)",!
D R
W BUDTELB,!
W $$REPEAT^XLFSTR("_",80),!
W BUDTELN_"a",?5,"| Asian" D R1
D R
W BUDTELN_"b1",?5,"| Native Hawaiian" D R1
D R
W BUDTELN_"b2",?5,"| Pacific Islander" D R1
D R
W BUDTELN_"c",?5,"| Black/African" D R1
W ?5,"| American" D R1
D R
W BUDTELN_"d",?5,"| American Indian/" D R1
W ?5,"| Alaska Native" D R1
D R
W BUDTELN_"e",?5,"| White" D R1
D R
W BUDTELN_"f",?5,"| More than One" D R1
W ?5,"| Race" D R1
D R
W BUDTELN_"g",?5,"| Unreported/" D R1
W ?5,"| Refused" D R1
W ?5,"| to Report Race" D R1
D R
W ?5,"| Subtotal"
I BUDTELB["Non" W ?16,"Non-"
D R1
W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB),?23,"| | | | ",! I 1
D R
Q
R ;EP
;W $$REPEAT^XLFSTR("_",80),!
W "_____|_________________|_____________|_____________|_____________|______________",!
Q
R1 ;EP
W ?23,"|",?37,"|",?51,"|",?65,"|",!
Q
P7B ;
D HEADER^BUDBRPTP Q:BUDQUIT D T7H
W $$CTR("SECTION B: HYPERTENSION BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
W $$REPEAT^XLFSTR("_",80),!
W ?5,"|",?23,"|Total Hypertensive",?42,"| Charts Sampled or",?61,"| Patients with HTN",!
W " #",?5,"| Race and ",?23,"| Patients",?42,"| EHR Total",?61,"| Controlled",!
W ?5,"| Ethnicity",?23,"| (2a)",?42,"| (2b)",?61,"| (2c)",!
D RB
W BUDTELB,!
W $$REPEAT^XLFSTR("_",80),!
W BUDTELN_"a",?5,"| Asian" S X=1 D R1B
D RB
W BUDTELN_"b1",?5,"| Native Hawaiian" S X=2 D R1B
D RB
W BUDTELN_"b2",?5,"| Pacific Islander" S X=3 D R1B
D RB
W BUDTELN_"c",?5,"| Black/African" D R2B
W ?5,"| American" S X=4 D R1B
D RB
W BUDTELN_"d",?5,"| American Indian/" D R2B
W ?5,"| Alaska Native" S X=5 D R1B
D RB
W BUDTELN_"e",?5,"| White" S X=6 D R1B
D RB
W BUDTELN_"f",?5,"| More than One" D R2B
W ?5,"| Race" S X=7 D R1B
D RB
W BUDTELN_"g",?5,"| Unreported/" D R2B
W ?5,"| Refused" D R2B
W ?5,"| to Report Race" S X=8 D R1B
D RB
W ?5,"| Subtotal"
I BUDTELB["Non" W ?16,"Non-"
D R2B
W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB) D
.W ?23,"|",?28,$$C($P($G(BUDSECTB(BUDTELL)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(BUDTELL)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(BUDTELL)),U,3),8),!
D RB
Q
RB ;EP
;W $$REPEAT^XLFSTR("_",80),!
W "_____|_________________|__________________|__________________|__________________",!
Q
R1B ;EP
W ?23,"|",?28,$$C($P($G(BUDSECTB(BUDTELL,X)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(BUDTELL,X)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(BUDTELL,X)),U,3),8),!
Q
R2B ;EP
W ?23,"|",?42,"|",?61,"|",!
Q
P7C ;
D HEADER^BUDBRPTP Q:BUDQUIT D T7H
W $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO ETHNCITY",80),!
W $$REPEAT^XLFSTR("_",72),!
W ?5,"|",?23,"| Total",?32,"| Charts",?41,"|Patients",?50,"|Patients",?59,"|Patients",!
W " #",?5,"| Race and ",?23,"|Patients",?32,"|Sampled",?41,"| with",?50,"| with",?59,"| with",!
W ?5,"| Ethnicity",?23,"| with",?32,"| or EHR",?41,"| Hba1c",?50,"| 8%<=",?59,"| Hba1c",!
W ?5,"|",?23,"|Diabetes",?32,"| Total",?41,"| <8%",?50,"| Hba1c",?59,"|>9% Or No",!
W ?5,"|",?23,"|",?32,"|",?41,"| ",?50,"| <=9%",?59,"| Test",!
W ?5,"|",?23,"|",?32,"|",?41,"|",?50,"|",?59,"|During Year",!
W ?5,"|",?23,"| (3a)",?32,"| (3b)",?41,"| (3d1)",?50,"| (3e)",?59,"| (3f)",!
D RC
W BUDTELB,!
W $$REPEAT^XLFSTR("_",72),!
W BUDTELN_"a",?5,"| Asian" S X=1 D R1C
D RC
W BUDTELN_"b1",?5,"| Native Hawaiian" S X=2 D R1C
D RC
W BUDTELN_"b2",?5,"| Pacific Islander" S X=3 D R1C
D RC
W BUDTELN_"c",?5,"| Black/African" D R2C
W ?5,"| American" S X=4 D R1C
D RC
W BUDTELN_"d",?5,"| American Indian/" D R2C
W ?5,"| Alaska Native" S X=5 D R1C
D RC
W BUDTELN_"e",?5,"| White" S X=6 D R1C
D RC
W BUDTELN_"f",?5,"| More than One" D R2C
W ?5,"| Race" S X=7 D R1C
D RC
W BUDTELN_"g",?5,"| Unreported/" D R2C
W ?5,"| Refused" D R2C
W ?5,"| to Report Race" S X=8 D R1C
D RC
W ?5,"| Subtotal"
I BUDTELB["Non" W ?16,"Non-"
D R2C
W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB) D
.W ?23,"|",?24,$$C($P($G(BUDSECTC(BUDTELL)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(BUDTELL)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(BUDTELL)),U,4),7)
.W ?50,"|",?51,$$C($P($G(BUDSECTC(BUDTELL)),U,5),7),?59,"|",?60,$$C($P($G(BUDSECTC(BUDTELL)),U,6),7),!
D RC
Q
RC ;EP
;W $$REPEAT^XLFSTR("_",80),!
W "_____|_________________|________|________|________|________|___________",!
Q
R1C ;EP
W ?23,"|",?24,$$C($P($G(BUDSECTC(BUDTELL,X)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(BUDTELL,X)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(BUDTELL,X)),U,4),7)
W ?50,"|",?51,$$C($P($G(BUDSECTC(BUDTELL,X)),U,5),7),?59,"|",?60,$$C($P($G(BUDSECTC(BUDTELL,X)),U,6),7),!
Q
R2C ;EP
W ?23,"|",?32,"|",?41,"|",?50,"|",?59,"|",!
Q
LISTS ;
I $G(BUDPRGHL) S BUDGPG=0 D PRGHL^BUDBRP7I
I $G(BUDPRGRL) S BUDGPG=0 D PRGRL^BUDBRP7I
;I $G(BUDPRGEL) S BUDGPG=0 D PRGEL^BUDBRP7I
I $G(BUDHTRL) S BUDGPG=0 D HTRL^BUDBRP7J
I $G(BUDHTCRL) S BUDGPG=0 D HTCRL^BUDBRP7J
I $G(BUDHTURL) S BUDGPG=0 D HTURL^BUDBRP7J
;I $G(BUDHTEL) S BUDGPG=0 D HTEL^BUDBRP7K
;I $G(BUDHTCEL) S BUDGPG=0 D HTCEL^BUDBRP7K
;I $G(BUDHTUEL) S BUDGPG=0 D HTUEL^BUDBRP7K
I $G(BUDDMRL) S BUDGPG=0 D DMRL^BUDBRP7L
I $G(BUDDMR1L) S BUDGPG=0 D DMR1L^BUDBRP7L
I $G(BUDDMR2L) S BUDGPG=0 D DMR2L^BUDBRP7T
I $G(BUDDMR3L) S BUDGPG=0 D DMR3L^BUDBRP7T
;I $G(BUDDMR4L) S BUDGPG=0 D DMR4L^BUDBRP7T
;I $G(BUDDMEL) S BUDGPG=0 D DMEL^BUDBRP7M
;I $G(BUDDME1L) S BUDGPG=0 D DME1L^BUDBRP7M
;I $G(BUDDME2L) S BUDGPG=0 D DME2L^BUDBRP7M
;I $G(BUDDME3L) S BUDGPG=0 D DME3L^BUDBRP7S
K ^XTMP("BUDBRP7",BUDJ,BUDH)
Q
;
;
T7H ;EP
W !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES"),! ;$$REPEAT^XLFSTR("_",80),! ;,!?41,"HISPANIC/LATINO (1)",!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
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")
;----------
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
C(X,Y) ;
I $G(Y)=1,+X=0 Q ""
I $G(Y)=2 Q "********"
S X2=0,X3=8
D COMMA^%DTC
Q X
LINE1 ;EP
W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",! ;$$REPEAT^XLFSTR("_",9),?79,"|",!
Q
T7H1 ;EP
W !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES",60),!,$$REPEAT^XLFSTR("_",69),! ;,!?41,"HISPANIC/LATINO",!
Q
LINE4 ;EP
W $$REPEAT^XLFSTR("_",69),?59,"|",!
Q
LINE5 ;EP
W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",! ;,$$REPEAT^XLFSTR("_",9),?79,"|",!
Q
LINE ;EP
W $$REPEAT^XLFSTR("_",69),?59,"|",!
Q
BUDBRP71 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
PRINT ;EP
+1 SET BUDPG=0
+2 ;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
+3 SET BUDQUIT=0
+4 SET BUDTELB="Hispanic/Latino"
SET BUDTELN=1
+5 DO P71
+6 IF BUDQUIT
QUIT
+7 SET BUDTELB="Non-Hispanic/Latino"
SET BUDTELN=2
+8 DO P71
+9 IF BUDQUIT
QUIT
+10 ;D R
+11 WRITE "Unreported/Refused to Report Ethnicity",!
+12 WRITE $$REPEAT^XLFSTR("_",80),!
+13 WRITE "h",?5,"|Unreported/"
DO R1
+14 WRITE ?5,"| Refused"
DO R1
+15 WRITE ?5,"| to Report Race"
DO R1
+16 WRITE ?5,"| and Ethnicity"
DO R1
+17 DO R
+18 WRITE "i",?5,"| Total"
DO R1
+19 ;W $$REPEAT^XLFSTR("_",80),!
DO R
+20 IF BUDQUIT
QUIT
B7 ;
+1 SET BUDTELB="Hispanic/Latino"
SET BUDTELL=1
SET BUDTELN=1
+2 DO P7B
+3 IF BUDQUIT
QUIT
+4 SET BUDTELB="Non-Hispanic/Latino"
SET BUDTELL=2
SET BUDTELN=2
+5 DO P7B
+6 IF BUDQUIT
QUIT
+7 WRITE "Unreported/Refused to Report Ethnicity",!
+8 WRITE $$REPEAT^XLFSTR("_",80),!
+9 WRITE "h",?5,"|Unreported/"
DO R2B
+10 WRITE ?5,"| Refused"
DO R2B
+11 WRITE ?5,"| to Report Race"
DO R2B
+12 WRITE ?5,"| and Ethnicity"
SET BUDTELL=3
SET X=1
DO R1B
+13 DO RB
+14 WRITE "i",?5,"| Total"
WRITE ?23,"|",?28,$$C($PIECE($GET(BUDSECTB(4)),U,1),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTB(4)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTB(4)),U,3),8),!
+15 ;W $$REPEAT^XLFSTR("_",80),!
DO RB
+16 IF BUDQUIT
QUIT
+17 ;section c
C7 ;
+1 SET BUDTELB="Hispanic/Latino"
SET BUDTELL=1
SET BUDTELN=1
+2 DO P7C
+3 IF BUDQUIT
QUIT
+4 SET BUDTELB="Non-Hispanic/Latino"
SET BUDTELL=2
SET BUDTELN=2
+5 DO P7C
+6 IF BUDQUIT
QUIT
+7 WRITE "Unreported/Refused to Report Ethnicity",!
+8 WRITE $$REPEAT^XLFSTR("_",80),!
+9 WRITE "h",?5,"|Unreported/"
DO R2C
+10 WRITE ?5,"| Refused"
DO R2C
+11 WRITE ?5,"| to Report Race"
DO R2C
+12 WRITE ?5,"| and Ethnicity"
SET BUDTELL=3
SET X=1
DO R1C
+13 DO RC
+14 WRITE "i",?5,"| Total"
Begin DoDot:1
+15 WRITE ?23,"|",?24,$$C($PIECE($GET(BUDSECTC(4)),U,1),7),?32,"|",?33,$$C($PIECE($GET(BUDSECTC(4)),U,2),7),?41,"|",?42,$$C($PIECE($GET(BUDSECTC(4)),U,4),7)
+16 WRITE ?50,"|",?51,$$C($PIECE($GET(BUDSECTC(4)),U,5),7),?59,"|",?60,$$C($PIECE($GET(BUDSECTC(4)),U,6),7),!
End DoDot:1
+17 ;W $$REPEAT^XLFSTR("_",80),!
DO RC
+18 IF BUDQUIT
QUIT
+19 DO LISTS
+20 QUIT
P71 ;
+1 DO HEADER^BUDBRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("SECTION A: DELIVERIES AND BIRTH WEIGHT BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
+3 WRITE $$REPEAT^XLFSTR("_",80),!
+4 IF BUDTELB'="Hispanic/Latino"
GOTO P71A
+5 WRITE !,"0",?5,"HIV Positive Pregnant Women",$$REPEAT^XLFSTR("*",(67-$X)),?67,"| ",$PIECE($GET(BUDSECTH(1)),U,18),!
+6 WRITE $$REPEAT^XLFSTR("_",80),!
+7 WRITE "2",?5,"Deliveries Performed by Grantee's Providers",$$REPEAT^XLFSTR("*",(67-$X)),?67,"|",!
+8 WRITE $$REPEAT^XLFSTR("_",80),!
+9 ;D R
P71A ;W !!,$$REPEAT^XLFSTR("_",80),!
+1 WRITE ?5,"|",?23,"|Prenatal Care",?37,"| Live Births:",?51,"| Live Births:",?65,"| Live Births:",!
+2 WRITE ?5,"|",?23,"| Patients Who",?37,"| <1500 grams",?51,"| 1500-2499",?65,"| =>2500 grams",!
+3 WRITE "Line",?5,"| Race and ",?23,"| Delivered",?37,"|",?51,"| grams",?65,"|",!
+4 WRITE " #",?5,"| Ethnicity",?23,"| During the",?37,"|",?51,"|",?65,"|",!
+5 WRITE ?5,"|",?23,"| Year",?37,"|",?51,"|",?65,"|",!
+6 WRITE ?5,"|",?23,"| (1a)",?37,"| (1b)",?51,"| (1c)",?65,"| (1d)",!
+7 DO R
+8 WRITE BUDTELB,!
+9 WRITE $$REPEAT^XLFSTR("_",80),!
+10 WRITE BUDTELN_"a",?5,"| Asian"
DO R1
+11 DO R
+12 WRITE BUDTELN_"b1",?5,"| Native Hawaiian"
DO R1
+13 DO R
+14 WRITE BUDTELN_"b2",?5,"| Pacific Islander"
DO R1
+15 DO R
+16 WRITE BUDTELN_"c",?5,"| Black/African"
DO R1
+17 WRITE ?5,"| American"
DO R1
+18 DO R
+19 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R1
+20 WRITE ?5,"| Alaska Native"
DO R1
+21 DO R
+22 WRITE BUDTELN_"e",?5,"| White"
DO R1
+23 DO R
+24 WRITE BUDTELN_"f",?5,"| More than One"
DO R1
+25 WRITE ?5,"| Race"
DO R1
+26 DO R
+27 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R1
+28 WRITE ?5,"| Refused"
DO R1
+29 WRITE ?5,"| to Report Race"
DO R1
+30 DO R
+31 WRITE ?5,"| Subtotal"
+32 IF BUDTELB["Non"
WRITE ?16,"Non-"
+33 DO R1
+34 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB),?23,"| | | | ",!
IF 1
+35 DO R
+36 QUIT
R ;EP
+1 ;W $$REPEAT^XLFSTR("_",80),!
+2 WRITE "_____|_________________|_____________|_____________|_____________|______________",!
+3 QUIT
R1 ;EP
+1 WRITE ?23,"|",?37,"|",?51,"|",?65,"|",!
+2 QUIT
P7B ;
+1 DO HEADER^BUDBRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("SECTION B: HYPERTENSION BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
+3 WRITE $$REPEAT^XLFSTR("_",80),!
+4 WRITE ?5,"|",?23,"|Total Hypertensive",?42,"| Charts Sampled or",?61,"| Patients with HTN",!
+5 WRITE " #",?5,"| Race and ",?23,"| Patients",?42,"| EHR Total",?61,"| Controlled",!
+6 WRITE ?5,"| Ethnicity",?23,"| (2a)",?42,"| (2b)",?61,"| (2c)",!
+7 DO RB
+8 WRITE BUDTELB,!
+9 WRITE $$REPEAT^XLFSTR("_",80),!
+10 WRITE BUDTELN_"a",?5,"| Asian"
SET X=1
DO R1B
+11 DO RB
+12 WRITE BUDTELN_"b1",?5,"| Native Hawaiian"
SET X=2
DO R1B
+13 DO RB
+14 WRITE BUDTELN_"b2",?5,"| Pacific Islander"
SET X=3
DO R1B
+15 DO RB
+16 WRITE BUDTELN_"c",?5,"| Black/African"
DO R2B
+17 WRITE ?5,"| American"
SET X=4
DO R1B
+18 DO RB
+19 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R2B
+20 WRITE ?5,"| Alaska Native"
SET X=5
DO R1B
+21 DO RB
+22 WRITE BUDTELN_"e",?5,"| White"
SET X=6
DO R1B
+23 DO RB
+24 WRITE BUDTELN_"f",?5,"| More than One"
DO R2B
+25 WRITE ?5,"| Race"
SET X=7
DO R1B
+26 DO RB
+27 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R2B
+28 WRITE ?5,"| Refused"
DO R2B
+29 WRITE ?5,"| to Report Race"
SET X=8
DO R1B
+30 DO RB
+31 WRITE ?5,"| Subtotal"
+32 IF BUDTELB["Non"
WRITE ?16,"Non-"
+33 DO R2B
+34 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB)
Begin DoDot:1
+35 WRITE ?23,"|",?28,$$C($PIECE($GET(BUDSECTB(BUDTELL)),U,1),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTB(BUDTELL)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTB(BUDTELL)),U,3),8),!
End DoDot:1
+36 DO RB
+37 QUIT
RB ;EP
+1 ;W $$REPEAT^XLFSTR("_",80),!
+2 WRITE "_____|_________________|__________________|__________________|__________________",!
+3 QUIT
R1B ;EP
+1 WRITE ?23,"|",?28,$$C($PIECE($GET(BUDSECTB(BUDTELL,X)),U,1),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTB(BUDTELL,X)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTB(BUDTELL,X)),U,3),8),!
+2 QUIT
R2B ;EP
+1 WRITE ?23,"|",?42,"|",?61,"|",!
+2 QUIT
P7C ;
+1 DO HEADER^BUDBRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("SECTION C: DIABETES BY RACE AND HISPANIC/LATINO ETHNCITY",80),!
+3 WRITE $$REPEAT^XLFSTR("_",72),!
+4 WRITE ?5,"|",?23,"| Total",?32,"| Charts",?41,"|Patients",?50,"|Patients",?59,"|Patients",!
+5 WRITE " #",?5,"| Race and ",?23,"|Patients",?32,"|Sampled",?41,"| with",?50,"| with",?59,"| with",!
+6 WRITE ?5,"| Ethnicity",?23,"| with",?32,"| or EHR",?41,"| Hba1c",?50,"| 8%<=",?59,"| Hba1c",!
+7 WRITE ?5,"|",?23,"|Diabetes",?32,"| Total",?41,"| <8%",?50,"| Hba1c",?59,"|>9% Or No",!
+8 WRITE ?5,"|",?23,"|",?32,"|",?41,"| ",?50,"| <=9%",?59,"| Test",!
+9 WRITE ?5,"|",?23,"|",?32,"|",?41,"|",?50,"|",?59,"|During Year",!
+10 WRITE ?5,"|",?23,"| (3a)",?32,"| (3b)",?41,"| (3d1)",?50,"| (3e)",?59,"| (3f)",!
+11 DO RC
+12 WRITE BUDTELB,!
+13 WRITE $$REPEAT^XLFSTR("_",72),!
+14 WRITE BUDTELN_"a",?5,"| Asian"
SET X=1
DO R1C
+15 DO RC
+16 WRITE BUDTELN_"b1",?5,"| Native Hawaiian"
SET X=2
DO R1C
+17 DO RC
+18 WRITE BUDTELN_"b2",?5,"| Pacific Islander"
SET X=3
DO R1C
+19 DO RC
+20 WRITE BUDTELN_"c",?5,"| Black/African"
DO R2C
+21 WRITE ?5,"| American"
SET X=4
DO R1C
+22 DO RC
+23 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R2C
+24 WRITE ?5,"| Alaska Native"
SET X=5
DO R1C
+25 DO RC
+26 WRITE BUDTELN_"e",?5,"| White"
SET X=6
DO R1C
+27 DO RC
+28 WRITE BUDTELN_"f",?5,"| More than One"
DO R2C
+29 WRITE ?5,"| Race"
SET X=7
DO R1C
+30 DO RC
+31 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R2C
+32 WRITE ?5,"| Refused"
DO R2C
+33 WRITE ?5,"| to Report Race"
SET X=8
DO R1C
+34 DO RC
+35 WRITE ?5,"| Subtotal"
+36 IF BUDTELB["Non"
WRITE ?16,"Non-"
+37 DO R2C
+38 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB)
Begin DoDot:1
+39 WRITE ?23,"|",?24,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,1),7),?32,"|",?33,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,2),7),?41,"|",?42,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,4),7)
+40 WRITE ?50,"|",?51,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,5),7),?59,"|",?60,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,6),7),!
End DoDot:1
+41 DO RC
+42 QUIT
RC ;EP
+1 ;W $$REPEAT^XLFSTR("_",80),!
+2 WRITE "_____|_________________|________|________|________|________|___________",!
+3 QUIT
R1C ;EP
+1 WRITE ?23,"|",?24,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,1),7),?32,"|",?33,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,2),7),?41,"|",?42,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,4),7)
+2 WRITE ?50,"|",?51,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,5),7),?59,"|",?60,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,6),7),!
+3 QUIT
R2C ;EP
+1 WRITE ?23,"|",?32,"|",?41,"|",?50,"|",?59,"|",!
+2 QUIT
LISTS ;
+1 IF $GET(BUDPRGHL)
SET BUDGPG=0
DO PRGHL^BUDBRP7I
+2 IF $GET(BUDPRGRL)
SET BUDGPG=0
DO PRGRL^BUDBRP7I
+3 ;I $G(BUDPRGEL) S BUDGPG=0 D PRGEL^BUDBRP7I
+4 IF $GET(BUDHTRL)
SET BUDGPG=0
DO HTRL^BUDBRP7J
+5 IF $GET(BUDHTCRL)
SET BUDGPG=0
DO HTCRL^BUDBRP7J
+6 IF $GET(BUDHTURL)
SET BUDGPG=0
DO HTURL^BUDBRP7J
+7 ;I $G(BUDHTEL) S BUDGPG=0 D HTEL^BUDBRP7K
+8 ;I $G(BUDHTCEL) S BUDGPG=0 D HTCEL^BUDBRP7K
+9 ;I $G(BUDHTUEL) S BUDGPG=0 D HTUEL^BUDBRP7K
+10 IF $GET(BUDDMRL)
SET BUDGPG=0
DO DMRL^BUDBRP7L
+11 IF $GET(BUDDMR1L)
SET BUDGPG=0
DO DMR1L^BUDBRP7L
+12 IF $GET(BUDDMR2L)
SET BUDGPG=0
DO DMR2L^BUDBRP7T
+13 IF $GET(BUDDMR3L)
SET BUDGPG=0
DO DMR3L^BUDBRP7T
+14 ;I $G(BUDDMR4L) S BUDGPG=0 D DMR4L^BUDBRP7T
+15 ;I $G(BUDDMEL) S BUDGPG=0 D DMEL^BUDBRP7M
+16 ;I $G(BUDDME1L) S BUDGPG=0 D DME1L^BUDBRP7M
+17 ;I $G(BUDDME2L) S BUDGPG=0 D DME2L^BUDBRP7M
+18 ;I $G(BUDDME3L) S BUDGPG=0 D DME3L^BUDBRP7S
+19 KILL ^XTMP("BUDBRP7",BUDJ,BUDH)
+20 QUIT
+21 ;
+22 ;
T7H ;EP
+1 ;$$REPEAT^XLFSTR("_",80),! ;,!?41,"HISPANIC/LATINO (1)",!
WRITE !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES"),!
+2 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 ;----------
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 ;----------
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
C(X,Y) ;
+1 IF $GET(Y)=1
IF +X=0
QUIT ""
+2 IF $GET(Y)=2
QUIT "********"
+3 SET X2=0
SET X3=8
+4 DO COMMA^%DTC
+5 QUIT X
LINE1 ;EP
+1 ;$$REPEAT^XLFSTR("_",9),?79,"|",!
WRITE $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",!
+2 QUIT
T7H1 ;EP
+1 ;,!?41,"HISPANIC/LATINO",!
WRITE !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES",60),!,$$REPEAT^XLFSTR("_",69),!
+2 QUIT
LINE4 ;EP
+1 WRITE $$REPEAT^XLFSTR("_",69),?59,"|",!
+2 QUIT
LINE5 ;EP
+1 ;,$$REPEAT^XLFSTR("_",9),?79,"|",!
WRITE $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",!
+2 QUIT
LINE ;EP
+1 WRITE $$REPEAT^XLFSTR("_",69),?59,"|",!
+2 QUIT