- BUDERP7U ;IHS/CMI/LAB - UDS REPORT T7 PROCESS;
- ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
- ;
- ;
- 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^BUDERP7I
- 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("BUDERP7",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("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
- .S BUDETH="" F S BUDETH=$O(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D HTURL2
- Q
- HTURL2 ;
- S BUDSTOT=0
- S BUDRACEL=$$RACEL^BUDERP7I(BUDRACE,BUDETH)
- I BUDROT="P" W !,BUDRACEL
- I BUDROT="D" D S(BUDRACEL)
- S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
- .S BUDA="" F S BUDA=$O(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
- ..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
- ...S DFN=0 F S DFN=$O(^XTMP("BUDERP7",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^BUDERPTC(DFN)
- ....I BUDROT="P" W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDERPTC(DFN),U,3)_"-"_$P($$RACE^BUDERPTC(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^BUDERPTC(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("BUDERP7",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
- ;
- BUDERP7U ;IHS/CMI/LAB - UDS REPORT T7 PROCESS;
- +1 ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
- +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^BUDERP7I
- +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("BUDERP7",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("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE))
- IF BUDRACE=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +4 SET BUDETH=""
- FOR
- SET BUDETH=$ORDER(^XTMP("BUDERP7",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^BUDERP7I(BUDRACE,BUDETH)
- +3 IF BUDROT="P"
- WRITE !,BUDRACEL
- +4 IF BUDROT="D"
- DO S(BUDRACEL)
- +5 SET BUDCCOM=""
- FOR
- SET BUDCCOM=$ORDER(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM))
- IF BUDCCOM=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +6 SET BUDA=""
- FOR
- SET BUDA=$ORDER(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA))
- IF BUDA=""!(BUDQUIT)
- QUIT
- Begin DoDot:2
- +7 SET BUDNAME=""
- FOR
- SET BUDNAME=$ORDER(^XTMP("BUDERP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDETH,BUDCCOM,BUDA,BUDNAME))
- IF BUDNAME=""!(BUDQUIT)
- QUIT
- Begin DoDot:3
- +8 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BUDERP7",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^BUDERPTC(DFN)
- +14 ;,?60,$E($P($$RACE^BUDERPTC(DFN),U,3)_"-"_$P($$RACE^BUDERPTC(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^BUDERPTC(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("BUDERP7",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 ;
