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

BUDHRPTP.m

Go to the documentation of this file. 
  1. BUDHRPTP ;IHS/CMI/LAB - UDS REPORT PRINT;
  1.  ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
  1.  ;
  1. PRINT ;EP
  1.  ;
  1.  S BUDPG=0,BUDTPG=0,BUDSCTC=0,BUDZLIST=0
  1.  ;ARE THERE ANY LISTS?
  1.  I ($G(BUDT3BRL)+$G(BUDT4IPP)+$G(BUDT4PMI)+$G(BUDT4CHA)+$G(BUDT3AL)+$G(BUDT5L)+$G(BUDT5L1)+$G(BUDT6L)+$G(BUDTZL)+$G(BUDT5L2))>0 S BUDZLIST=1
  1.  S BUDQUIT=0
  1.  S BUD80L="",$P(BUD80L,"_",79)="_"
  1.  S:$G(BUDROT)="" BUDROT="P"
  1.  I BUDROT="D" D  G PL
  1.  .D ^%ZISC
  1.  .K ^TMP($J)
  1.  .S ^TMP($J,"BUDDEL",0)=0
  1.  .S BUDDECNT=0
  1.  .I $G(BUDTZ) D REOZ
  1.  I $G(BUDTZ) S BUDSCTC=BUDSCTC+1 D TZ G:BUDQUIT EOJ D SECT
  1.  I $G(BUDT3A) S BUDSCTC=BUDSCTC+1 D T3A G:BUDQUIT EOJ D SECT
  1.  I $G(BUDT3B) S BUDSCTC=BUDSCTC+1 D T3B G:BUDQUIT EOJ D SECT
  1.  I $G(BUDT4) S BUDSCTC=BUDSCTC+1 D T4 G:BUDQUIT EOJ D SECT
  1.  I $G(BUDT5) S BUDSCTC=BUDSCTC+1 D T5 G:BUDQUIT EOJ D SECT
  1.  I $G(BUDT6) S BUDSCTC=BUDSCTC+1 D T6 G:BUDQUIT EOJ D SECT
  1.  S BUDBD=BUDXXBD,BUDED=BUDXXED
  1.  I $G(BUDT6B) S BUDSCTC=BUDSCTC+1 D T6B G:BUDQUIT EOJ
  1.  I $G(BUDT7) S BUDSCTC=BUDSCTC+1 D T7 G:BUDQUIT EOJ
  1.  S BUDBD=BUDHOLBD,BUDED=BUDHOLED
  1.  I $G(BUDT9) S BUDSCTC=BUDSCTC+1 D T9 G:BUDQUIT EOJ I BUDTSCTC>1,BUDROT'="D" D SECT
  1. PL ;
  1.  D PATLISTS
  1.  I BUDROT'="D" W !,"***** END OF REPORT *****",!
  1.  D ^%ZISC
  1.  I BUDROT="D" D SAVEDEL^BUDHRPTD
  1.  I $G(BUDT9D) D WDEL^BUDHRPTQ
  1.  D EOJ
  1.  Q
  1. SECT ;
  1.  I BUDTSCTC>1,BUDROT'="D" W !,"***** END OF SECTION ",BUDSCTC," *****",!
  1.  Q
  1.  ;
  1. EOJ ;
  1.  K ^TMP($J)
  1.  K ^XTMP("BUDHRPT1",BUDJ,BUDH)
  1.  K ^XTMP("BUDHRPT9DEL",BUDJ,BUDH)
  1.  Q
  1. T9 ;
  1.  D T9^BUDHRPP2
  1.  Q
  1. T4 ;
  1.  D T4^BUDHRPP2
  1.  Q
  1. T3A ;
  1.  D T3A^BUDHRPL3
  1.  Q
  1. T3BSH ;
  1.  W !!,$$CTR("TABLE 3B -",80)
  1.  W !,$$CTR("DEMOGRAPHIC CHARACTERISTICS",80),!,$$CTR("Patients by Race and Hispanic or Latino Ethnicity",80),!,BUD80L
  1.  ;W !!,BUD80L
  1.  Q:$G(BUDLANG)
  1.  W !?53,"UNREPORTED/"
  1.  W !?41,"NON-",?53,"REFUSED TO",?70,"TOTAL"
  1.  W !?25,"HISPANIC/",?39,"HISPANIC/",?53,"REPORT",?71,"(d)"
  1.  W !?3,"PATIENTS BY RACE",?26,"LATINO",?40,"LATINO",?53,"ETHNICITY",?67,"(Sum Columns"
  1.  W !?28,"(a)",?41,"(b)",?56,"(c)",?70,"a+b+c)"
  1.  W !,BUD80L
  1.  Q
  1. TZSH ;
  1.  W !!,$$CTR("PATIENT BY ZIP CODE",80)
  1.  W !,$TR($J("",80)," ","-")
  1.  W !!?5,"Zip Code",?20,"None/",?34,"Medicaid/CHIP/",?51,"Medicare",?63,"Private",?72,"Total"
  1.  W !?20,"Uninsured",?34,"Other Public",?72,"Patients"
  1.  W !?7,"(a)",?23,"(b)",?39,"(c)",?54,"(d)",?65,"(e)",?74,"(f)"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. PATLISTS ;
  1.  D ^BUDHRPTL
  1.  Q
  1. T3B ;
  1.  S BUDPG=0
  1.  D HEADER Q:BUDQUIT  D T3BSH
  1.  ;
  1.  I $Y>(IOSL-6) D HEADER Q:BUDQUIT  D T3BSH
  1.  F BUDX="1","2A","2B","2",3,4,5,6,7,8 Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T3BSH
  1.  .W !?2,$P(BUDRACET(BUDX),U),?6,$P(BUDRACET(BUDX),U,2)
  1.  .I $P(BUDRACET(BUDX),U,7)]"" W !?6,$P(BUDRACET(BUDX),U,7)
  1.  .I $P(BUDRACET(BUDX),U,8)]"" W !?6,$P(BUDRACET(BUDX),U,8)
  1.  .I $P(BUDRACET(BUDX),U,9)]"" W !?6,$P(BUDRACET(BUDX),U,9)
  1.  .I $P(BUDRACET(BUDX),U,3)]"" W ?25,$$C($P(BUDRACET(BUDX),U,3))
  1.  .I $P(BUDRACET(BUDX),U,4)]"" W ?39,$$C($P(BUDRACET(BUDX),U,4))
  1.  .I $P(BUDRACET(BUDX),U,5)]"" W ?53,$$C($P(BUDRACET(BUDX),U,5))
  1.  .I $P(BUDRACET(BUDX),U,6)]"" W ?67,$$C($P(BUDRACET(BUDX),U,6))
  1.  .W !,BUD80L
  1.  D REST3B^BUDHRPTQ
  1.  K BUDLANG
  1.  Q
  1. TZ ;
  1.  D HEADER Q:BUDQUIT  D TZSH
  1.  ;print out each line
  1.  S BUDZTOT=0,BUDBTOT=0,BUDCTOT=0,BUDDTOT=0,BUDETOT=0,BUDFTOT=0
  1.  ;GET TOTAL
  1.  S BUDZ="" F  S BUDZ=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ)) Q:BUDZ=""  D
  1.  .S BUDY=^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ)
  1.  .S BUDZTOT=BUDZTOT+BUDY
  1.  .S BUDBTOT=BUDBTOT+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"b"))
  1.  .S BUDCTOT=BUDCTOT+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"c"))
  1.  .S BUDDTOT=BUDDTOT+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"d"))
  1.  .S BUDETOT=BUDETOT+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"e"))
  1.  .S BUDFTOT=BUDFTOT+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"f"))
  1.  ;CALCULATE "OTHER"
  1.  ;RESET BY TOTAL #
  1.  D REOZ
  1.  S BUDYY=0 F  S BUDYY=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIPORDER",BUDYY)) Q:BUDYY=""  D
  1.  .S BUDZ="" F  S BUDZ=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIPORDER",BUDYY,BUDZ)) Q:BUDZ=""!(BUDQUIT)  D
  1.  ..I $Y>(IOSL-4) D HEADER Q:BUDQUIT  D TZSH
  1.  ..S BUDY=^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ)
  1.  ..W !?8,BUDZ
  1.  ..W ?20,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"b")))
  1.  ..W ?35,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"c")))
  1.  ..W ?50,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"d")))
  1.  ..W ?63,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"e")))
  1.  ..W ?72,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ,"f")))
  1.  ..W !,BUD80L
  1.  Q:BUDQUIT
  1.  I $Y>(IOSL-6) D HEADER Q:BUDQUIT  D TZSH
  1.  W !?2,"Other Zip Codes" D
  1.  .W ?20,$$C(0)
  1.  .W ?35,$$C(0)
  1.  .W ?50,$$C(0)
  1.  .W ?63,$$C(0)
  1.  .W ?72,$$C(0)
  1.  W !,BUD80L
  1.  W !?2,"Unknown Residence" D
  1.  .W ?20,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP","Unknown Residence","b")))
  1.  .W ?35,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP","Unknown Residence","c")))
  1.  .W ?50,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP","Unknown Residence","d")))
  1.  .W ?63,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP","Unknown Residence","e")))
  1.  .W ?72,$$C(+$G(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP","Unknown Residence","f")))
  1.  W !,BUD80L,!?8,"TOTAL",?20,$$C(BUDBTOT),?35,$$C(BUDCTOT),?50,$$C(BUDDTOT),?63,$$C(BUDETOT),?72,$$C(BUDFTOT),!
  1.  Q
  1. REOZ ;
  1.  S BUDZ="" F  S BUDZ=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ)) Q:BUDZ=""  D
  1.  .Q:BUDZ["Unknown"
  1.  .S BUDY=^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIP",BUDZ)
  1.  .S BUDYY=9999999-BUDY
  1.  .S ^XTMP("BUDHRPT1",BUDJ,BUDH,"ZIPORDER",(9999999-BUDY),BUDZ)=BUDY
  1.  .D
  1.  ..;now reset the list
  1.  ..S BUDINS="" F  S BUDINS=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS)) Q:BUDINS=""  D
  1.  ...S BUDCCOM="" F  S BUDCCOM=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM)) Q:BUDCCOM=""  D
  1.  ....S BUDSEX="" F  S BUDSEX=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM,BUDSEX)) Q:BUDSEX=""  D
  1.  .....S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""  D
  1.  ......S DFN=0 F  S DFN=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN)) Q:DFN'=+DFN  D
  1.  .......S X=0 F  S X=$O(^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN,X)) Q:X'=+X  D
  1.  ........S ^XTMP("BUDHRPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZ,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN,X)=""
  1.  ........K ^XTMP("BUDHRPT1",BUDJ,BUDH,"Z",BUDZ,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN,X)
  1.  Q
  1. T5 ;print 5
  1.  S BUDPG=0 D HEADER Q:BUDQUIT  D T5SH
  1.  F BUDL=1:1:7 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .Q:'BUDY
  1.  .W !
  1.  .I +BUDL<10 W " "
  1.  .W BUDL,".",?6,$P(^BUDHTFIV(BUDY,0),U,2)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .I $P($G(BUDTAB5(BUDL)),U,1)]"" W ?60,$$C($P(BUDTAB5(BUDL),U,1),$S(BUDL=6:2,1:0)),?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  W !," 8.",?8,"Total Physicians (Lines 1 - 7)",?60,$$C($P(BUDTAB5(8),U,1)),?71,$$C($P(BUDTAB5(8),U,2),2),!,BUD80L
  1.  ;print out lines 9-15
  1.  F BUDL="9A","9B",10 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !
  1.  .I +BUDL<10 W " "
  1.  .W $$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  W !,"10a.",?8,"Total NPs, PAs, CNMs (Lines 9a - 10)",?60,$$C($P(BUDTAB5("10A"),U,1)),?71,$$C($P(BUDTAB5("10A"),U,2),2),!,BUD80L
  1.  F BUDL=11:1:14 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),$S(BUDL=11:0,1:2))
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  W !,"15.",?8,"Total Medical (Lines 8+10a through 14)",?60,$$C($P(BUDTAB5(15),U,1)),?71,$$C($P(BUDTAB5(15),U,2)),!,BUD80L
  1.  F BUDL=16,17,"17a" S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1. T518 F BUDL=18 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),2)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  W !,"19.",?8,"Total Dental Services (Lines 16 - 18)",?60,$$C($P(BUDTAB5(19),U,1)),?71,$$C($P(BUDTAB5(19),U,2)),!,BUD80L
  1.  F BUDL="20A","20A1","20A2","20B","20C" S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,4)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,4)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  W !,"20.",?8,"Total Mental Health (Lines 20a-c)",?60,$$C($P(BUDTAB5(20),U,1)),?71,$$C($P(BUDTAB5(20),U,2)),!,BUD80L
  1.  F BUDL=21 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?8,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),0)
  1.  .W !,BUD80L
  1.  F BUDL=22 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?8,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?8,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),0)
  1.  .W !,BUD80L
  1.  F BUDL="22A","22B","22C" S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .I $P(^BUDHTFIV(BUDY,0),U,4)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,4)
  1.  .I BUDL'="22C" W ?60,$$C($P(BUDTAB5(BUDL),U,1),1)
  1.  .I BUDL="22C" W ?60,$$C($P(BUDTAB5(BUDL),U,1),2)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  W !,"22d.",?8,"Total Vision Services (Lines 22a-c)",?60,$$C($P(BUDTAB5("22D"),U,1)),?71,$$C($P(BUDTAB5("22D"),U,2)),!,BUD80L
  1.  F BUDL=23 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?8,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),2)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  F BUDL=24:1:25 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),0)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  F BUDL=26,27,"27a","27b","27c",28 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),2),?71,$$C($P(BUDTAB5(BUDL),U,2),2)
  1.  .W !,BUD80L
  1.  I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  W !,"29.",?8,"Total Enabling Services (Lines 24 - 28)",?60,$$C($P(BUDTAB5(29),U,1)),?71,$$C($P(BUDTAB5(29),U,2)),!,BUD80L
  1.  I $Y>(IOSL-5) D HEADER Q:BUDQUIT  D T5SH
  1.  W !,"29a.",?8,"Other Programs/ Services",!?8,"(specify__)",?60,$$C($P(BUDTAB5("29a"),U,1),2),?71,$$C($P(BUDTAB5("29a"),U,2),2),!,BUD80L
  1.  W !,"29b.",?12,"Quality Improvement Staff",?60,$$C($P(BUDTAB5("29b"),U,1),2),?71,$$C($P(BUDTAB5("29b"),U,2),2),!,BUD80L
  1.  F BUDL="30A","30B","30C" S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D
  1.  .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH
  1.  .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)
  1.  .W ?60,$$C($P(BUDTAB5(BUDL),U,1),2)
  1.  .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)
 .W !,BUD80L

 I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH

  F BUDL=31,32 S BUDY=$O(^BUDHTFIV("B",BUDL,0)) Q:BUDQUIT  D

 .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH

 .W !,$$LOW^XLFSTR(BUDL),".",?6,$P(^BUDHTFIV(BUDY,0),U,2) I $P(^BUDHTFIV(BUDY,0),U,3)]"" W !?6,$P(^BUDHTFIV(BUDY,0),U,3)

 .W ?60,$$C($P(BUDTAB5(BUDL),U,1),2)

 .W ?71,$$C($P(BUDTAB5(BUDL),U,2),2)

 .W !,BUD80L

 I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH

 W !,"33.",?8,"Total Facility and Non-Clinical",!?8,"Support Staff (Lines 30a-32)"

 W ?60,$$C($P(BUDTAB5(33),U,1),2),?71,$$C($P(BUDTAB5(33),U,2),2),!,BUD80L

 I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH

 W !,"34.",?8,"Grand Total (Lines ",!?8,"15+19+20+21+22+22d+23+29+29a+29b+33)"

 S Y=0 F X=15,19,20,21,22,"22D",29 S Y=Y+$P(BUDTAB5(X),U)

 W ?60,$$C(Y),?71,$$C(Y,2),!,BUD80L

 I $P(BUDTAB5(35),U) D

 .I $Y>(IOSL-3) D HEADER Q:BUDQUIT  D T5SH

 .W !!,$P(BUDTAB5(35),U)," visits did not fit into any of the above categories",!

 W !

 Q

T5SH ;

 W !,$$CTR("TABLE 5 - STAFFING AND UTILIZATION",80)

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

 W !,?54,"FTEs",?60,"CLINIC",?71,"PATIENTS"

 W !?60,"VISITS"

 W !,"PERSONNEL BY MAJOR SERVICE CATEGORY",?54,"(a)",?64,"(b)",?73,"(c)"

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

 Q

T6 ;

 D T6^BUDHRPP1

 Q

T6B ;

 D PRINT^BUDHRP6B

 Q

T7 ;

 D PRINT^BUDHRP7

 Q

 G:'BUDPG HEADER1

 K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q

HEADER1 ;

 I BUDTPG=0 D:'$G(BUDZLIST) COVPAGET^BUDHUTL1 D:$G(BUDZLIST) COVPAGEP^BUDHUTL1 S BUDTPG=1 ;SECURITY

 I $G(BUDTPG)=0 G HEADER2

 I $G(BUDTPG)!($G(BUDFNP)) W:$D(IOF) @IOF

 ;

HEADER2 S BUDPG=BUDPG+1,BUDTPG=$G(BUDTPG)+1

 W $$CTR("***** SENSITIVE INFORMATION *****",IOM),!

 S X=$$CTR($P(^DIC(4,BUDSITE,0),U),55),$E(X,3)=$P(^VA(200,DUZ,0),U,2),$E(X,10)="UDS 2018",$E(X,55)="Section "_BUDSCTC_" of "_BUDTSCTC_", Page "_BUDPG W !,X

 W !,"UDS No.  ",$P(^BUDHSITE(BUDSITE,0),U,2),?50,"Date Run: ",$$FMTE^XLFDT(DT)

 W !,"Reporting Period:  ",$$FMTE^XLFDT(BUDBD)," through ",$$FMTE^XLFDT(BUDED)

 W !,"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)",$G(BUDBEN)=4:"Homeless",1:"")

 W !

 Q

C(X,Y) ;

 I $G(Y)=1,+X=0 Q ""

 I $G(Y)=2 Q "********"

 S X2=0,X3=8

 D COMMA^%DTC

 Q X

CTR(X,Y) ;EP - Center X

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

USR() ;EP - Return name

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return loc

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------