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

BUD1RPTL.m

Go to the documentation of this file. 
  1. BUD1RPTL ; IHS/CMI/LAB - UDS print lists 12 Dec 2007 12:12 PM 02 Dec 2011 10:43 AM ;
  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) S BUDGPG=0 D TZ
  1.  Q:BUDQUIT
  1.  I $G(BUDT3AL) S BUDGPG=0 D T3A
  1.  Q:BUDQUIT
  1.  I $G(BUDT3BRL) S BUDGPG=0 D T3BR
  1.  Q:BUDQUIT
  1.  I $G(BUDT4IPP) S BUDGPG=0 D T4IPPL
  1.  Q:BUDQUIT
  1.  I $G(BUDT4PMI) S BUDGPG=0 D T4PMIS
  1.  Q:BUDQUIT
  1.  I $G(BUDT4CHA) S BUDGPG=0 D T4CHAR
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L) S BUDGPG=0 D T5
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L1) S BUDGPG=0 D T51
  1.  Q:BUDQUIT
  1.  I $G(BUDT5L2) S BUDGPG=0 D T52
  1.  Q:BUDQUIT
  1.  I $G(BUDT6L) S BUDGPG=0 D T6
  1.  Q:BUDQUIT
  1.  Q
  1. T3BR ;
  1.  D T3BR^BUD1RPL4
  1.  Q
  1. T4IPPL ;
  1.  D T4IPPL^BUD1RPL5
  1.  Q
  1. T4PMIS ;
  1.  D T4PMIS^BUD1RPL5
  1.  Q
  1. T4CHAR ;
  1.  D T4CHAR^BUD1RPL5
  1.  Q
  1. T3A ;
  1.  S BUDP=0
  1.  D T3H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"3A",BUDAGE)) Q:BUDAGE'=+BUDAGE!(BUDQUIT)  D
  1.  .S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN="" F  S DFN=$O(^XTMP("BUD1RPT1",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) ;
  1.  ....S BUDV=0 F  S BUDV=$O(^XTMP("BUD1RPT1",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 Table 3A, Patients by Age and Gender",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.  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)",1:"") 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, 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^BUD1RPL2
  1.  Q
  1. T51 ;EP
  1.  D T51^BUD1RPL2
  1.  Q
  1. T5 ;
  1.  S BUDP=0
  1.  S BUD1L="" F   S BUD1L=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L)) Q:BUD1L=""!(BUDQUIT)  D
  1.  .Q:BUD1L=35  ;NO UNCATEGORIZED
  1.  .S BUD1L2="" F  S BUD1L2=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2)) Q:BUD1L2=""!(BUDQUIT)  D
  1.  ..S BUD1LL=BUD1L_$S(BUD1L2=0:"",1:BUD1L2)
  1.  ..S BUDY=$O(^BUDLTFIV("B",BUD1LL,0)),BUDY=$P(^BUDLTFIV(BUDY,0),U,2)_" "_$P(^BUDLTFIV(BUDY,0),U,3)_" "_$P(^BUDLTFIV(BUDY,0),U,4)
  1.  ..S BUDSUBT="Line "_BUD1LL_"   "_BUDY
  1.  ..D T5H Q:BUDQUIT
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ....S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  .....S DFN=0 F  S DFN=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2,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))
  1.  W ?36,$E(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCAD),?60,$E($P($$RACE^BUD1RPTC(DFN),U,4),1,16)," (",$P($$RACE^BUD1RPTC(DFN),U,3),")"
  1.  K BUDVLST S BUDV=0 F  S BUDV=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T5",BUD1L,BUD1L2,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.  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)",1:"") 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.",!,"Age is calculated as of June 30." D
  1.  .W !,"* (R) - denotes the value was obtained from the Race field"
  1.  .W !,"  (C) - denotes the value was obtained from the Classification/Beneficiary field"
  1.  W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE*"
  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 BUDYY=0 F  S BUDYY=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY)) Q:BUDYY'=+BUDYY!(BUDQUIT)  D TZ1
  1.  Q:BUDQUIT
  1.  ;now list unknown residence
  1.  S BUDYY="Unknown Residence" D TZ2
  1.  Q
  1. TZ2 ;
  1.  ;S BUDZIP="" F  S BUDZIP=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,BUDZIP)) Q:BUDZIP=""!(BUDQUIT)  D
  1.  D
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,BUDCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ...S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,BUDCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ....S DFN="" F  S DFN=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,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,BUDYY
  1.  .....S BUDV=0 F  S BUDV=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"Z",BUDYY,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. TZ1 ;
  1.  S BUDZIP="" F  S BUDZIP=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP)) Q:BUDZIP=""!(BUDQUIT)  D
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ...S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ....S DFN="" F  S DFN=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,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("BUD1RPT1",BUDJ,BUDH,"ZNEW",BUDYY,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.  D TZH^BUD1RPTD
  1.  Q
  1. T6 ;
  1.  S BUDP=0
  1.  F BUD1L=1,2,3,4,67,68,5:1:14,60,15:1:19,61,40:1:43,21,69,70,22,23,24,65,66,25,26,62,63,64,71,27:1:34 D
  1.  .Q:'$D(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L))
  1.  .D T6H Q:BUDQUIT
  1.  .W !!,"Line ",$S($P($T(@BUD1L),";;",3)]"":$P($T(@BUD1L),";;",3),1:BUD1L),"   ",$P($T(@BUD1L),";;",2)
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ...S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,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(@BUD1L),";;",3)]"":$P($T(@BUD1L),";;",3),1:BUD1L),"   ",$P($T(@BUD1L),";;",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))
  1.  W ?36,$E(BUDCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCAD),?60,$E($P($$RACE^BUD1RPTC(DFN),U,4),1,16)," (",$P($$RACE^BUD1RPTC(DFN),U,3),")"
  1.  K BUDVRR S BUDV=0,BUDVC=0 F  S BUDV=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,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(@BUD1L),";;",3)]"":$P($T(@BUD1L),";;",3),1:BUD1L),"   ",$P($T(@BUD1L),";;",2)
  1.  .S BUDV=BUDVRR(BUDVD,BUDVC)
  1.  .W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,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 BUD1L=22 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1.  I BUD1L=23 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD1RPT1",BUDJ,BUDH,"T6",BUD1L,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 6A, 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.  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)",1:"") 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." D
  1.  .W !,"* (R) - denotes the value was obtained from the Race field"
  1.  .W !,"  (C) - denotes the value was obtained from the Classification/Beneficiary field"
  1.  W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE*"
  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
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. 1 ;;Symptomatic and Asymptomatic HIV;;1,2
  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. 60 ;;Overweight and obesity;;14a
  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. 61 ;;Tobacco use disorder;;19a
  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 Test
  1. 24 ;;Selected Immunizations
  1. 65 ;;Seasonal Flu vaccine;;24a
  1. 66 ;;H1N1 Flu vaccine;;24b
  1. 25 ;;Contraceptive Management
  1. 26 ;;Health supervision of infant or child (ages 0 through 11)
  1. 62 ;;Childhood lead test screening (9 to 72 months);;26a
  1. 63 ;;Screening, Brief Intervention, and Referral (SBIRT);;26b
  1. 64 ;;Smoke and tobacco use cessation counseling;;26c
  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)
  1. 69 ;;Hepatitis B test;;21a
  1. 70 ;;Hepatitis C test;;21b
  1. 71 ;;Comprehensive and Intermediate Eye Exams;;26d
  1. 67 ;;Hepatitis B;;4a
  1. 68 ;;Hepatitis C;;4b