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

BUD5RPTL.m

Go to the documentation of this file. 
  1. BUD5RPTL ; IHS/CMI/LAB - UDS print lists ;
  1.  ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1.  ;
  1. START ;
  1.  S BUDQUIT="",BUDGPG=0
  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(BUDT6L) D T6
  1.  Q:BUDQUIT
  1.  I $G(BUDTZL) D TZ
  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("BUD5RPT1",BUDJ,BUDH,"3A",BUDAGE)) Q:BUDAGE'=+BUDAGE!(BUDQUIT)  D
  1.  .S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN="" F  S DFN=$O(^XTMP("BUD5RPT1",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^BUD5RPTC(DFN),U,2)
  1.  ....S BUDV=0 F  S BUDV=$O(^XTMP("BUD5RPT1",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.  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 Users, defined as any patient 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^BUD5RPL2
  1.  Q
  1. T51 ;
  1.  D T51H Q:BUDQUIT
  1.  S BUD5L="" F  S BUD5L=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T51",BUD5L)) Q:BUD5L=""!(BUDQUIT)  D
  1.  .S BUD5L2="" F  S BUD5L2=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T51",BUD5L,BUD5L2)) Q:BUD5L2=""!(BUDQUIT)  D
  1.  ..S BUD5LL=BUD5L_$S(BUD5L2=0:"",1:BUD5L2)
  1.  ..I $Y>(IOSL-3) D T51H Q:BUDQUIT
  1.  ..S BUDY=$O(^BUDVTFIV("B",BUD5LL,0)),BUDY=$P(^BUDVTFIV(BUDY,0),U,2)
  1.  ..W !!,"Line ",BUD5LL,"   ",BUDY
  1.  ..S BUDPROV="" F  S BUDPROV=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T51",BUD5L,BUD5L2,BUDPROV)) Q:BUDPROV=""!(BUDQUIT)  D
  1.  ...W !,BUDPROV,?35,^XTMP("BUD5RPT1",BUDJ,BUDH,"T51",BUD5L,BUD5L2,BUDPROV)
  1.  .Q
  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.  Q
  1. T5 ;
  1.  S BUDP=0
  1.  S BUD5L="" F   S BUD5L=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L)) Q:BUD5L=""!(BUDQUIT)  D
  1.  .S BUD5L2="" F  S BUD5L2=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2)) Q:BUD5L2=""!(BUDQUIT)  D
  1.  ..D T5H Q:BUDQUIT
  1.  ..S BUD5LL=BUD5L_$S(BUD5L2=0:"",1:BUD5L2)
  1.  ..S BUDY=$O(^BUDVTFIV("B",BUD5LL,0)),BUDY=$P(^BUDVTFIV(BUDY,0),U,2)
  1.  ..W !!,"Line ",BUD5LL,"   ",BUDY
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ....S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  .....S DFN=0 F  S DFN=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2,BUDCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D T5W
  1.  .....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  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^BUD5RPTC(DFN),U,2)
  1.  K BUDVLST S BUDV=0 F  S BUDV=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T5",BUD5L,BUD5L2,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 Users, 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.  S BUDP=1
  1.  Q
  1. TZ ;
  1.  S BUDP=0
  1.  D TZH Q:BUDQUIT
  1.  S BUDZIP="" F  S BUDZIP=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"Z",BUDZIP)) Q:BUDZIP=""!(BUDQUIT)  D
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ...S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"Z",BUDZIP,BUDCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ....S DFN="" F  S DFN=$O(^XTMP("BUD5RPT1",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("BUD5RPT1",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.  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: User/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 Users, defined as any patient with one or more visits during the",!,"calendar year."
  1.  I BUDP=0 W !,"Zip code is from patient registration."
  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 BUD6L="" F   S BUD6L=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L)) Q:BUD6L=""!(BUDQUIT)  D
  1.  F BUD6L=1:1:19,40:1:43,21:1:34 D
  1.  .Q:'$D(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L))
  1.  .D T6H Q:BUDQUIT
  1.  .W !!,"Line ",$S($P($T(@BUD6L),";;",3)]"":$P($T(@BUD6L),";;",3),1:BUD6L),"   ",$P($T(@BUD6L),";;",2)
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ...S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D T6W
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1. T6W ;
  1.  I $Y>(IOSL-3) D T6H 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^BUD5RPTC(DFN),U,2)
  1.  S BUDV=0 F  S BUDV=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT)  D
  1.  .I $Y>(IOSL-3) D T6H Q:BUDQUIT
  1.  .W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,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 BUD6L=22 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1.  I BUD6L=23 D
  1.  .S BUDW=0 F  S BUDW=$O(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT)  D
  1.  ..W !?5,$P(^XTMP("BUD5RPT1",BUDJ,BUDH,"T6",BUD6L,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 Users, 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 venereal 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. Restorative Services (Endo, Perio, Prostho, Ortho)