Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BUD7RPTL

BUD7RPTL.m

Go to the documentation of this file. 
  1. BUD7RPTL ; IHS/CMI/LAB - UDS print lists 12 Dec 2007 12:12 PM ;
  1.  ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1.  ;
  1. START ;
  1.  S BUDQUIT="",BUDGPG=0
  1.  I $G(BUDTZL) D TZ
  1.  Q:BUDQUIT
  1.  I $G(BUDT3AL) D T3A
  1.  Q:BUDQUIT
  1.  I $G(BUDT3BL),'$G(BUDT3AL) D T3A
  1.  Q:BUDQUIT
  1.  I $G(BUDT4L) D T4
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L) D T5
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L1) D T51
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L2) D T52
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L3) D T53
  1.  Q:BUDQUIT
  1.  I $G(BUDT6L) D T6
  1.  Q:BUDQUIT
  1.  Q
  1. T4 ;
  1.  Q
  1. T3A ;
  1.  S BUDP=0
  1.  D T3H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"3A",BUDAGE)) Q:BUDAGE'=+BUDAGE!(BUDQUIT)  D
  1.  .S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN="" F  S DFN=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I $Y>(IOSL-3) D T3H Q:BUDQUIT
  1.  ....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(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCAD),?60,$P($$RACE^BUD7RPTC(DFN),U,2)
  1.  ....S BUDV=0 F  S BUDV=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D
  1.  .....I $Y>(IOSL-3) D T3H Q:BUDQUIT
  1.  .....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)
  1.  W !
  1.  Q
  1. T3H ;
  1.  G:'BUDGPG T3H1
  1.  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
  1. T3H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  BPHC Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List for Tables 3A, 3B",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 W !,"List of all patients with one or more visits during the calendar year,",!,"with gender, age, race or ethnicity, and visit information.",!,"Age is calculated as of June 30.",!
  1.  W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE/ETHN"
  1.  W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"SRV",?45,"CLINIC",?62,"LOCATION"
  1.  S BUDP=1
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. T52 ;
  1.  D T52^BUD7RPL2
  1.  Q
  1. T53 ;
  1.  D T53^BUD7RPL3
  1.  Q
  1. T51 ;
  1.  S BUDNEWR=1
  1.  S BUD7L="" F  S BUD7L=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T51",BUD7L)) Q:BUD7L=""!(BUDQUIT)  D
  1.  .S BUD7L2="" F  S BUD7L2=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T51",BUD7L,BUD7L2)) Q:BUD7L2=""!(BUDQUIT)  D
  1.  ..S BUD7LL=BUD7L_$S(BUD7L2=0:"",1:BUD7L2)
  1.  ..S BUDY=$O(^BUDETFIV("B",BUD7LL,0)),BUDY=$P(^BUDETFIV(BUDY,0),U,2)
  1.  ..S BUDSUBT="Line "_BUD7LL_"   "_BUDY
  1.  ..I $Y>(IOSL-3)!$G(BUDNEWR) D T51H Q:BUDQUIT  K BUDNEWR
  1.  ..W !!,"Line ",BUD7LL,"   ",BUDY
  1.  ..S BUDPROV="" F  S BUDPROV=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T51",BUD7L,BUD7L2,BUDPROV)) Q:BUDPROV=""!(BUDQUIT)  D
  1.  ...I $Y>(IOSL-3) D T51H Q:BUDQUIT  W !!,"Line ",BUD7LL,"   ",BUDY
  1.  ...W !,BUDPROV,?35,^XTMP("BUD7RPT1",BUDJ,BUDH,"T51",BUD7L,BUD7L2,BUDPROV)
  1.  .Q
  1.  W !
  1.  Q
  1. T51H ;
  1.  G:'BUDGPG T51H1
  1.  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
  1. T51H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  BPHC Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Personnel List for Table 5 Column A, By Service Category",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  W !,"List of all Active Provider Personnel sorted by Major Service Category.",!
  1.  W !,"PROVIDER NAME",?35,"PROVIDER CODE",?70,"FTE"
  1.  W !,$TR($J("",80)," ","-")
  1.  ;W !!,BUDSUBT
  1.  Q
  1. T5 ;
  1.  S BUDP=0
  1.  S BUD7L="" F   S BUD7L=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L)) Q:BUD7L=""!(BUDQUIT)  D
  1.  .S BUD7L2="" F  S BUD7L2=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2)) Q:BUD7L2=""!(BUDQUIT)  D
  1.  ..S BUD7LL=BUD7L_$S(BUD7L2=0:"",1:BUD7L2)
  1.  ..S BUDY=$O(^BUDETFIV("B",BUD7LL,0)),BUDY=$P(^BUDETFIV(BUDY,0),U,2)
  1.  ..S BUDSUBT="Line "_BUD7LL_"   "_BUDY
  1.  ..D T5H Q:BUDQUIT
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ....S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  .....S DFN=0 F  S DFN=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2,BUDCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D T5W
  1.  .....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  W !
  1.  Q
  1. T5W 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(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCAD),?60,$P($$RACE^BUD7RPTC(DFN),U,2)
  1.  K BUDVLST S BUDV=0 F  S BUDV=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T5",BUD7L,BUD7L2,BUDCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D
  1.  .S BUDVLST($P(^AUPNVSIT(BUDV,0),U),BUDV)=""
  1.  S BUDDD=0 F  S BUDDD=$O(BUDVLST(BUDDD)) Q:BUDDD=""!(BUDQUIT)  D
  1.  .S BUDV=0 F  S BUDV=$O(BUDVLST(BUDDD,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D
  1.  ..I $Y>(IOSL-3) D T5H Q:BUDQUIT
  1.  ..W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$E($$PRIMPROV^APCLV(BUDV,"D"),1,8),?50,$P(^AUPNVSIT(BUDV,0),U,7),?55,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?70,$E($$LOCENC^APCLV(BUDV,"E"),1,9)
  1.  ..Q
  1.  Q
  1. T5H ;
  1.  G:'BUDGPG T5H1
  1.  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
  1. T5H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  BPHC Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List for Table 5 Columns B & C, By Service Category",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 W !,"List of all patients, sorted by defined Service Categories.  Displays",!,"community, gender, age and visit data, including Provider codes."
  1.  W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE/ETHN"
  1.  W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"PROV CD",?50,"SRV",?55,"CLINIC",?62,"LOCATION"
  1.  W !,$TR($J("",80)," ","-")
  1.  W !!,BUDSUBT,!
  1.  S BUDP=1
  1.  Q
  1. TZ ;
  1.  S BUDP=0
  1.  D TZH Q:BUDQUIT
  1.  S BUDZIP="" F  S BUDZIP=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP)) Q:BUDZIP=""!(BUDQUIT)  D
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ...S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ....S DFN="" F  S DFN=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  .....I $Y>(IOSL-3) D TZH Q:BUDQUIT
  1.  .....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(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,BUDZIP
  1.  .....S BUDV=0 F  S BUDV=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX,BUDNAME,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D
  1.  ......I $Y>(IOSL-3) D TZH Q:BUDQUIT
  1.  ......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)
  1.  W !
  1.  Q
  1. TZH ;
  1.  G:'BUDGPG TZH1
  1.  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
  1. TZH1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  BPHC Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List Center/Grantee Profile: Patient by Zip Code",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 W !,"List of all patients with one or more visits during the calendar year."
  1.  I BUDP=0 W !,"Zip code is from patient registration."
  1.  I BUDP=0 W !!,"NOTE:  Patients with a zip code included in the Other Zip Codes category"
  1.  I BUDP=0 W !,"have their zip code value followed by a ""","*",""" (e.g. 87015*)."
  1.  W !!,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"ZIP CODE"
  1.  W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"SRV",?45,"CLINIC",?62,"LOCATION"
  1.  S BUDP=1
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. T6 ;
  1.  S BUDP=0
  1.  ;D T6H Q:BUDQUIT
  1.  ;S BUD7L="" F   S BUD7L=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L)) Q:BUD7L=""!(BUDQUIT)  D
  1.  F BUD7L=1:1:19,40:1:43,21:1:34 D
  1.  .Q:'$D(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L))
  1.  .D T6H Q:BUDQUIT
  1.  .W !!,"Line ",$S($P($T(@BUD7L),";;",3)]"":$P($T(@BUD7L),";;",3),1:BUD7L),"   ",$P($T(@BUD7L),";;",2)
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ...S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D T6W
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  W !
  1.  Q
  1. T6W ;
  1.  I $Y>(IOSL-3) D T6H Q:BUDQUIT  W !!,"Line ",$S($P($T(@BUD7L),";;",3)]"":$P($T(@BUD7L),";;",3),1:BUD7L),"   ",$P($T(@BUD7L),";;",2)
  1.  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(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCAD),?60,$P($$RACE^BUD7RPTC(DFN),U,2)
  1.  K BUDVRR S BUDV=0,BUDVC=0 F  S BUDV=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  S BUDVC=BUDVC+1,BUDVRR($$VD^APCLV(BUDV),BUDVC)=BUDV
  1.  S BUDVD=0 F  S BUDVD=$O(BUDVRR(BUDVD)) Q:BUDVD=""  S BUDVC=0 F  S BUDVC=$O(BUDVRR(BUDVD,BUDVC)) Q:BUDVC=""  D
  1.  .I $Y>(IOSL-3) D T6H Q:BUDQUIT  W !!,"Line ",$S($P($T(@BUD7L),";;",3)]"":$P($T(@BUD7L),";;",3),1:BUD7L),"   ",$P($T(@BUD7L),";;",2)
  1.  .S BUDV=BUDVRR(BUDVD,BUDVC)
  1.  .W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,BUDV),?40,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,15),?62,$E($$LOCENC^APCLV(BUDV,"E"),1,15)
  1.  .Q
  1.  I BUD7L=22 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1.  I BUD7L=23 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD7RPT1",BUDJ,BUDH,"T6",BUD7L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1.  Q
  1. T6H ;
  1.  G:'BUDGPG T6H1
  1.  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
  1. T6H1 ;
  1.  W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1.  W !,$$CTR("***  BPHC Uniform Data System (UDS)  ***",80)
  1.  W !,$$CTR("Patient List for Table 6, By Diagnosis Category",80),!
  1.  W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 W !,"List of all patients, sorted by primary diagnosis and tests/screening",!,"categories.  Displays community, gender, age and visit data, and codes."
  1.  W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE/ETHN"
  1.  W !?5,"VISIT DATE",?25,"VALUE",?41,"SRV",?45,"CLINIC",?63,"LOCATION"
  1.  W !,$TR($J("",80)," ","-")
  1.  S BUDP=1
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. 1 ;;Symptomatic HIV
  1. 2 ;;Asymptomatic HIV
  1. 3 ;;Tuberculosis
  1. 4 ;;Syphilis and other sexually transmitted diseases
  1. 5 ;;Asthma
  1. 6 ;;Chronic bronchitis and emphysema
  1. 7 ;;Abnormal breast findings, female
  1. 8 ;;Abnormal cervical findings
  1. 9 ;;Diabetes mellitus
  1. 10 ;;Heart disease (selected)
  1. 11 ;;Hypertension
  1. 12 ;;Contact dermatitis and other eczema
  1. 13 ;;Dehydration
  1. 14 ;;Exposure to heat or cold
  1. 15 ;;Otitis media and eustachian tube disorders
  1. 16 ;;Selected perinatal medical conditions
  1. 17 ;;Lack of expected normal physiological development
  1. 18 ;;Alcohol related disorders
  1. 19 ;;Other substance related disorders (excluding tobacco use disorders)
  1. 20 ;;Other Mental disorders, excluding drug or alcohol dependence
  1. 40 ;;Depression and Other Mood Disorders;;20a
  1. 41 ;;Anxiety disorders including PTSD;;20b
  1. 42 ;;Attention Deficit and disruptive behavior disorders;;20c
  1. 43 ;;Other Mental disorders, excl drug or alcohol dependence (incl mental retardation);;20d
  1. 21 ;;HIV Test
  1. 22 ;;Mammogram
  1. 23 ;;Pap Smear
  1. 24 ;;Selected Immunizations
  1. 25 ;;Contraceptive Management
  1. 26 ;;Health supervision of infant or child (ages 0 through 11)
  1. 27 ;;I.  Emergency Services
  1. 28 ;;II. Oral Exams
  1. 29 ;;Prophylaxis - adult or child
  1. 30 ;;Sealants
  1. 31 ;;Fluoride treatment
  1. 32 ;;III. Restorative Services
  1. 33 ;;IV. Oral Surgery (extractions only)
  1. 34 ;;V. Rehabilitative Services (Endo, Perio, Prostho, Ortho)