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

BUDRPTL.m

Go to the documentation of this file. 
  1. BUDRPTL ; 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(BUDTOL) D TOL
  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("BUDRPT1",BUDJ,BUDH,"3A",BUDAGE)) Q:BUDAGE'=+BUDAGE!(BUDQUIT)  D
  1.  .S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"3A",BUDAGE,BUDSEX,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN="" F  S DFN=$O(^XTMP("BUDRPT1",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^BUDRPTC(DFN),U,2)
  1.  ....S BUDV=0 F  S BUDV=$O(^XTMP("BUDRPT1",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.  S BUDP=1
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. T52 ;
  1.  D T52^BUDRPTL2
  1.  Q
  1. T51 ;
  1.  D T51H Q:BUDQUIT
  1.  S BUD5L="" F  S BUD5L=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T51",BUD5L)) Q:BUD5L=""!(BUDQUIT)  D
  1.  .I $Y>(IOSL-3) D T51H Q:BUDQUIT
  1.  .S BUDY=$O(^BUDTFIVE("B",BUD5L,0)),BUDY=$P(^BUDTFIVE(BUDY,0),U,2)
  1.  .W !!,"Line ",BUD5L,"   ",BUDY
  1.  .S BUDPROV="" F  S BUDPROV=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T51",BUD5L,BUDPROV)) Q:BUDPROV=""!(BUDQUIT)  D
  1.  ..W !,BUDPROV,?35,^XTMP("BUDRPT1",BUDJ,BUDH,"T51",BUD5L,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("Provider List for Table 5 Columns 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.  ;D T5H Q:BUDQUIT
  1.  S BUD5L="" F   S BUD5L=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L)) Q:BUD5L=""!(BUDQUIT)  D
  1.  .D T5H Q:BUDQUIT
  1.  .S BUDY=$O(^BUDTFIVE("B",BUD5L,0)),BUDY=$P(^BUDTFIVE(BUDY,0),U,2)
  1.  .W !!,"Line ",BUD5L,"   ",BUDY
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ...S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L,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^BUDRPTC(DFN),U,2)
  1.  K BUDVLST S BUDV=0 F  S BUDV=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T5",BUD5L,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,$$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)
  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 !,$TR($J("",80)," ","-")
  1.  S BUDP=1
  1.  Q
  1. T6 ;
  1.  S BUDP=0
  1.  ;D T6H Q:BUDQUIT
  1.  S BUD6L="" F   S BUD6L=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T6",BUD6L)) Q:BUD6L=""!(BUDQUIT)  D
  1.  .D T6H Q:BUDQUIT
  1.  .W !!,"Line ",BUD6L,"   ",$P($T(@BUD6L),";;",2)
  1.  .S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ..S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  ...S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDRPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BUDRPT1",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.  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^BUDRPTC(DFN),U,2)
  1.  S BUDV=0 F  S BUDV=$O(^XTMP("BUDRPT1",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("BUDRPT1",BUDJ,BUDH,"T6",BUD6L,BUDCOM,BUDAGE,BUDSEX,DFN,BUDV),?40,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,15),?60,$E($$LOCENC^APCLV(BUDV,"E"),1,15)
  1.  .Q
  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 !,$TR($J("",80)," ","-")
  1.  S BUDP=1
  1.  Q
  1. TOL ;
  1.  D TOL^BUDRPTL1
  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 dependence
  1. 19 ;;Drug dependence
  1. 20 ;;Other Mental disorders, excluding drug or alcohol dependence
  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)