BUDHRP71 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE ; 30 Jul 2018 3:45 PM
;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
;
;
PRINT ;EP
S BUDPG=0 S:'$G(BUDXXXXX) BUDSCTC=1
;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
S BUDQUIT=0
I BUDROT="D" D G PL
.D ^%ZISC ;close printer device
.K ^TMP($J)
.S ^TMP($J,"BUDDEL",0)=0
.S BUDDECNT=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 R2B
W ?5,"| Refused" D R2B
W ?5,"| to Report Race" D R2B
W ?5,"| and Ethnicity" S BUDTELL=3,X=1 D R1C
D RB
W "i",?5,"| Total" W ?23,"|",?28,$$C($P($G(BUDSECTC(4)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTC(4)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTC(4)),U,5),8),!
D RB ;W $$REPEAT^XLFSTR("_",80),!
Q:BUDQUIT
I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
PL D LISTS
I BUDROT'="D",'$G(BUDXXXXX) W !,"***** END OF REPORT *****",!
I BUDROT="D" D ^%ZISC
I BUDROT="D" D SAVEDEL^BUDHRPTD
K ^XTMP("BUDHRP7",BUDJ,BUDH)
Q
P71 ;
D HEADER^BUDHRPTP Q:BUDQUIT D T7H
W $$CTR("SECTION A: DELIVERIES AND BIRTH WEIGHT",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 Health Center'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,"| Other Pacific" D R1
W ?5,"| 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^BUDHRPTP Q:BUDQUIT D T7H
W $$CTR("Section B: Controlling High Blood Pressure",80),!
W $$REPEAT^XLFSTR("_",80),!
W ?5,"|",?23,"|Total Patients 18",?42,"| Charts Sampled or",?61,"| Patients with HTN",!
W " #",?5,"| Race and ",?23,"|through 85 Years",?42,"| EHR Total",?61,"| Controlled",!
W ?5,"| Ethnicity ",?23,"|of Age with",?42,"| ",?61,"| ",!
W ?5,"| ",?23,"|Hypertension",?42,"| ",?61,"| ",!
W ?5,"| ",?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,"| Other Pacific" D R2B
W ?5,"| 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^BUDHRPTP Q:BUDQUIT D T7H
W $$CTR("Section C: Diabetes: Hemoglobin A1c (HbA1c) Poor Control (> 9%)",80),!
W $$REPEAT^XLFSTR("_",80),!
W ?5,"|",?23,"|Total Patients 18",?42,"| Charts Sampled or",?61,"| Patients with ",!
W " #",?5,"| Race and ",?23,"|through 75 Years",?42,"| EHR Total",?61,"| HbA1c >9% or No",!
W ?5,"| Ethnicity ",?23,"|of Age with",?42,"| ",?61,"| Test During Year",!
W ?5,"| ",?23,"|Diabetes",?42,"| ",?61,"| ",!
W ?5,"| ",?23,"| (3a)",?42,"| (3b)",?61,"| (3f)",!
D RB
W BUDTELB,!
W $$REPEAT^XLFSTR("_",80),!
W BUDTELN_"a",?5,"| Asian" S X=1 D R1C
D RB
W BUDTELN_"b1",?5,"| Native Hawaiian" S X=2 D R1C
D RB
W BUDTELN_"b2",?5,"| Other Pacific" D R2B
W ?5,"| Islander" S X=3 D R1C
D RB
W BUDTELN_"c",?5,"| Black/African" D R2B
W ?5,"| American" S X=4 D R1C
D RB
W BUDTELN_"d",?5,"| American Indian/" D R2B
W ?5,"| Alaska Native" S X=5 D R1C
D RB
W BUDTELN_"e",?5,"| White" S X=6 D R1C
D RB
W BUDTELN_"f",?5,"| More than One" D R2B
W ?5,"| Race" S X=7 D R1C
D RB
W BUDTELN_"g",?5,"| Unreported/" D R2B
W ?5,"| Refused" D R2B
W ?5,"| to Report Race" S X=8 D R1C
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(BUDSECTC(BUDTELL)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTC(BUDTELL)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTC(BUDTELL)),U,5),8),!
D RB
Q
RC ;EP
;W $$REPEAT^XLFSTR("_",80),!
W "_____|_________________|________|________|________|____________________",!
Q
R1C ;EP
W ?23,"|",?24,$$C($P($G(BUDSECTC(BUDTELL,X)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTC(BUDTELL,X)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTC(BUDTELL,X)),U,5),7),!
Q
R2C ;EP
W ?23,"|",?32,"|",?41,"|",?50,"|",!
Q
LISTS ;
I $G(BUDPRGHL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D PRGHL^BUDHRP7I I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDPRGRL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D PRGRL^BUDHRP7I I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDHTRL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D HTRL^BUDHRP7J I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDHTCRL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D HTCRL^BUDHRP7J I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDHTURL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D HTURL^BUDHRP7U I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDDMRL) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D DMRL^BUDHRP7L I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
I $G(BUDDMR1L) S BUDGPG=0,BUDSCTC=BUDSCTC+1 D DMR1L^BUDHRP7T I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
K ^XTMP("BUDHRP7",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
BUDHRP71 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE ; 30 Jul 2018 3:45 PM
+1 ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
+2 ;
+3 ;
PRINT ;EP
+1 SET BUDPG=0
IF '$GET(BUDXXXXX)
SET BUDSCTC=1
+2 ;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
+3 SET BUDQUIT=0
+4 IF BUDROT="D"
Begin DoDot:1
+5 ;close printer device
DO ^%ZISC
+6 KILL ^TMP($JOB)
+7 SET ^TMP($JOB,"BUDDEL",0)=0
+8 SET BUDDECNT=0
End DoDot:1
GOTO PL
+9 SET BUDTELB="Hispanic/Latino"
SET BUDTELN=1
+10 DO P71
+11 IF BUDQUIT
QUIT
+12 SET BUDTELB="Non-Hispanic/Latino"
SET BUDTELN=2
+13 DO P71
+14 IF BUDQUIT
QUIT
+15 ;D R
+16 WRITE "Unreported/Refused to Report Ethnicity",!
+17 WRITE $$REPEAT^XLFSTR("_",80),!
+18 WRITE "h",?5,"|Unreported/"
DO R1
+19 WRITE ?5,"| Refused"
DO R1
+20 WRITE ?5,"| to Report Race"
DO R1
+21 WRITE ?5,"| and Ethnicity"
DO R1
+22 DO R
+23 WRITE "i",?5,"| Total"
DO R1
+24 ;W $$REPEAT^XLFSTR("_",80),!
DO R
+25 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 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 R1C
+13 DO RB
+14 WRITE "i",?5,"| Total"
WRITE ?23,"|",?28,$$C($PIECE($GET(BUDSECTC(4)),U,1),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTC(4)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTC(4)),U,5),8),!
+15 ;W $$REPEAT^XLFSTR("_",80),!
DO RB
+16 IF BUDQUIT
QUIT
+17 IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
PL DO LISTS
+1 IF BUDROT'="D"
IF '$GET(BUDXXXXX)
WRITE !,"***** END OF REPORT *****",!
+2 IF BUDROT="D"
DO ^%ZISC
+3 IF BUDROT="D"
DO SAVEDEL^BUDHRPTD
+4 KILL ^XTMP("BUDHRP7",BUDJ,BUDH)
+5 QUIT
P71 ;
+1 DO HEADER^BUDHRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("SECTION A: DELIVERIES AND BIRTH WEIGHT",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 Health Center'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,"| Other Pacific"
DO R1
+15 WRITE ?5,"| Islander"
DO R1
+16 DO R
+17 WRITE BUDTELN_"c",?5,"| Black/African"
DO R1
+18 WRITE ?5,"| American"
DO R1
+19 DO R
+20 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R1
+21 WRITE ?5,"| Alaska Native"
DO R1
+22 DO R
+23 WRITE BUDTELN_"e",?5,"| White"
DO R1
+24 DO R
+25 WRITE BUDTELN_"f",?5,"| More than One"
DO R1
+26 WRITE ?5,"| Race"
DO R1
+27 DO R
+28 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R1
+29 WRITE ?5,"| Refused"
DO R1
+30 WRITE ?5,"| to Report Race"
DO R1
+31 DO R
+32 WRITE ?5,"| Subtotal"
+33 IF BUDTELB["Non"
WRITE ?16,"Non-"
+34 DO R1
+35 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB),?23,"| | | | ",!
IF 1
+36 DO R
+37 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^BUDHRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("Section B: Controlling High Blood Pressure",80),!
+3 WRITE $$REPEAT^XLFSTR("_",80),!
+4 WRITE ?5,"|",?23,"|Total Patients 18",?42,"| Charts Sampled or",?61,"| Patients with HTN",!
+5 WRITE " #",?5,"| Race and ",?23,"|through 85 Years",?42,"| EHR Total",?61,"| Controlled",!
+6 WRITE ?5,"| Ethnicity ",?23,"|of Age with",?42,"| ",?61,"| ",!
+7 WRITE ?5,"| ",?23,"|Hypertension",?42,"| ",?61,"| ",!
+8 WRITE ?5,"| ",?23,"| (2a)",?42,"| (2b)",?61,"| (2c)",!
+9 DO RB
+10 WRITE BUDTELB,!
+11 WRITE $$REPEAT^XLFSTR("_",80),!
+12 WRITE BUDTELN_"a",?5,"| Asian"
SET X=1
DO R1B
+13 DO RB
+14 WRITE BUDTELN_"b1",?5,"| Native Hawaiian"
SET X=2
DO R1B
+15 DO RB
+16 WRITE BUDTELN_"b2",?5,"| Other Pacific"
DO R2B
+17 WRITE ?5,"| Islander"
SET X=3
DO R1B
+18 DO RB
+19 WRITE BUDTELN_"c",?5,"| Black/African"
DO R2B
+20 WRITE ?5,"| American"
SET X=4
DO R1B
+21 DO RB
+22 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R2B
+23 WRITE ?5,"| Alaska Native"
SET X=5
DO R1B
+24 DO RB
+25 WRITE BUDTELN_"e",?5,"| White"
SET X=6
DO R1B
+26 DO RB
+27 WRITE BUDTELN_"f",?5,"| More than One"
DO R2B
+28 WRITE ?5,"| Race"
SET X=7
DO R1B
+29 DO RB
+30 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R2B
+31 WRITE ?5,"| Refused"
DO R2B
+32 WRITE ?5,"| to Report Race"
SET X=8
DO R1B
+33 DO RB
+34 WRITE ?5,"| Subtotal"
+35 IF BUDTELB["Non"
WRITE ?16,"Non-"
+36 DO R2B
+37 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB)
Begin DoDot:1
+38 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
+39 DO RB
+40 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^BUDHRPTP
IF BUDQUIT
QUIT
DO T7H
+2 WRITE $$CTR("Section C: Diabetes: Hemoglobin A1c (HbA1c) Poor Control (> 9%)",80),!
+3 WRITE $$REPEAT^XLFSTR("_",80),!
+4 WRITE ?5,"|",?23,"|Total Patients 18",?42,"| Charts Sampled or",?61,"| Patients with ",!
+5 WRITE " #",?5,"| Race and ",?23,"|through 75 Years",?42,"| EHR Total",?61,"| HbA1c >9% or No",!
+6 WRITE ?5,"| Ethnicity ",?23,"|of Age with",?42,"| ",?61,"| Test During Year",!
+7 WRITE ?5,"| ",?23,"|Diabetes",?42,"| ",?61,"| ",!
+8 WRITE ?5,"| ",?23,"| (3a)",?42,"| (3b)",?61,"| (3f)",!
+9 DO RB
+10 WRITE BUDTELB,!
+11 WRITE $$REPEAT^XLFSTR("_",80),!
+12 WRITE BUDTELN_"a",?5,"| Asian"
SET X=1
DO R1C
+13 DO RB
+14 WRITE BUDTELN_"b1",?5,"| Native Hawaiian"
SET X=2
DO R1C
+15 DO RB
+16 WRITE BUDTELN_"b2",?5,"| Other Pacific"
DO R2B
+17 WRITE ?5,"| Islander"
SET X=3
DO R1C
+18 DO RB
+19 WRITE BUDTELN_"c",?5,"| Black/African"
DO R2B
+20 WRITE ?5,"| American"
SET X=4
DO R1C
+21 DO RB
+22 WRITE BUDTELN_"d",?5,"| American Indian/"
DO R2B
+23 WRITE ?5,"| Alaska Native"
SET X=5
DO R1C
+24 DO RB
+25 WRITE BUDTELN_"e",?5,"| White"
SET X=6
DO R1C
+26 DO RB
+27 WRITE BUDTELN_"f",?5,"| More than One"
DO R2B
+28 WRITE ?5,"| Race"
SET X=7
DO R1C
+29 DO RB
+30 WRITE BUDTELN_"g",?5,"| Unreported/"
DO R2B
+31 WRITE ?5,"| Refused"
DO R2B
+32 WRITE ?5,"| to Report Race"
SET X=8
DO R1C
+33 DO RB
+34 WRITE ?5,"| Subtotal"
+35 IF BUDTELB["Non"
WRITE ?16,"Non-"
+36 DO R2B
+37 WRITE ?5,"| ",$SELECT(BUDTELB["-":$PIECE(BUDTELB,"-",2),1:BUDTELB)
Begin DoDot:1
+38 WRITE ?23,"|",?28,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,1),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTC(BUDTELL)),U,5),8),!
End DoDot:1
+39 DO RB
+40 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),8),?42,"|",?47,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,2),8),?61,"|",?66,$$C($PIECE($GET(BUDSECTC(BUDTELL,X)),U,5),7),!
+2 QUIT
R2C ;EP
+1 WRITE ?23,"|",?32,"|",?41,"|",?50,"|",!
+2 QUIT
LISTS ;
+1 IF $GET(BUDPRGHL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO PRGHL^BUDHRP7I
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+2 IF $GET(BUDPRGRL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO PRGRL^BUDHRP7I
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+3 IF $GET(BUDHTRL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO HTRL^BUDHRP7J
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+4 IF $GET(BUDHTCRL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO HTCRL^BUDHRP7J
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+5 IF $GET(BUDHTURL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO HTURL^BUDHRP7U
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+6 IF $GET(BUDDMRL)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO DMRL^BUDHRP7L
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+7 IF $GET(BUDDMR1L)
SET BUDGPG=0
SET BUDSCTC=BUDSCTC+1
DO DMR1L^BUDHRP7T
IF BUDTSCTC>1
IF BUDROT'="D"
WRITE !,"***** END OF SECTION ",BUDSCTC," *****",!
+8 KILL ^XTMP("BUDHRP7",BUDJ,BUDH)
+9 QUIT
+10 ;
+11 ;
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
