BUDHRPL4 ;IHS/CMI/LAB - UDS TAB 1-6A;
;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
;
;
;
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")
;----------
RACEL(R,E) ;EP
I R=1,E=1 Q "Line 1: Asian, Hispanic"
I R=1,E=2 Q "Line 1: Asian, Non-Hispanic"
I R=2,E=1 Q "Line 2a: Native Hawaiian, Hispanic"
I R=2,E=2 Q "Line 2a: Native Hawaiian, Non-Hispanic"
I R=3,E=1 Q "Line 2b: Other Pacific Islander, Hispanic"
I R=3,E=2 Q "Line 2b: Other Pacific Islander, Non-Hispanic"
I R=4,E=1 Q "Line 3: Black/African American, Hispanic"
I R=4,E=2 Q "Line 3: Black/African American, Non-Hispanic"
I R=5,E=1 Q "Line 4: American Indian/Alaska Native, Hispanic"
I R=5,E=2 Q "Line 4: American Indian/Alaska Native, Non-Hispanic"
I R=6,E=1 Q "Line 5: White, Hispanic"
I R=6,E=2 Q "Line 5: White, Non-Hispanic"
I R=7,E=1 Q "Line 6: More than one race, Hispanic"
I R=7,E=2 Q "Line 6: More than one race, Non-Hispanic"
I R=8,E=1 Q "Line 7: Unreported / Refused to Report, Hispanic"
I R=8,E=2 Q "Line 7: Unreported / Refused to Report, Non-Hispanic"
I R=8,E=3 Q "Line 7: Unreported / Refused to Report, Unreported / Refused to Report"
Q "UNKNOWN"
;
RACE(R) ;EP
I R="UNREP/REF" Q "7-Line 7: Unreported"
I R="ASIAN" Q "3-Line 1: Asian"
I R="NATIVE HAWAIIAN" Q "1-Line 2a: Native Hawaiian"
I R="OTH PAC ISLANDER" Q "2-Line 2b: Other Pacific Islander"
I R="BLACK" Q "4-Line 3: Black/African American"
I R="AI/AN" Q "5-Line 4: American Indian/Alaska Native"
I R="WHITE" Q "6-Line 5: White"
I R="HISPANIC,WHITE" Q "6-Line 5: White"
I R="HISPANIC,BLACK" Q "5-Line 3: Black/African American"
Q ""
T3BR ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D T3BRH Q:BUDQUIT
I '$D(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR")) D
.I BUDROT="P" W !!,"No patients to report." Q
.D S(""),S("No patients to report.")
D T3BRL1
I BUDROT="P",$Y>(IOSL-3) D T3BRH G:BUDQUIT T3BRLX
I BUDROT="P" W !!,"TOTAL PATIENTS: ",BUDTOT,!
I BUDROT="D" D S("TOTAL PATIENTS: "_BUDTOT),S("")
T3BRLX ;
Q
T3BRL1 ;
I BUDROT="P",$Y>(IOSL-7) D T3BRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDHTH="" F S BUDHTH=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH)) Q:BUDHTH=""!(BUDQUIT) D T3BRL2
Q
T3BRL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL(BUDRACE,BUDHTH)
I BUDROT="P" W !,BUDRACEL
I BUDROT="D" D S(""),S(BUDRACEL)
S BUDA="" F S BUDA=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA)) Q:BUDA=""!(BUDQUIT) D
.S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D T3BRH Q:BUDQUIT W !,BUDRACEL,!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,22),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)) D
.....W ?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
....S BUDRACV=$$RACE^BUDHRPTC(DFN)
....I BUDROT="P" W !?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDHRPTC(DFN),U,3)_"-"_$P($$RACE^BUDHRPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDHRPTC(DFN)
....I BUDROT="P" W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")"
....S BUDV=0,BUDD=0 F S BUDV=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) D
.....S BUDD=BUDD+1
.....S BUDI=^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN,BUDV),BUDI=$P(BUDI,"|||",3)
.....I BUDROT="P",$Y>(IOSL-3) D T3BRH Q:BUDQUIT I BUDROT="P" W !,BUDRACEL,!
.....I BUDROT="P",BUDD=1 W ?60,$S(BUDI:"YES",1:"NO")
.....I BUDROT="P" W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?62,$E($$LOCENC^APCLV(BUDV,"E"),1,14)
.....I BUDROT="D" D
......S X=$P(^DPT(DFN,0),U,1)_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_$$AGE^AUPNPAT(DFN,BUDCCAD)
......S X=X_U_$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3)_")"_U_$P(BUDHISV,U,3)_" ("_$P(BUDHISV,U,2)_")"_U_$S(BUDI:"YES",1:"NO")
......S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
......D S(X)
I BUDROT="P",$Y>(IOSL-4) D T3BRH Q:BUDQUIT
I BUDROT="P" W !!,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total "_BUDRACEL_": "_BUDSTOT),S("")
Q
T3BRH ;
I BUDROT="D" D T3BRHD Q
G:'BUDGPG T3BRH1
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
T3BRH1 ;
W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
W !,$$CTR("***** SENSITIVE INFORMATION *****",IOM)
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?55,"Section "_BUDSCTC_" of "_BUDTSCTC_", Page "_BUDGPG,!
W !,$$CTR("*** RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_" ***",80)
W !,$$CTR("Patient List for Table 3B, Patients by Hispanic or Latino Identity and Race",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),!
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)",BUDBEN=4:"Homeless",1:"")
W $$CTR(X,80),!
W $TR($J("",80)," ","-")
I BUDP=0 D
.W !,"List of all patients with one or more visits during the calendar year, with"
.W !,"gender, age, Hispanic or Latino Identity, race, and visit information."
.W !,"Age on the patient list is calculated as of June 30."
.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 !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
W !,?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*",?60,"INTERPRETER"
W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"SRV",?45,"CLINIC",?62,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
T3BRHD ;
D S(),S(),S()
D S("***** SENSITIVE INFORMATION *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_" ***")
D S("Patient List for Table 3B, Patients by Hispanic or Latino Identity and Race")
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)",BUDBEN=4:"Homeless",1:"") D S(X)
D S(" ")
D S("List of all patients with one or more visits during the calendar year, with")
D S("gender, age, Hispanic or Latino Identity, race, and visit information.")
D S("Age on the patient list is calculated as of June 30.")
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(" "),S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^HISPANIC OR LATINO ETHNICITY^INTERPRETER^VISIT DATE^PROV TYPE^SRV^CLINIC^LOCATION")
Q
S(V) ;
S BUDDECNT=BUDDECNT+1
S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
Q
BUDHRPL4 ;IHS/CMI/LAB - UDS TAB 1-6A;
+1 ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
+2 ;
+3 ;
+4 ;
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 ;----------
RACEL(R,E) ;EP
+1 IF R=1
IF E=1
QUIT "Line 1: Asian, Hispanic"
+2 IF R=1
IF E=2
QUIT "Line 1: Asian, Non-Hispanic"
+3 IF R=2
IF E=1
QUIT "Line 2a: Native Hawaiian, Hispanic"
+4 IF R=2
IF E=2
QUIT "Line 2a: Native Hawaiian, Non-Hispanic"
+5 IF R=3
IF E=1
QUIT "Line 2b: Other Pacific Islander, Hispanic"
+6 IF R=3
IF E=2
QUIT "Line 2b: Other Pacific Islander, Non-Hispanic"
+7 IF R=4
IF E=1
QUIT "Line 3: Black/African American, Hispanic"
+8 IF R=4
IF E=2
QUIT "Line 3: Black/African American, Non-Hispanic"
+9 IF R=5
IF E=1
QUIT "Line 4: American Indian/Alaska Native, Hispanic"
+10 IF R=5
IF E=2
QUIT "Line 4: American Indian/Alaska Native, Non-Hispanic"
+11 IF R=6
IF E=1
QUIT "Line 5: White, Hispanic"
+12 IF R=6
IF E=2
QUIT "Line 5: White, Non-Hispanic"
+13 IF R=7
IF E=1
QUIT "Line 6: More than one race, Hispanic"
+14 IF R=7
IF E=2
QUIT "Line 6: More than one race, Non-Hispanic"
+15 IF R=8
IF E=1
QUIT "Line 7: Unreported / Refused to Report, Hispanic"
+16 IF R=8
IF E=2
QUIT "Line 7: Unreported / Refused to Report, Non-Hispanic"
+17 IF R=8
IF E=3
QUIT "Line 7: Unreported / Refused to Report, Unreported / Refused to Report"
+18 QUIT "UNKNOWN"
+19 ;
RACE(R) ;EP
+1 IF R="UNREP/REF"
QUIT "7-Line 7: Unreported"
+2 IF R="ASIAN"
QUIT "3-Line 1: Asian"
+3 IF R="NATIVE HAWAIIAN"
QUIT "1-Line 2a: Native Hawaiian"
+4 IF R="OTH PAC ISLANDER"
QUIT "2-Line 2b: Other Pacific Islander"
+5 IF R="BLACK"
QUIT "4-Line 3: Black/African American"
+6 IF R="AI/AN"
QUIT "5-Line 4: American Indian/Alaska Native"
+7 IF R="WHITE"
QUIT "6-Line 5: White"
+8 IF R="HISPANIC,WHITE"
QUIT "6-Line 5: White"
+9 IF R="HISPANIC,BLACK"
QUIT "5-Line 3: Black/African American"
+10 QUIT ""
T3BR ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO T3BRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR"))
Begin DoDot:1
+4 IF BUDROT="P"
WRITE !!,"No patients to report."
QUIT
+5 DO S("")
DO S("No patients to report.")
End DoDot:1
+6 DO T3BRL1
+7 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T3BRH
IF BUDQUIT
GOTO T3BRLX
+8 IF BUDROT="P"
WRITE !!,"TOTAL PATIENTS: ",BUDTOT,!
+9 IF BUDROT="D"
DO S("TOTAL PATIENTS: "_BUDTOT)
DO S("")
T3BRLX ;
+1 QUIT
T3BRL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO T3BRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDHTH=""
FOR
SET BUDHTH=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH))
IF BUDHTH=""!(BUDQUIT)
QUIT
DO T3BRL2
End DoDot:1
+5 QUIT
T3BRL2 ;
+1 SET BUDSTOT=0
+2 SET BUDRACEL=$$RACEL(BUDRACE,BUDHTH)
+3 IF BUDROT="P"
WRITE !,BUDRACEL
+4 IF BUDROT="D"
DO S("")
DO S(BUDRACEL)
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:1
+6 SET BUDSEX=""
FOR
SET BUDSEX=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX))
IF BUDSEX=""!(BUDQUIT)
QUIT
Begin DoDot:2
+7 SET BUDCCOM=""
FOR
SET BUDCCOM=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+9 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T3BRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 IF BUDROT="P"
WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,22),?24,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))
Begin DoDot:5
+12 WRITE ?36,$EXTRACT(BUDCCOM,1,12),?51,$PIECE(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
End DoDot:5
+13 SET BUDRACV=$$RACE^BUDHRPTC(DFN)
+14 ;,?60,$E($P($$RACE^BUDHRPTC(DFN),U,3)_"-"_$P($$RACE^BUDHRPTC(DFN),U,4),1,19)
IF BUDROT="P"
WRITE !?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+15 SET BUDHISV=$$HISP^BUDHRPTC(DFN)
+16 IF BUDROT="P"
WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")"
+17 SET BUDV=0
SET BUDD=0
FOR
SET BUDV=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN,BUDV))
IF BUDV'=+BUDV!(BUDQUIT)
QUIT
Begin DoDot:5
+18 SET BUDD=BUDD+1
+19 SET BUDI=^XTMP("BUDHRPT1",BUDJ,BUDH,"3BR",BUDRACE,BUDHTH,BUDA,BUDSEX,BUDCCOM,DFN,BUDV)
SET BUDI=$PIECE(BUDI,"|||",3)
+20 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T3BRH
IF BUDQUIT
QUIT
IF BUDROT="P"
WRITE !,BUDRACEL,!
+21 IF BUDROT="P"
IF BUDD=1
WRITE ?60,$SELECT(BUDI:"YES",1:"NO")
+22 IF BUDROT="P"
WRITE !?5,$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(BUDV,0),U),".")),?25,$EXTRACT($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$PIECE(^AUPNVSIT(BUDV,0),U,7),?45,$EXTRACT($$CLINIC^APCLV(BUDV,"E"),1,14),?62,$EXTRACT
($$LOCENC^APCLV(BUDV,"E"),1,14)
+23 IF BUDROT="D"
Begin DoDot:6
+24 SET X=$PIECE(^DPT(DFN,0),U,1)_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_$$AGE^AUPNPAT
(DFN,BUDCCAD)
+25 SET X=X_U_$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3)_")"_U_$PIECE(BUDHISV,U,3)_" ("_$PIECE(BUDHISV,U,2)_")"_U_$SELECT(BUDI:"YES",1:"NO")
+26 SET X=X_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$PIECE(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
+27 DO S(X)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF BUDROT="P"
IF $Y>(IOSL-4)
DO T3BRH
IF BUDQUIT
QUIT
+29 IF BUDROT="P"
WRITE !!,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+30 IF BUDROT="D"
DO S("Sub-Total "_BUDRACEL_": "_BUDSTOT)
DO S("")
+31 QUIT
T3BRH ;
+1 IF BUDROT="D"
DO T3BRHD
QUIT
+2 IF 'BUDGPG
GOTO T3BRH1
+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
T3BRH1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BUDGPG=BUDGPG+1
+2 WRITE !,$$CTR("***** SENSITIVE INFORMATION *****",IOM)
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?55,"Section "_BUDSCTC_" of "_BUDTSCTC_", Page "_BUDGPG,!
+4 WRITE !,$$CTR("*** RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_" ***",80)
+5 WRITE !,$$CTR("Patient List for Table 3B, Patients by Hispanic or Latino Identity and Race",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 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)",BUDBEN=4:"Homeless",1:"")
+9 WRITE $$CTR(X,80),!
+10 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+11 IF BUDP=0
Begin DoDot:1
+12 WRITE !,"List of all patients with one or more visits during the calendar year, with"
+13 WRITE !,"gender, age, Hispanic or Latino Identity, race, and visit information."
+14 WRITE !,"Age on the patient list is calculated as of June 30."
+15 WRITE !,"* (E) - denotes the value was obtained from the Ethnicity field"
+16 WRITE !," (R) - denotes the value was obtained from the Race field"
+17 WRITE !," (C) - denotes the value was obtained from the Classification/Beneficiary field"
+18 WRITE !
End DoDot:1
+19 WRITE !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
+20 WRITE !,?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*",?60,"INTERPRETER"
+21 WRITE !?5,"VISIT DATE",?25,"PROV TYPE",?41,"SRV",?45,"CLINIC",?62,"LOCATION"
+22 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+23 SET BUDP=1
+24 QUIT
T3BRHD ;
+1 DO S()
DO S()
DO S()
+2 DO S("***** SENSITIVE INFORMATION *****")
+3 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+4 DO S("*** RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_" ***")
+5 DO S("Patient List for Table 3B, Patients by Hispanic or Latino Identity and Race")
+6 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+8 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)",BUDBEN=4:"Homeless",1:"")
DO S(X)
+9 DO S(" ")
+10 DO S("List of all patients with one or more visits during the calendar year, with")
+11 DO S("gender, age, Hispanic or Latino Identity, race, and visit information.")
+12 DO S("Age on the patient list is calculated as of June 30.")
+13 DO S("* (E) - denotes the value was obtained from the Ethnicity field")
+14 DO S(" (R) - denotes the value was obtained from the Race field")
+15 DO S(" (C) - denotes the value was obtained from the Classification/Beneficiary field")
+16 DO S(" ")
DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^HISPANIC OR LATINO ETHNICITY^INTERPRETER^VISIT DATE^PROV TYPE^SRV^CLINIC^LOCATION")
+17 QUIT
S(V) ;
+1 SET BUDDECNT=BUDDECNT+1
+2 SET ^TMP($JOB,"BUDDEL",BUDDECNT)=$GET(V)
+3 QUIT
