BUDDRP7J ; 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")
;----------
;
HTR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2016",80)
W !!,"All Hypertension Patients by Race & Hispanic or Latino Identity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino identity of "
W !,"patients age 18 to 85 years old who have had at least one medical visit"
W !,"during the report period and were diagnosed with hypertension before June 30"
W !,"of the report period."
W !
Q
HTRL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTRH Q:BUDQUIT
I '$D(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR")) S X="No patients to report." W:BUDROT="P" !!,X D:BUDROT="D" S(),S(X) Q
D HTRL1
I BUDROT="P",$Y>(IOSL-3) D HTRH G:BUDQUIT HTRLX
S X="TOTAL HTN PATIENTS 18-85 YEARS OLD: "_BUDTOT
I BUDROT="P" W !!,X,!
I BUDROT="D" D S(),S(X)
HTRLX ;
Q
HTRL1 ;
I BUDROT="P",$Y>(IOSL-7) D HTRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTRL2
Q
HTRL2 ;
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,"HTR",BUDRACE,BUDETH,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D HTRH 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,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"^",1)
....;W ?5,$P(BUDALL,"^",2),!
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I BUDROT="P",$Y>(IOSL-3) D HTRH Q:BUDQUIT W !,BUDRACEL,!
.....I BUDROT="P" I $E(BUDV)="P" W ?5,BUDV,! Q
.....I BUDROT="D" I $E(BUDV)="P" S BUDPV=BUDPV_U_BUDV D S(BUDPV) Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....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 HTRH Q:BUDQUIT W !,BUDRACEL,!
I BUDROT="P" W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
Q
HTRHD ;
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 Patients 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(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDBEN)=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("and were diagnosed with hypertension before June 30 of the report period.")
D S("The list displays the patient's most recent hypertension diagnosis ")
D S("before June 30 of the report period.")
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^SEX^AGE^RACE*^HISPANIC OR LATINO IDENTITY^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
Q
HTRH ;
I BUDROT="D" D HTRHD Q
G:'BUDGPG HTRH1
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
HTRH1 ;
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 Patients 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 !,"and were diagnosed with hypertension before June 30 of the report period."
.W !,"The list displays the patient's most recent hypertension diagnosis "
.W !,"before June 30 of the report period."
.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 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
;
HTCR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2016",80)
W !!,"All Hypertension Patients w/Controlled BP by Race and Hispanic or Latino Identity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino identity"
W !,"of patients age 18 to 85 years old who have had at least one medical"
W !,"visit during the report period, were diagnosed with hypertension before"
W !,"June 30 of the report period, and who have controlled blood pressure "
W !,"(<140/90 mm HG) during the report period."
W !
Q
HTCRL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTCRH Q:BUDQUIT
I '$D(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR")) S X="No patients to report." W:BUDROT="P" !!,X D:BUDROT="D" S(),S(X) Q
D HTCRL1
I BUDROT="P",$Y>(IOSL-3) D HTCRH G:BUDQUIT HTCRLX
S X="TOTAL HTN PATIENTS 18+ W/CONTROLLED BP: "_BUDTOT
I BUDROT="P" W !!,X,!
I BUDROT="D" D S(),S(X)
HTCRLX ;
Q
HTCRL1 ;
I BUDROT="P",$Y>(IOSL-7) D HTCRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTCRL2
Q
HTCRL2 ;
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,"HTCR",BUDRACE,BUDETH,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D HTCRH 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,"HTCR",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 HTCRH 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)
.....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 HTCRH Q:BUDQUIT W !,BUDRACEL,!
I BUDROT="P" W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
Q
HTCRHD ;
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/Controlled 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(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDBEN)=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 age 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 period, ")
D S("and 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^SEX^AGE^RACE*^HISPANIC OR LATINO IDENTITY^LAST BP VALUE OR CD & DATE^LAST HTN DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
Q
HTCRH ;
I BUDROT="D" D HTCRHD Q
G:'BUDGPG HTCRH1
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
HTCRH1 ;
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/Controlled 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 age 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 period,"
.W !,"and 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 OR CD & 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
BUDDRP7J ; 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 ;
HTR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2016",80)
+4 WRITE !!,"All Hypertension Patients by Race & Hispanic or Latino Identity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino identity of "
+8 WRITE !,"patients age 18 to 85 years old who have had at least one medical visit"
+9 WRITE !,"during the report period and were diagnosed with hypertension before June 30"
+10 WRITE !,"of the report period."
+11 WRITE !
+12 QUIT
HTRL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR"))
SET X="No patients to report."
IF BUDROT="P"
WRITE !!,X
IF BUDROT="D"
DO S()
DO S(X)
QUIT
+4 DO HTRL1
+5 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
GOTO HTRLX
+6 SET X="TOTAL HTN PATIENTS 18-85 YEARS OLD: "_BUDTOT
+7 IF BUDROT="P"
WRITE !!,X,!
+8 IF BUDROT="D"
DO S()
DO S(X)
HTRLX ;
+1 QUIT
HTRL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO HTRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO HTRL2
End DoDot:1
+5 QUIT
HTRL2 ;
+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,"HTR",BUDRACE,BUDETH,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+6 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+7 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+9 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTRH
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,"HTR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN)
+20 SET BUDPPV=$PIECE(BUDALL,"^",1)
+21 ;W ?5,$P(BUDALL,"^",2),!
+22 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+23 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+24 IF BUDROT="P"
IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+25 IF BUDROT="D"
IF $EXTRACT(BUDV)="P"
SET BUDPV=BUDPV_U_BUDV
DO S(BUDPV)
QUIT
+26 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+27 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),!
+28 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
+29 IF BUDROT="P"
IF $Y>(IOSL-4)
DO HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+30 IF BUDROT="P"
WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+31 IF BUDROT="D"
DO S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
+32 QUIT
HTRHD ;
+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 Patients 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(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDBEN)=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("and were diagnosed with hypertension before June 30 of the report period.")
+12 DO S("The list displays the patient's most recent hypertension diagnosis ")
+13 DO S("before June 30 of the report period.")
+14 DO S("Age is calculated as of December 31.")
+15 DO S("* E - denotes the value was obtained from the Ethnicity field.")
+16 DO S(" R - denotes the value was obtained from the Race field")
+17 DO S(" C - denotes the value was obtained from the Classification/Beneficiary field")
+18 DO S()
+19 DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^HISPANIC OR LATINO IDENTITY^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
+20 QUIT
HTRH ;
+1 IF BUDROT="D"
DO HTRHD
QUIT
+2 IF 'BUDGPG
GOTO HTRH1
+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
HTRH1 ;
+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 Patients 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 !,"and were diagnosed with hypertension before June 30 of the report period."
+14 WRITE !,"The list displays the patient's most recent hypertension diagnosis "
+15 WRITE !,"before June 30 of the report period."
+16 WRITE !,"Age is calculated as of December 31."
+17 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
+18 WRITE !," R - denotes the value was obtained from the Race field"
+19 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
+20 WRITE !
End DoDot:1
+21 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
+22 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
+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 ;
HTCR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2016",80)
+4 WRITE !!,"All Hypertension Patients w/Controlled BP by Race and Hispanic or Latino Identity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino identity"
+8 WRITE !,"of patients age 18 to 85 years old who have had at least one medical"
+9 WRITE !,"visit during the report period, were diagnosed with hypertension before"
+10 WRITE !,"June 30 of the report period, and who have controlled blood pressure "
+11 WRITE !,"(<140/90 mm HG) during the report period."
+12 WRITE !
+13 QUIT
HTCRL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTCRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR"))
SET X="No patients to report."
IF BUDROT="P"
WRITE !!,X
IF BUDROT="D"
DO S()
DO S(X)
QUIT
+4 DO HTCRL1
+5 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTCRH
IF BUDQUIT
GOTO HTCRLX
+6 SET X="TOTAL HTN PATIENTS 18+ W/CONTROLLED BP: "_BUDTOT
+7 IF BUDROT="P"
WRITE !!,X,!
+8 IF BUDROT="D"
DO S()
DO S(X)
HTCRLX ;
+1 QUIT
HTCRL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO HTCRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO HTCRL2
End DoDot:1
+5 QUIT
HTCRL2 ;
+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,"HTCR",BUDRACE,BUDETH,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+6 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+7 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDDRP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+9 IF BUDROT="P"
IF $Y>(IOSL-3)
DO HTCRH
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,"HTCR",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 HTCRH
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)
+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 HTCRH
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
HTCRHD ;
+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/Controlled 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(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDBEN)=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 age 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 period, ")
+12 DO S("and 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^SEX^AGE^RACE*^HISPANIC OR LATINO IDENTITY^LAST BP VALUE OR CD & DATE^LAST HTN DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
+19 QUIT
HTCRH ;
+1 IF BUDROT="D"
DO HTCRHD
QUIT
+2 IF 'BUDGPG
GOTO HTCRH1
+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
HTCRH1 ;
+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/Controlled 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 age 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 period,"
+14 WRITE !,"and 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 OR CD & 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
