BUDDRP7U ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;11.0;IHS/RPMS UNIFORM DATA SYSTEM;;JAN 18, 2017;Build 66
;
;
S(V) ;
S BUDDECNT=BUDDECNT+1
S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
Q
;----------
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;general introductions
D GENI^BUDDRP7I
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")
;----------
;
HTUR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2015",80)
W !!,"Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino Identity"
W !,"of patients 18 to 85 years old who have had at least one medical visit"
W !,"during the report period, were diagnosed with hypertension before"
W !,"June 30 of the report period, and who do not have controlled blood"
W !,"pressure (<140/90 mm HG) during the report period."
W !
Q
HTURL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTURH Q:BUDQUIT
I '$D(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR")) S X="No patients to report." W:BUDROT="P" !!,X D:BUDROT="D" S(),S(X) Q
D HTURL1
I BUDROT="P",$Y>(IOSL-4) D HTURH G:BUDQUIT HTURLX
I BUDROT="P" W !!,"TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC",!,"OR LATINO IDENTITY: "_BUDTOT
I BUDROT="D" D S(),S("TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC OR LATINO IDENTITY: "_BUDTOT)
HTURLX ;
Q
HTURL1 ;
I BUDROT="P",$Y>(IOSL-7) D HTURH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTURL2
Q
HTURL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDDRP7I(BUDRACE,BUDETH)
I BUDROT="P" W !,BUDRACEL
I BUDROT="D" D S(BUDRACEL)
S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D HTURH Q:BUDQUIT W !,BUDRACEL,!
....I BUDROT="P" W !?2,$E($P(^DPT(DFN,0),U,1),1,20),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$E(BUDCCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,! ;
....I BUDROT="D" S BUDPV="",BUDPV=$E($P(^DPT(DFN,0),U,1),1,30)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_BUDA
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDDRPTC(DFN)
....I BUDROT="P" W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDDRPTC(DFN),U,3)_"-"_$P($$RACE^BUDDRPTC(DFN),U,4),1,19)
....I BUDROT="D" S BUDPV=BUDPV_U_$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3)_")"
....S BUDHISV=$$HISP^BUDDRPTC(DFN)
....I BUDROT="P" W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....I BUDROT="D" S BUDPV=BUDPV_U_$P(BUDHISV,U,3)_" ("_$P(BUDHISV,U,2)_")"
....S BUDALL=^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"#",1)
....I BUDROT="P" W ?5,$P(BUDALL,"#",2),!
....I BUDROT="D" S BUDPV=BUDPV_U_$P(BUDALL,"#",2)
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I BUDROT="P",$Y>(IOSL-3) D HTURH Q:BUDQUIT W !,BUDRACEL,!
.....I BUDROT="P" I $E(BUDV)="P" W ?5,BUDV,! Q
.....I BUDROT="D",$E(BUDV)="P" S BUDPV=BUDPV_U_BUDV D S(BUDPV) Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2),C=$P(C,"^",1)
.....I BUDROT="P" W ?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$P(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$E($$VAL^XBDIQ1(9000010,V,.06),1,15),!
.....I BUDROT="D" S X=BUDPV_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$P(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06) D S(X)
I BUDROT="P",$Y>(IOSL-4) D HTURH Q:BUDQUIT W !,BUDRACEL,!
I BUDROT="P" W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
Q
HTURHD ;
D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) ***")
D S("Patient List for Table 7, Section B, Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity")
D S($P(^DIC(4,BUDSITE,0),U))
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
S X="Population: "_$S($G(BUDDEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDDEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDDEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") D S(X)
D S()
D S("List by race and Hispanic or Latino Identity of all patients 18 to 85")
D S("years old who have had at least one medical visit during the report period,")
D S("who were diagnosed with hypertension before June 30 of the report")
D S("period, and do not have controlled blood pressure (BP <140/90 mm Hg).")
D S("Age is calculated as of December 31.")
D S("* E - denotes the value was obtained from the Ethnicity field.")
D S(" R - denotes the value was obtained from the Race field")
D S(" C - denotes the value was obtained from the Classification/Beneficiary field")
D S()
D S("PATIENT NAME^HRN^COMMUNITY^AGE^RACE*^HISPANIC OR LATINO IDENTITY^LAST BP VALUE DATE^LAST HTN DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
Q
HTURH ;
I BUDROT="D" D HTURHD Q
G:'BUDGPG HTURH1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q
HTURH1 ;
W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
W !,$$CTR("Patient List for Table 7, Section B",80)
W !,$$CTR("Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity",80),!
W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
W $TR($J("",80)," ","-")
I BUDP=0 D
.W !,"List by race and Hispanic or Latino Identity of all patients 18 to 85"
.W !,"years old who have had at least one medical visit during the report period,"
.W !,"who were diagnosed with hypertension before June 30 of the report"
.W !,"period, and do not have controlled blood pressure (BP <140/90 mm Hg)."
.W !,"Age is calculated as of December 31."
.W !,"* E - denotes the value was obtained from the Ethnicity field."
.W !," R - denotes the value was obtained from the Race field"
.W !," C - denotes the value was obtained from the Classification/Beneficiary field"
.W !
W !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
W !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
W !?5,"LAST BP VALUE & DATE"
W !?5,"LAST HTN DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
BUDDRP7U ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;11.0;IHS/RPMS UNIFORM DATA SYSTEM;;JAN 18, 2017;Build 66
+2 ;
+3 ;
S(V) ;
+1 SET BUDDECNT=BUDDECNT+1
+2 SET ^TMP($JOB,"BUDDEL",BUDDECNT)=$GET(V)
+3 QUIT
+4 ;----------
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
GENI ;general introductions
+1 DO GENI^BUDDRP7I
+2 QUIT
+3 ;
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 ;----------
+3 ;
HTUR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2015",80)
+4 WRITE !!,"Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino Identity"
+8 WRITE !,"of patients 18 to 85 years old who have had at least one medical visit"
+9 WRITE !,"during the report period, were diagnosed with hypertension before"
+10 WRITE !,"June 30 of the report period, and who do not have controlled blood"
+11 WRITE !,"pressure (<140/90 mm HG) during the report period."
+12 WRITE !
+13 QUIT
HTURL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTURH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR"))
SET X="No patients to report."
IF BUDROT="P"
WRITE !!,X
IF BUDROT="D"
DO S()
DO S(X)
QUIT
+4 DO HTURL1
+5 IF BUDROT="P"
IF $Y>(IOSL-4)
DO HTURH
IF BUDQUIT
GOTO HTURLX
+6 IF BUDROT="P"
WRITE !!,"TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC",!,"OR LATINO IDENTITY: "_BUDTOT
+7 IF BUDROT="D"
DO S()
DO S("TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC OR LATINO IDENTITY: "_BUDTOT)
HTURLX ;
+1 QUIT
HTURL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO HTURH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO HTURL2
End DoDot:1
+5 QUIT
HTURL2 ;
+1 SET BUDSTOT=0
+2 SET BUDRACEL=$$RACEL^BUDDRP7I(BUDRACE,BUDETH)
+3 IF BUDROT="P"
WRITE !,BUDRACEL
+4 IF BUDROT="D"
DO S(BUDRACEL)
+5 SET BUDCCOM=""
FOR
SET BUDCCOM=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+6 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+7 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+9 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+10 ;
IF BUDROT="P"
WRITE !?2,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,20),?24,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$EXTRACT(BUDCCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?5
1,BUDA,!
+11 IF BUDROT="D"
SET BUDPV=""
SET BUDPV=$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,30)_U_$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$EXTRACT(BUDCCOM,1,12)_U_$PIECE(^DPT(DFN,0),U,2)_U_BUDA
+12 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+13 SET BUDRACV=$$RACE^BUDDRPTC(DFN)
+14 ;,?60,$E($P($$RACE^BUDDRPTC(DFN),U,3)_"-"_$P($$RACE^BUDDRPTC(DFN),U,4),1,19)
IF BUDROT="P"
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+15 IF BUDROT="D"
SET BUDPV=BUDPV_U_$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3)_")"
+16 SET BUDHISV=$$HISP^BUDDRPTC(DFN)
+17 IF BUDROT="P"
WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+18 IF BUDROT="D"
SET BUDPV=BUDPV_U_$PIECE(BUDHISV,U,3)_" ("_$PIECE(BUDHISV,U,2)_")"
+19 SET BUDALL=^XTMP("BUDDRP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)
+20 SET BUDPPV=$PIECE(BUDALL,"#",1)
+21 IF BUDROT="P"
WRITE ?5,$PIECE(BUDALL,"#",2),!
+22 IF BUDROT="D"
SET BUDPV=BUDPV_U_$PIECE(BUDALL,"#",2)
+23 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+24 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+25 IF BUDROT="P"
IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+26 IF BUDROT="D"
IF $EXTRACT(BUDV)="P"
SET BUDPV=BUDPV_U_BUDV
DO S(BUDPV)
QUIT
+27 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
SET C=$PIECE(C,"^",1)
+28 IF BUDROT="P"
WRITE ?5,$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$PIECE(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$EXTRACT($$VAL^XBDIQ1(9000010,V,.06),1,15),!
+29 IF BUDROT="D"
SET X=BUDPV_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$PIECE(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06)
DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF BUDROT="P"
IF $Y>(IOSL-4)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+31 IF BUDROT="P"
WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+32 IF BUDROT="D"
DO S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
+33 QUIT
HTURHD ;
+1 DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
+2 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+3 DO S("*** RPMS Uniform Data System (UDS) ***")
+4 DO S("Patient List for Table 7, Section B, Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity")
+5 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+6 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+7 SET X="Population: "_$SELECT($GET(BUDDEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDDEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDDEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"")
DO S(X)
+8 DO S()
+9 DO S("List by race and Hispanic or Latino Identity of all patients 18 to 85")
+10 DO S("years old who have had at least one medical visit during the report period,")
+11 DO S("who were diagnosed with hypertension before June 30 of the report")
+12 DO S("period, and do not have controlled blood pressure (BP <140/90 mm Hg).")
+13 DO S("Age is calculated as of December 31.")
+14 DO S("* E - denotes the value was obtained from the Ethnicity field.")
+15 DO S(" R - denotes the value was obtained from the Race field")
+16 DO S(" C - denotes the value was obtained from the Classification/Beneficiary field")
+17 DO S()
+18 DO S("PATIENT NAME^HRN^COMMUNITY^AGE^RACE*^HISPANIC OR LATINO IDENTITY^LAST BP VALUE DATE^LAST HTN DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
+19 QUIT
HTURH ;
+1 IF BUDROT="D"
DO HTURHD
QUIT
+2 IF 'BUDGPG
GOTO HTURH1
+3 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BUDQUIT=1
QUIT
HTURH1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BUDGPG=BUDGPG+1
+2 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
+4 WRITE !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
+5 WRITE !,$$CTR("Patient List for Table 7, Section B",80)
+6 WRITE !,$$CTR("Hypertension w/Uncontrolled BP by Race and Hispanic or Latino Identity",80),!
+7 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+8 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !,"List by race and Hispanic or Latino Identity of all patients 18 to 85"
+12 WRITE !,"years old who have had at least one medical visit during the report period,"
+13 WRITE !,"who were diagnosed with hypertension before June 30 of the report"
+14 WRITE !,"period, and do not have controlled blood pressure (BP <140/90 mm Hg)."
+15 WRITE !,"Age is calculated as of December 31."
+16 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
+17 WRITE !," R - denotes the value was obtained from the Race field"
+18 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
+19 WRITE !
End DoDot:1
+20 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
+21 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
+22 WRITE !?5,"LAST BP VALUE & DATE"
+23 WRITE !?5,"LAST HTN DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+24 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+25 SET BUDP=1
+26 QUIT
+27 ;
