BUDARP7J ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;general introductions
D GENI^BUDARP7I
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 2013",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 two medical visits during"
W !,"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("BUDARP7",BUDJ,BUDH,"HTR")) W !!,"No patients to report." Q
D HTRL1
I $Y>(IOSL-3) D HTRH G:BUDQUIT HTRLX
W !!,"TOTAL HTN PATIENTS 18-85 YEARS OLD: ",BUDTOT,!
HTRLX ;
Q
HTRL1 ;
I $Y>(IOSL-7) D HTRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTRL2
Q
HTRL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
W !,BUDRACEL
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HTRH Q:BUDQUIT W !,BUDRACEL,!
....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(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDARPTC(DFN)
....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDARPTC(DFN)
....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....S BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"#",1)
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I $Y>(IOSL-3) D HTRH Q:BUDQUIT W !,BUDRACEL,!
.....I $E(BUDV)="P" W ?5,BUDV,! Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....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 $Y>(IOSL-4) D HTRH Q:BUDQUIT W !,BUDRACEL,!
W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
Q
HTRH ;
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 two medical visits during the report period and"
.W !,"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 2013",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 two medical visits"
W !,"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("BUDARP7",BUDJ,BUDH,"HTCR")) W !!,"No patients to report." Q
D HTCRL1
I $Y>(IOSL-3) D HTCRH G:BUDQUIT HTCRLX
W !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP: ",BUDTOT,!
HTCRLX ;
Q
HTCRL1 ;
I $Y>(IOSL-7) D HTCRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTCRL2
Q
HTCRL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
W !,BUDRACEL
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HTCRH Q:BUDQUIT W !,BUDRACEL,!
....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(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDARPTC(DFN)
....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDARPTC(DFN)
....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....S BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,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 $Y>(IOSL-3) D HTCRH Q:BUDQUIT W !,BUDRACEL,!
.....I $E(BUDV)="P" W ?5,BUDV,! Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....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 $Y>(IOSL-4) D HTCRH Q:BUDQUIT W !,BUDRACEL,!
W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
Q
HTCRH ;
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 two medical visits during the report period, who were "
.W !,"diagnosed with hypertension before June 30 of the report period, and have "
.W !,"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
;
HTUR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2013",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 two medical visits during"
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("BUDARP7",BUDJ,BUDH,"HTUR")) W !!,"No patients to report." Q
D HTURL1
I $Y>(IOSL-4) D HTURH G:BUDQUIT HTURLX
W !!,"TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC",!,"OR LATINO IDENTITY: ",BUDTOT,!
HTURLX ;
Q
HTURL1 ;
I $Y>(IOSL-7) D HTURH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTURL2
Q
HTURL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
W !,BUDRACEL
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HTURH Q:BUDQUIT W !,BUDRACEL,!
....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(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,! ;
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDARPTC(DFN)
....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDARPTC(DFN)
....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....S BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,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 $Y>(IOSL-3) D HTURH Q:BUDQUIT W !,BUDRACEL,!
.....I $E(BUDV)="P" W ?5,BUDV,! Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2),C=$P(C,"^",1)
.....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 $Y>(IOSL-4) D HTURH Q:BUDQUIT W !,BUDRACEL,!
W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
Q
HTURH ;
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 two medical visits 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
;
BUDARP7J ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
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^BUDARP7I
+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 2013",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 two medical visits during"
+9 WRITE !,"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("BUDARP7",BUDJ,BUDH,"HTR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTRL1
+5 IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
GOTO HTRLX
+6 WRITE !!,"TOTAL HTN PATIENTS 18-85 YEARS OLD: ",BUDTOT,!
HTRLX ;
+1 QUIT
HTRL1 ;
+1 IF $Y>(IOSL-7)
DO HTRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDARP7",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^BUDARP7I(BUDRACE,BUDETH)
+3 WRITE !,BUDRACEL
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+9 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(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUD
A,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDRACV=$$RACE^BUDARPTC(DFN)
+12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
+14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+15 SET BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+16 SET BUDPPV=$PIECE(BUDALL,"#",1)
+17 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+18 IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+19 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+20 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+21 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),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF $Y>(IOSL-4)
DO HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+23 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+24 QUIT
HTRH ;
+1 IF 'BUDGPG
GOTO HTRH1
+2 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 two medical visits during the report period and"
+13 WRITE !,"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 2013",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 two medical visits"
+9 WRITE !,"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("BUDARP7",BUDJ,BUDH,"HTCR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTCRL1
+5 IF $Y>(IOSL-3)
DO HTCRH
IF BUDQUIT
GOTO HTCRLX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP: ",BUDTOT,!
HTCRLX ;
+1 QUIT
HTCRL1 ;
+1 IF $Y>(IOSL-7)
DO HTCRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDARP7",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^BUDARP7I(BUDRACE,BUDETH)
+3 WRITE !,BUDRACEL
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF $Y>(IOSL-3)
DO HTCRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+9 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(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUD
A,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDRACV=$$RACE^BUDARPTC(DFN)
+12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
+14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+15 SET BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+16 SET BUDPPV=$PIECE(BUDALL,"^",1)
+17 WRITE ?5,$PIECE(BUDALL,"^",2),!
+18 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+19 IF $Y>(IOSL-3)
DO HTCRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+20 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+21 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+22 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),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $Y>(IOSL-4)
DO HTCRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+25 QUIT
HTCRH ;
+1 IF 'BUDGPG
GOTO HTCRH1
+2 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 two medical visits during the report period, who were "
+13 WRITE !,"diagnosed with hypertension before June 30 of the report period, and have "
+14 WRITE !,"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
+27 ;
HTUR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2013",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 two medical visits during"
+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("BUDARP7",BUDJ,BUDH,"HTUR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTURL1
+5 IF $Y>(IOSL-4)
DO HTURH
IF BUDQUIT
GOTO HTURLX
+6 WRITE !!,"TOTAL HYPERTENSION PATIENTS 18-85 W/UNCONTROLLED BP BY RACE AND HISPANIC",!,"OR LATINO IDENTITY: ",BUDTOT,!
HTURLX ;
+1 QUIT
HTURL1 ;
+1 IF $Y>(IOSL-7)
DO HTURH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDARP7",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^BUDARP7I(BUDRACE,BUDETH)
+3 WRITE !,BUDRACEL
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF $Y>(IOSL-3)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+9 ;
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(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUD
A,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDRACV=$$RACE^BUDARPTC(DFN)
+12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
+14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+15 SET BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+16 SET BUDPPV=$PIECE(BUDALL,"#",1)
+17 WRITE ?5,$PIECE(BUDALL,"#",2),!
+18 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+19 IF $Y>(IOSL-3)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+20 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+21 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
SET C=$PIECE(C,"^",1)
+22 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),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $Y>(IOSL-4)
DO HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+25 QUIT
HTURH ;
+1 IF 'BUDGPG
GOTO HTURH1
+2 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 two medical visits 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 ;
