BUDHRPL5 ;IHS/CMI/LAB - UDS REPORT 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
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
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
T4IPPL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D T4IPPH Q:BUDQUIT
I '$D(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL")) D Q
.I BUDROT="P" W !!,"No patients to report." Q
.I BUDROT="D" D S(""),S(""),S("No patients to report.")
D T4IPPL1
I BUDROT="P",$Y>(IOSL-3) D T4IPPH G:BUDQUIT T4IPPLX
D
.I BUDROT="P" W !!,"TOTAL PATIENTS: ",BUDTOT,! Q
.I BUDROT="D" D S(""),S("TOTAL PATIENTS: "_BUDTOT),S("")
T4IPPLX ;
Q
T4IPPL1 ;
I BUDROT="P",$Y>(IOSL-7) D T4IPPH Q:BUDQUIT
S BUDTOT=0
S BUDINCI="" F S BUDINCI=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI)) Q:BUDINCI=""!(BUDQUIT) D
.S BUDINC="" F S BUDINC=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC)) Q:BUDINC=""!(BUDQUIT) D T4IPPL2
Q
T4IPPL2 ;
S BUDSTOT=0
I BUDROT="P" W !,"Income as Percent of Poverty Level: ",BUDINC,!
I BUDROT="D" D S("Income as Percent of Poverty Level: "_BUDINC)
S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
.S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
..S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX,BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX,BUDAGE,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D T4IPPH Q:BUDQUIT W !,"Income as Percent of Poverty Level: ",BUDINC,!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....I BUDROT="P" D
.....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))
.....W ?36,$E(BUDCCOM,1,13),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
.....W !?5,BUDINC
....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_BUDINC
.....D S(X)
I BUDROT="P",$Y>(IOSL-4) D T4IPPH Q:BUDQUIT
I BUDROT="P" W !!,"Sub-Total Line ",BUDINCI," ",BUDINC,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total Line "_BUDINCI_" "_BUDINC_": "_BUDSTOT),S("")
Q
T4IPPDH ;
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 4, Income As Percent of Poverty Level")
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("This report provides a list of all patients with an income percent")
D S("of poverty level (=<100%, 101-150%, 151-200%, >200%, Unknown) during")
D S("the report period.")
D S("Age on the patient list is calculated as of June 30.")
D S(" "),S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^INCOME PERCENT OF POVERTY LEVEL")
Q
S(V) ;
S BUDDECNT=BUDDECNT+1
S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
Q
T4IPPH ;
I BUDROT="D" D T4IPPDH Q
G:'BUDGPG T4IPPH1
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
T4IPPH1 ;
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 4, Income As Percent of Poverty Level",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 !,"This report provides a list of all patients with an income percent"
.W !,"of poverty level (=<100%, 101-150%, 151-200%, >200%, Unknown) during"
.W !,"the report period."
.W !,"Age on the patient list is calculated as of June 30."
.W !
W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
W !,?5,"INCOME PERCENT OF POVERTY LEVEL"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;----------
T4PMIS ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D T4PMIH Q:BUDQUIT
I '$D(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS")) D Q
.I BUDROT="P" W !!,"No patients to report." Q
.I BUDROT="D" D S(""),S(""),S("No patients to report.")
D T4PMIS1
I BUDROT="P",$Y>(IOSL-3) D T4PMIH G:BUDQUIT T4PMISX
D
.I BUDROT="P" W !!,"TOTAL PATIENTS: ",BUDTOT,! Q
.I BUDROT="D" D S(""),S("TOTAL PATIENTS: "_BUDTOT),S("")
T4PMISX ;
Q
T4PMIS1 ;
I BUDROT="P",$Y>(IOSL-7) D T4PMIH Q:BUDQUIT
S BUDTOT=0
S BUDINCI="" F S BUDINCI=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI)) Q:BUDINCI=""!(BUDQUIT) D
.S BUDINC="" F S BUDINC=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC)) Q:BUDINC=""!(BUDQUIT) D T4PMIS2
Q
T4PMIS2 ;
S BUDSTOT=0
I BUDROT="P" W !,"Principal Third-Party Medical Insurance Source: ",BUDINC,!
I BUDROT="D" D S("Principal Third-Party Medical Insurance Source: "_BUDINC),S("")
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
..S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D T4PMIH Q:BUDQUIT W !,"Principal Third-Party Medical Insurance Source: ",BUDINC,!
....S:BUDINCI'=8.9 BUDTOT=BUDTOT+1 S BUDSTOT=BUDSTOT+1
....I BUDROT="P" D
.....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))
.....W ?36,$E(BUDCCOM,1,13),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
.....W !?5,$S(BUDINCI=8.9:"Medicare/Medicaid",1:BUDINC)
....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_$S(BUDINCI=8.9:"Medicare/Medicaid",1:BUDINC)
.....D S(X)
I BUDROT="P",$Y>(IOSL-4) D T4PMIH Q:BUDQUIT
I BUDROT="P" W !!,"Sub-Total Line ",$S(BUDINCI=8.9:"9a",BUDINCI=8.1:"8a",BUDINCI=8.2:"8b",BUDINCI=10.1:"10a",BUDINCI=10.2:"10b",1:BUDINCI)," ",BUDINC,": ",BUDSTOT,!
I BUDROT="D" D S("Sub-Total Line "_$S(BUDINCI=8.9:"9a",BUDINCI=8.1:"8a",BUDINCI=8.2:"8b",BUDINCI=10.1:"10a",BUDINCI=10.2:"10b",1:BUDINCI)_" "_BUDINC_": "_BUDSTOT),S("")
Q
T4PMIDH ;
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 4, Principal Third-Party Medical Insurance Source")
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("This report provides a list of all patients and the type of medical insurance")
D S("the patient has during the report period, if any.")
D S("Age on the patient list is calculated as of June 30.")
D S(" "),S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^PRINCIPAL THIRD-PARTY MEDICAL INSURANCE SOURCE")
Q
T4PMIH ;
I BUDROT="D" D T4PMIDH Q
G:'BUDGPG T4PMIH1
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
T4PMIH1 ;
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 4",80)
W !,$$CTR("Principal Third-Party Medical Insurance Source",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 !,"This report provides a list of all patients and the type of medical insurance"
.W !,"the patient has during the report period, if any."
.W !,"Age on the patient list is calculated as of June 30."
.W !
W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
W !,?5,"PRINCIPAL THIRD-PARTY MEDICAL INSURANCE SOURCE"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;----------
T4CHAR ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D T4CHAH Q:BUDQUIT
I '$D(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR")) D Q
.I BUDROT="P" W !!,"No patients to report." Q
.I BUDROT="D" D S(""),S("No patients to report.")
D T4CHAR1
I BUDROT="P",$Y>(IOSL-3) D T4CHAH G:BUDQUIT T4CHARX
D
.I BUDROT="P" W !!,"TOTAL PATIENTS: ",BUDTOT,! Q
.I BUDROT="D" D S(""),S("TOTAL PATIENTS: "_BUDTOT),S("")
T4CHARX ;
Q
T4CHAR1 ;
I BUDROT="P",$Y>(IOSL-7) D T4CHAH Q:BUDQUIT
S BUDTOT=0
S BUDINCI="" F S BUDINCI=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI)) Q:BUDINCI=""!(BUDQUIT) D
.S BUDINC="" F S BUDINC=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC)) Q:BUDINC=""!(BUDQUIT) D T4CHAR2
Q
T4CHAR2 ;
S BUDSTOT=0
I BUDROT="P" W !,"Special Characteristics: ",BUDINC,!
I BUDROT="D" D S("Special Characteristics: "_BUDINC)
S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
.S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
..S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D T4CHAH Q:BUDQUIT W !,"Special Characteristics: ",BUDINC,!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....I BUDROT="P" D
.....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))
.....W ?36,$E(BUDCCOM,1,13),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
.....W !?5,BUDINC
....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_BUDINC
.....D S(X)
I BUDROT="P",$Y>(IOSL-4) D T4CHAH Q:BUDQUIT
I BUDROT="P" W !!,"Sub-Total Line ",BUDINCI," ",BUDINC,": ",BUDSTOT,!
I BUDROT="D" D S(""),S("Sub-Total Line "_BUDINCI_" "_BUDINC_": "_BUDSTOT)
Q
T4CHAH ;
I BUDROT="D" D T4CHADH Q
G:'BUDGPG T4CHAH1
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
T4CHAH1 ;
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 4")
W !,$$CTR("Characteristics - Special Characteristics",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 !,"This report provides a list of all patients who are migrant workers,"
.W !,"seasonal workers, homeless, school based health center patients, or a"
.W !,"veteran during the report period."
.W !,"Note: Because RPMS does not record Public Housing Patients, those"
.W !,"patients are not included in this report."
.W !,"Age on the patient list is calculated as of June 30."
.W !
W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
W !,?5,"SPECIAL CHARACTERISTIC"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
T4CHADH ;
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 4, Characteristics - Special Characteristics")
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("This report provides a list of all patients who are migrant workers,")
D S("seasonal workers, homeless, school based health center patients, or a")
D S("veteran during the report period.")
D S("Note: Because RPMS does not record Public Housing Patients, those")
D S("patients are not included in this report.")
D S("Age on the patient list is calculated as of June 30.")
D S(" "),S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^SPECIAL CHARACTERISTIC")
Q
BUDHRPL5 ;IHS/CMI/LAB - UDS REPORT 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
+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
+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 ;----------
T4IPPL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO T4IPPH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL"))
Begin DoDot:1
+4 IF BUDROT="P"
WRITE !!,"No patients to report."
QUIT
+5 IF BUDROT="D"
DO S("")
DO S("")
DO S("No patients to report.")
End DoDot:1
QUIT
+6 DO T4IPPL1
+7 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4IPPH
IF BUDQUIT
GOTO T4IPPLX
+8 Begin DoDot:1
+9 IF BUDROT="P"
WRITE !!,"TOTAL PATIENTS: ",BUDTOT,!
QUIT
+10 IF BUDROT="D"
DO S("")
DO S("TOTAL PATIENTS: "_BUDTOT)
DO S("")
End DoDot:1
T4IPPLX ;
+1 QUIT
T4IPPL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO T4IPPH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDINCI=""
FOR
SET BUDINCI=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI))
IF BUDINCI=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDINC=""
FOR
SET BUDINC=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC))
IF BUDINC=""!(BUDQUIT)
QUIT
DO T4IPPL2
End DoDot:1
+5 QUIT
T4IPPL2 ;
+1 SET BUDSTOT=0
+2 IF BUDROT="P"
WRITE !,"Income as Percent of Poverty Level: ",BUDINC,!
+3 IF BUDROT="D"
DO S("Income as Percent of Poverty Level: "_BUDINC)
+4 SET BUDCCOM=""
FOR
SET BUDCCOM=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDSEX=""
FOR
SET BUDSEX=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX))
IF BUDSEX=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX,BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4IPPL",BUDINCI,BUDINC,BUDCCOM,BUDSEX,BUDAGE,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4IPPH
IF BUDQUIT
QUIT
WRITE !,"Income as Percent of Poverty Level: ",BUDINC,!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 IF BUDROT="P"
Begin DoDot:5
+11 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))
+12 WRITE ?36,$EXTRACT(BUDCCOM,1,13),?51,$PIECE(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
+13 WRITE !?5,BUDINC
End DoDot:5
+14 IF BUDROT="D"
Begin DoDot:5
+15 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,BUD
CCAD)
+16 SET X=X_U_BUDINC
+17 DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF BUDROT="P"
IF $Y>(IOSL-4)
DO T4IPPH
IF BUDQUIT
QUIT
+19 IF BUDROT="P"
WRITE !!,"Sub-Total Line ",BUDINCI," ",BUDINC,": ",BUDSTOT,!
+20 IF BUDROT="D"
DO S("Sub-Total Line "_BUDINCI_" "_BUDINC_": "_BUDSTOT)
DO S("")
+21 QUIT
T4IPPDH ;
+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 4, Income As Percent of Poverty Level")
+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("This report provides a list of all patients with an income percent")
+11 DO S("of poverty level (=<100%, 101-150%, 151-200%, >200%, Unknown) during")
+12 DO S("the report period.")
+13 DO S("Age on the patient list is calculated as of June 30.")
+14 DO S(" ")
DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^INCOME PERCENT OF POVERTY LEVEL")
+15 QUIT
S(V) ;
+1 SET BUDDECNT=BUDDECNT+1
+2 SET ^TMP($JOB,"BUDDEL",BUDDECNT)=$GET(V)
+3 QUIT
T4IPPH ;
+1 IF BUDROT="D"
DO T4IPPDH
QUIT
+2 IF 'BUDGPG
GOTO T4IPPH1
+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
T4IPPH1 ;
+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 4, Income As Percent of Poverty Level",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 !,"This report provides a list of all patients with an income percent"
+13 WRITE !,"of poverty level (=<100%, 101-150%, 151-200%, >200%, Unknown) during"
+14 WRITE !,"the report period."
+15 WRITE !,"Age on the patient list is calculated as of June 30."
+16 WRITE !
End DoDot:1
+17 WRITE !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
+18 WRITE !,?5,"INCOME PERCENT OF POVERTY LEVEL"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
+22 ;----------
T4PMIS ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO T4PMIH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS"))
Begin DoDot:1
+4 IF BUDROT="P"
WRITE !!,"No patients to report."
QUIT
+5 IF BUDROT="D"
DO S("")
DO S("")
DO S("No patients to report.")
End DoDot:1
QUIT
+6 DO T4PMIS1
+7 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4PMIH
IF BUDQUIT
GOTO T4PMISX
+8 Begin DoDot:1
+9 IF BUDROT="P"
WRITE !!,"TOTAL PATIENTS: ",BUDTOT,!
QUIT
+10 IF BUDROT="D"
DO S("")
DO S("TOTAL PATIENTS: "_BUDTOT)
DO S("")
End DoDot:1
T4PMISX ;
+1 QUIT
T4PMIS1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO T4PMIH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDINCI=""
FOR
SET BUDINCI=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI))
IF BUDINCI=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDINC=""
FOR
SET BUDINC=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC))
IF BUDINC=""!(BUDQUIT)
QUIT
DO T4PMIS2
End DoDot:1
+5 QUIT
T4PMIS2 ;
+1 SET BUDSTOT=0
+2 IF BUDROT="P"
WRITE !,"Principal Third-Party Medical Insurance Source: ",BUDINC,!
+3 IF BUDROT="D"
DO S("Principal Third-Party Medical Insurance Source: "_BUDINC)
DO S("")
+4 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDCCOM=""
FOR
SET BUDCCOM=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDSEX=""
FOR
SET BUDSEX=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX))
IF BUDSEX=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4PMIS",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4PMIH
IF BUDQUIT
QUIT
WRITE !,"Principal Third-Party Medical Insurance Source: ",BUDINC,!
+9 IF BUDINCI'=8.9
SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 IF BUDROT="P"
Begin DoDot:5
+11 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))
+12 WRITE ?36,$EXTRACT(BUDCCOM,1,13),?51,$PIECE(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
+13 WRITE !?5,$SELECT(BUDINCI=8.9:"Medicare/Medicaid",1:BUDINC)
End DoDot:5
+14 IF BUDROT="D"
Begin DoDot:5
+15 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,BUD
CCAD)
+16 SET X=X_U_$SELECT(BUDINCI=8.9:"Medicare/Medicaid",1:BUDINC)
+17 DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF BUDROT="P"
IF $Y>(IOSL-4)
DO T4PMIH
IF BUDQUIT
QUIT
+19 IF BUDROT="P"
WRITE !!,"Sub-Total Line ",$SELECT(BUDINCI=8.9:"9a",BUDINCI=8.1:"8a",BUDINCI=8.2:"8b",BUDINCI=10.1:"10a",BUDINCI=10.2:"10b",1:BUDINCI)," ",BUDINC,": ",BUDSTOT,!
+20 IF BUDROT="D"
DO S("Sub-Total Line "_$SELECT(BUDINCI=8.9:"9a",BUDINCI=8.1:"8a",BUDINCI=8.2:"8b",BUDINCI=10.1:"10a",BUDINCI=10.2:"10b",1:BUDINCI)_" "_BUDINC_": "_BUDSTOT)
DO S("")
+21 QUIT
T4PMIDH ;
+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 4, Principal Third-Party Medical Insurance Source")
+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("This report provides a list of all patients and the type of medical insurance")
+11 DO S("the patient has during the report period, if any.")
+12 DO S("Age on the patient list is calculated as of June 30.")
+13 DO S(" ")
DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^PRINCIPAL THIRD-PARTY MEDICAL INSURANCE SOURCE")
+14 QUIT
T4PMIH ;
+1 IF BUDROT="D"
DO T4PMIDH
QUIT
+2 IF 'BUDGPG
GOTO T4PMIH1
+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
T4PMIH1 ;
+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 4",80)
+6 WRITE !,$$CTR("Principal Third-Party Medical Insurance Source",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 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:"")
+10 WRITE $$CTR(X,80),!
+11 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+12 IF BUDP=0
Begin DoDot:1
+13 WRITE !,"This report provides a list of all patients and the type of medical insurance"
+14 WRITE !,"the patient has during the report period, if any."
+15 WRITE !,"Age on the patient list is calculated as of June 30."
+16 WRITE !
End DoDot:1
+17 WRITE !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
+18 WRITE !,?5,"PRINCIPAL THIRD-PARTY MEDICAL INSURANCE SOURCE"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
+22 ;----------
T4CHAR ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO T4CHAH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR"))
Begin DoDot:1
+4 IF BUDROT="P"
WRITE !!,"No patients to report."
QUIT
+5 IF BUDROT="D"
DO S("")
DO S("No patients to report.")
End DoDot:1
QUIT
+6 DO T4CHAR1
+7 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4CHAH
IF BUDQUIT
GOTO T4CHARX
+8 Begin DoDot:1
+9 IF BUDROT="P"
WRITE !!,"TOTAL PATIENTS: ",BUDTOT,!
QUIT
+10 IF BUDROT="D"
DO S("")
DO S("TOTAL PATIENTS: "_BUDTOT)
DO S("")
End DoDot:1
T4CHARX ;
+1 QUIT
T4CHAR1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO T4CHAH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDINCI=""
FOR
SET BUDINCI=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI))
IF BUDINCI=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDINC=""
FOR
SET BUDINC=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC))
IF BUDINC=""!(BUDQUIT)
QUIT
DO T4CHAR2
End DoDot:1
+5 QUIT
T4CHAR2 ;
+1 SET BUDSTOT=0
+2 IF BUDROT="P"
WRITE !,"Special Characteristics: ",BUDINC,!
+3 IF BUDROT="D"
DO S("Special Characteristics: "_BUDINC)
+4 SET BUDAGE=""
FOR
SET BUDAGE=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE))
IF BUDAGE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDCCOM=""
FOR
SET BUDCCOM=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM))
IF BUDCCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDSEX=""
FOR
SET BUDSEX=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX))
IF BUDSEX=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDHRPT1",BUDJ,BUDH,"T4CHAR",BUDINCI,BUDINC,BUDAGE,BUDCCOM,BUDSEX,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF BUDROT="P"
IF $Y>(IOSL-3)
DO T4CHAH
IF BUDQUIT
QUIT
WRITE !,"Special Characteristics: ",BUDINC,!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 IF BUDROT="P"
Begin DoDot:5
+11 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))
+12 WRITE ?36,$EXTRACT(BUDCCOM,1,13),?51,$PIECE(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD)
+13 WRITE !?5,BUDINC
End DoDot:5
+14 IF BUDROT="D"
Begin DoDot:5
+15 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,BUD
CCAD)
+16 SET X=X_U_BUDINC
+17 DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF BUDROT="P"
IF $Y>(IOSL-4)
DO T4CHAH
IF BUDQUIT
QUIT
+19 IF BUDROT="P"
WRITE !!,"Sub-Total Line ",BUDINCI," ",BUDINC,": ",BUDSTOT,!
+20 IF BUDROT="D"
DO S("")
DO S("Sub-Total Line "_BUDINCI_" "_BUDINC_": "_BUDSTOT)
+21 QUIT
T4CHAH ;
+1 IF BUDROT="D"
DO T4CHADH
QUIT
+2 IF 'BUDGPG
GOTO T4CHAH1
+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
T4CHAH1 ;
+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 4")
+6 WRITE !,$$CTR("Characteristics - Special Characteristics",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 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:"")
+10 WRITE $$CTR(X,80),!
+11 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+12 IF BUDP=0
Begin DoDot:1
+13 WRITE !,"This report provides a list of all patients who are migrant workers,"
+14 WRITE !,"seasonal workers, homeless, school based health center patients, or a"
+15 WRITE !,"veteran during the report period."
+16 WRITE !,"Note: Because RPMS does not record Public Housing Patients, those"
+17 WRITE !,"patients are not included in this report."
+18 WRITE !,"Age on the patient list is calculated as of June 30."
+19 WRITE !
End DoDot:1
+20 WRITE !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE"
+21 WRITE !,?5,"SPECIAL CHARACTERISTIC"
+22 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+23 SET BUDP=1
+24 QUIT
T4CHADH ;
+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 4, Characteristics - Special Characteristics")
+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("This report provides a list of all patients who are migrant workers,")
+11 DO S("seasonal workers, homeless, school based health center patients, or a")
+12 DO S("veteran during the report period.")
+13 DO S("Note: Because RPMS does not record Public Housing Patients, those")
+14 DO S("patients are not included in this report.")
+15 DO S("Age on the patient list is calculated as of June 30.")
+16 DO S(" ")
DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^SPECIAL CHARACTERISTIC")
+17 QUIT
