BUDERPL2.m

BUDERPL2 ; IHS/CMI/LAB - UDS print lists ;

 ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75

 ;

T52 ;EP

 S BUDP=0,BUDX2L=35

 I BUDROT="P",'$D(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L)) D T52H W !!,"No Uncategorized Provider visits to report." Q

 I BUDROT="D",'$D(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L)) D T52H D S(""),S("No Uncategorized Provider visits to report.") Q

 D T52H

 S BUDX2L=35,BUDX2L2=0,BUDY=$O(^BUDETFIV("B",BUDX2L,0)),BUDY=$P(^BUDETFIV(BUDY,0),U,2)

 I BUDROT="P" W !!,"Line ",BUDX2L,"   ",BUDY

 I BUDROT="D" D S(""),S("Line "_BUDX2L_"   "_BUDY)

 S BUDCCOM="" F  S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT)  D

 .S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D

 ..S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D

 ...S DFN=0 F  S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D T5W

 ...Q

 ..Q

 .Q

 I BUDROT="P" W !

 Q

T5W ;

 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)),?36,$E(BUDCCOM,1,12)

 I BUDROT="P" W ?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD),?60,$E($P($$RACE^BUDERPTC(DFN),U,4),1,15)," (",$P($$RACE^BUDERPTC(DFN),U,3),")"

 K BUDVLST S BUDV=0 F  S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D

 .S BUDVLST($P(^AUPNVSIT(BUDV,0),U),BUDV)=""

 S BUDDD=0 F  S BUDDD=$O(BUDVLST(BUDDD)) Q:BUDDD=""!(BUDQUIT)  D

 .S BUDV=0 F  S BUDV=$O(BUDVLST(BUDDD,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D

 ..I BUDROT="P",$Y>(IOSL-3) D T52H Q:BUDQUIT  W !!,"Line ",BUDX2L,"   ",BUDY

 ..I BUDROT="P" W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$$PRIMPROV^APCLV(BUDV,"D"),?50,$P(^AUPNVSIT(BUDV,0),U,7),?55,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?70,$E($$LOCENC^APCLV(BUDV,"E"),1,9)

 ..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($$RACE^BUDERPTC(DFN),U,4),1,15)_" ("_$P($$RACE^BUDERPTC(DFN),U,3)_")"

 ...S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$$PRIMPROV^APCLV(BUDV,"D")_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")

 ...D S(X)

 ..Q

 Q

T52DH ;

 D S(),S(),S()

 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 5 Columns B & C, Uncategorized Provider Visits")

 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, for uncategorized provider visits.  Displays community, gender, age and visit data, including Provider codes.")

 D S("* (R) - denotes the value was obtained from the Race field")

 D S("  (C) - denotes the value was obtained from the Classification/Beneficiary field")

 D S("")

 D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^VISIT DATE^PROV TYPE^PROV CD^SRV^CLINIC^LOCATION")

 Q

T52H ;

 I BUDROT="D" D T52DH Q

 G:'BUDGPG T5H2

 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

T5H2 ;

 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 5 Columns B & C, Uncategorized Provider Visits",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 W !,"List of all patients, for uncategorized provider visits.  Displays",!,"community, gender, age and visit data, including Provider codes." D

 .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",?60,"RACE*"

 W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"PROV CD",?50,"SRV",?55,"CLINIC",?70,"LOCATION"

 W !,$TR($J("",80)," ","-")

 S BUDP=1

 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")

 ;----------

T51 ;EP

 S BUDNEWR=1

 I BUDROT="D" D T51DH

 S BUDX2L="" F  S BUDX2L=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L)) Q:BUDX2L=""!(BUDQUIT)  D

 .S BUDX2L2="" F  S BUDX2L2=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2)) Q:BUDX2L2=""!(BUDQUIT)  D

 ..S BUDX2LL=BUDX2L_$S(BUDX2L2=0:"",1:BUDX2L2)

 ..S BUDY=$O(^BUDETFIV("B",BUDX2LL,0)),BUDY=$P(^BUDETFIV(BUDY,0),U,2)_" "_$P(^BUDETFIV(BUDY,0),U,3)_" "_$P(^BUDETFIV(BUDY,0),U,4)

 ..S BUDSUBT="Line "_BUDX2LL_"   "_BUDY

 ..I BUDROT="P",$Y>(IOSL-3)!$G(BUDNEWR) D T51H Q:BUDQUIT  K BUDNEWR

 ..I BUDROT="P" W !!,"Line ",BUDX2LL,"   ",BUDY

 ..I BUDROT="D" D S(""),S("Line "_BUDX2LL_"  "_BUDY)

 ..S BUDPROV="" F  S BUDPROV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV)) Q:BUDPROV=""!(BUDQUIT)  D

 ...I BUDROT="P",$Y>(IOSL-3) D T51H Q:BUDQUIT  W !!,"Line ",BUDX2LL,"   ",BUDY

 ...I BUDROT="P" W !,BUDPROV,?35,^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV)

 ...I BUDROT="D" S X=BUDPROV_U_^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV) D S(X)

 .Q

 I BUDROT="P" W !

 Q

T51H ;

 I BUDROT="D" D T51DH

 G:'BUDGPG T51H1

 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

T51H1 ;

 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("Personnel List for Table 5 Column A, By Service Category",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)," ","-")

 W !,"List of all Active Provider Personnel sorted by Major Service Category.",!

 W !,"PROVIDER NAME",?35,"PROVIDER CODE",?70,"FTE"

 W !,$TR($J("",80)," ","-")

 Q

T51DH ;

 D S(),S(),S()

 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("Personnel List for Table 5 Column A, By Service Category")

 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 Active Provider Personnel sorted by Major Service Category.")

 D S(" "),S("PROVIDER NAME^PROVIDER CODE^FTE")

 Q

T3A ;EP

 S BUDP=0

 D T3H Q:BUDQUIT

 S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"3A",BUDAGE)) Q:BUDAGE'=+BUDAGE!(BUDQUIT)  D

 .S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D

 ..S BUDCCOM="" F  S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT)  D

 ...S DFN="" F  S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D

 ....I BUDROT="P",$Y>(IOSL-3) D T3H Q:BUDQUIT

 ....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)),?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD) ;

 ....S BUDV=0 F  S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCCOM,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D

 .....I BUDROT="P",$Y>(IOSL-3) D T3H Q:BUDQUIT

 .....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_$$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" W !

 Q

T3H ;

 I BUDROT="D" D T3HD Q

 G:'BUDGPG T3H1

 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

T3H1 ;

 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 3A, Patients by Age and Sex Assigned at Birth",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,"

 .W !,"with sex assigned at birth, age, and visit information. "

 .W !,"Age is calculated as of June 30.",!

 W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",!?46,"ASSIGNED",!?46,"AT BIRTH"

 W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"SRV",?45,"CLINIC",?62,"LOCATION"

 S BUDP=1

 W !,$TR($J("",80)," ","-")

 Q

T3HD ;

 D S(),S(),S()

 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 3A, Patients by Age and Sex Assigned at Birth")

 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,")

 D S("with sex assigned at birth, age, and visit information.")

 D S("Age is calculated as of June 30.")

 D S(" "),S("PATIENT NAME^HRN^COMMUNITY^SEX ASSIGNED AT BIRTH^AGE^VISIT DATE^PROV TYPE^SRV^CLINIC^LOCATION")

 Q

S(V) ;

 S BUDDECNT=BUDDECNT+1

 S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)

 Q

BUDERPL2  ; IHS/CMI/LAB - UDS print lists ;

 +1       ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75

 +2       ;

T52       ;EP

 +1        SET BUDP=0

           SET BUDX2L=35

 +2        IF BUDROT="P"

               IF '$DATA(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L))

                   DO T52H

                   WRITE !!,"No Uncategorized Provider visits to report."

                   QUIT 

 +3        IF BUDROT="D"

               IF '$DATA(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L))

                   DO T52H

                   DO S("")

                   DO S("No Uncategorized Provider visits to report.")

                   QUIT 

 +4        DO T52H

 +5        SET BUDX2L=35

           SET BUDX2L2=0

           SET BUDY=$ORDER(^BUDETFIV("B",BUDX2L,0))

           SET BUDY=$PIECE(^BUDETFIV(BUDY,0),U,2)

 +6        IF BUDROT="P"

               WRITE !!,"Line ",BUDX2L,"   ",BUDY

 +7        IF BUDROT="D"

               DO S("")

               DO S("Line "_BUDX2L_"   "_BUDY)

 +8        SET BUDCCOM=""

           FOR 

               SET BUDCCOM=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM))

               IF BUDCCOM=""!(BUDQUIT)

                   QUIT 

               Begin DoDot:1

 +9                SET BUDAGE=""

                   FOR 

                       SET BUDAGE=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE))

                       IF BUDAGE=""!(BUDQUIT)

                           QUIT 

                       Begin DoDot:2

 +10                       SET BUDSEX=""

                           FOR 

                               SET BUDSEX=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX))

                               IF BUDSEX=""!(BUDQUIT)

                                   QUIT 

                               Begin DoDot:3

 +11                               SET DFN=0

                                   FOR 

                                       SET DFN=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN))

                                       IF DFN'=+DFN!(BUDQUIT)

                                           QUIT 

                                       DO T5W

 +12                               QUIT 

                               End DoDot:3

 +13                       QUIT 

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       IF BUDROT="P"

               WRITE !

 +16       QUIT 

T5W       ;

 +1        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)),?36,$EXTRACT(BUDCCOM,1,12)

 +2        IF BUDROT="P"

               WRITE ?51,$PIECE(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD),?60,$EXTRACT($PIECE($$RACE^BUDERPTC(DFN),U,4),1,15)," (",$PIECE($$RACE^BUDERPTC(DFN),U,3),")"

 +3        KILL BUDVLST

           SET BUDV=0

           FOR 

               SET BUDV=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN,BUDV))

               IF BUDV'=+BUDV!(BUDQUIT)

                   QUIT 

               Begin DoDot:1

 +4                SET BUDVLST($PIECE(^AUPNVSIT(BUDV,0),U),BUDV)=""

               End DoDot:1

 +5        SET BUDDD=0

           FOR 

               SET BUDDD=$ORDER(BUDVLST(BUDDD))

               IF BUDDD=""!(BUDQUIT)

                   QUIT 

               Begin DoDot:1

 +6                SET BUDV=0

                   FOR 

                       SET BUDV=$ORDER(BUDVLST(BUDDD,BUDV))

                       IF BUDV'=+BUDV!(BUDQUIT)

                           QUIT 

                       Begin DoDot:2

 +7                        IF BUDROT="P"

                               IF $Y>(IOSL-3)

                                   DO T52H

                                   IF BUDQUIT

                                       QUIT 

                                   WRITE !!,"Line ",BUDX2L,"   ",BUDY

 +8                        IF BUDROT="P"

                              WRITE !?5,$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(BUDV,0),U),".")),?25,$EXTRACT($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$$PRIMPROV^APCLV(BUDV,"D"),?50,$PIECE(^AUPNVSIT(BUDV,0),U,7),?55,$EXTRACT($$CLINIC^APCLV(BUDV,"E"),1,14),?70,..

.

                               ... $EXTRACT($$LOCENC^APCLV(BUDV,"E"),1,9)

 +9                        IF BUDROT="D"

                               Begin DoDot:3

 +10                               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)

 +11                               SET X=X_U_$EXTRACT($PIECE($$RACE^BUDERPTC(DFN),U,4),1,15)_" ("_$PIECE($$RACE^BUDERPTC(DFN),U,3)_")"

 +12                               SET X=X_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$$PRIMPROV^APCLV(BUDV,"D")_U_$PIECE(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")

 +13                               DO S(X)

                               End DoDot:3

 +14                       QUIT 

                       End DoDot:2

               End DoDot:1

 +15       QUIT 

T52DH     ;

 +1        DO S()

           DO S()

           DO S()

 +2        DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")

 +3        DO S($PIECE(^VA(200,DUZ,0),U,2)_"    "_$$FMTE^XLFDT(DT))

 +4        DO S("***  RPMS Uniform Data System (UDS)  ***")

 +5        DO S("Patient List for Table 5 Columns B & C, Uncategorized Provider Visits")

 +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, for uncategorized provider visits.  Displays community, gender, age and visit data, including Provider codes.")

 +11       DO S("* (R) - denotes the value was obtained from the Race field")

 +12       DO S("  (C) - denotes the value was obtained from the Classification/Beneficiary field")

 +13       DO S("")

 +14       DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^VISIT DATE^PROV TYPE^PROV CD^SRV^CLINIC^LOCATION")

 +15       QUIT 

T52H      ;

 +1        IF BUDROT="D"

               DO T52DH

               QUIT 

 +2        IF 'BUDGPG

               GOTO T5H2

 +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 

T5H2      ;

 +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 5 Columns B & C, Uncategorized Provider Visits",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

               WRITE !,"List of all patients, for uncategorized provider visits.  Displays",!,"community, gender, age and visit data, including Provider codes."

               Begin DoDot:1

 +12               WRITE !,"* (R) - denotes the value was obtained from the Race field"

 +13               WRITE !,"  (C) - denotes the value was obtained from the Classification/Beneficiary field"

 +14               WRITE !

               End DoDot:1

 +15       WRITE !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE*"

 +16       WRITE !?5,"VISIT DATE",?25,"PROV TYPE",?41,"PROV CD",?50,"SRV",?55,"CLINIC",?70,"LOCATION"

 +17       WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +18       SET BUDP=1

 +19       QUIT 

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       ;----------

T51       ;EP

 +1        SET BUDNEWR=1

 +2        IF BUDROT="D"

               DO T51DH

 +3        SET BUDX2L=""

           FOR 

               SET BUDX2L=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L))

               IF BUDX2L=""!(BUDQUIT)

                   QUIT 

               Begin DoDot:1

 +4                SET BUDX2L2=""

                   FOR 

                       SET BUDX2L2=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2))

                       IF BUDX2L2=""!(BUDQUIT)

                           QUIT 

                       Begin DoDot:2

 +5                        SET BUDX2LL=BUDX2L_$SELECT(BUDX2L2=0:"",1:BUDX2L2)

 +6                        SET BUDY=$ORDER(^BUDETFIV("B",BUDX2LL,0))

                           SET BUDY=$PIECE(^BUDETFIV(BUDY,0),U,2)_" "_$PIECE(^BUDETFIV(BUDY,0),U,3)_" "_$PIECE(^BUDETFIV(BUDY,0),U,4)

 +7                        SET BUDSUBT="Line "_BUDX2LL_"   "_BUDY

 +8                        IF BUDROT="P"

                               IF $Y>(IOSL-3)!$GET(BUDNEWR)

                                   DO T51H

                                   IF BUDQUIT

                                       QUIT 

                                   KILL BUDNEWR

 +9                        IF BUDROT="P"

                               WRITE !!,"Line ",BUDX2LL,"   ",BUDY

 +10                       IF BUDROT="D"

                               DO S("")

                               DO S("Line "_BUDX2LL_"  "_BUDY)

 +11                       SET BUDPROV=""

                           FOR 

                               SET BUDPROV=$ORDER(^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV))

                               IF BUDPROV=""!(BUDQUIT)

                                   QUIT 

                               Begin DoDot:3

 +12                               IF BUDROT="P"

                                       IF $Y>(IOSL-3)

                                           DO T51H

                                           IF BUDQUIT

                                               QUIT 

                                           WRITE !!,"Line ",BUDX2LL,"   ",BUDY

 +13                               IF BUDROT="P"

                                       WRITE !,BUDPROV,?35,^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV)

 +14                               IF BUDROT="D"

                                       SET X=BUDPROV_U_^XTMP("BUDERPT1",BUDJ,BUDH,"T51",BUDX2L,BUDX2L2,BUDPROV)

                                       DO S(X)

                               End DoDot:3

                       End DoDot:2

 +15               QUIT 

               End DoDot:1

 +16       IF BUDROT="P"

               WRITE !

 +17       QUIT 

T51H      ;

 +1        IF BUDROT="D"

               DO T51DH

 +2        IF 'BUDGPG

               GOTO T51H1

 +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 

T51H1     ;

 +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("Personnel List for Table 5 Column A, By Service Category",80),!

 +6        WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!

 +7        SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)