source: FOIAVistA/tag/r/HOSPITAL_BASED_HOME_CARE-HBH/HBHCUTL2.m@ 628

HBHCUTL2 ; LR VAMC(IRMS)/MJT-HBHC Utility module, Entry points:  PROV, EN, EN2, TOT, & FTOT (see line labels for called by routines) ; Aug 2000
 ;;1.0;HOSPITAL BASED HOME CARE;**6,16,14,22**;NOV 01, 1993;Build 2
PROV ; Provider variable setup, called by ^HBHCRP4, ^HBHCRP9, ^HBHCRP22
 S HBHCWHO="provider",HBHCWHOS="providers",HBHCWHOC="Provider"
 Q
EN ; Entry point called by ^HBHCRP4, ^HBHCRP6, ^HBHCRP9, & ^HBHCRP22
 S HBHCCC=0
 W !!,"Do you wish to include ALL ",HBHCWHOS," on the report" S %=1 D YN^DICN
 W !
 I %=0 W !!,"A 'Yes' response will include ALL "_HBHCWHOS_".  A 'No' response will",!,"prompt for an individual "_HBHCWHO_" name." G EN
 I %=2 K DIC S DIC="^HBHC(631.4,",DIC(0)="AEMQ",DIC("A")="Select HBPC "_HBHCWHOC_": ",DIC("S")="I $P(^HBHC(631.4,Y,0),U,7)="""""
ENPRV ; Enter provider prompt
 I %=2 D ^DIC S:+Y>0 HBHCPRVL(+Y)="" G:Y>0 ENPRV
 Q
EN2 ; Entry point 2 called by ^HBHCRP6 & ^HBHCRP9
 D START^HBHCUTL
 G:(HBHCBEG1=-1)!(HBHCEND1=-1) EXIT
 S %ZIS="Q" K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
 I $D(IO("Q")) S ZTRTN="DQ^HBHCUTL2",ZTDESC="HBPC "_HBHCWHOC_" Census Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
DQ ; De-queue
 U IO
 K ^TMP("HBHC",$J)
 S $P(HBHCY,"-",133)="",$P(HBHCZ,"=",133)="",HBHCTXT="Case Census",HBHCHEAD=HBHCWHOC_" Census",HBHCHDR="W !,""Patient Name"",?28,""Last Four"",?41,""Date"",?51,""Street Address"",?83,""City"",?100,""ZIP Code"",?112,""Phone"""
 S HBHCCOLM=(132-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 S (HBHCTOT,HBHCFTOT)=0
 D TODAY^HBHCUTL
LOOP ; Loop thru ^HBHC(631) "AD" (Admission Date) cross-ref to build report for case manager report or thru ^HBHC(632) "C" (Visit Date) for provider report
 S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCDATE=X
 F  S HBHCDATE=$O(^HBHC(HBHCFILE,HBHCXREF,HBHCDATE)) Q:(HBHCDATE="")!(HBHCDATE>HBHCEND1)  S HBHCDFN="" F  S HBHCDFN=$O(^HBHC(HBHCFILE,HBHCXREF,HBHCDATE,HBHCDFN)) Q:HBHCDFN=""  D PROCESS
 I '$D(^TMP("HBHC",$J)) K HBHCNAM D HDR132^HBHCUTL W !!,"No data found for "_HBHCWHOC_" by Date Range selected."
 I $D(^TMP("HBHC",$J)) D PRTLOOP D:'$D(HBHCPRVL) FTOT
 D END132^HBHCUTL1
EXIT ; Exit module
 D ^%ZISC
 K DIC,DTOUT,DUOUT,HBHCADDT,HBHCBEG1,HBHCBEG2,HBHCC,HBHCCC,HBHCCLM1,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDPT0,HBHCDPTA,HBHCEND1,HBHCEND2,HBHCFILE,HBHCFTOT,HBHCHDR,HBHCHEAD,HBHCLST4,HBHCNAM,HBHCNBR,HBHCNDX,HBHCNM,HBHCNOD0,HBHCNOD1
 K HBHCPAGE,HBHCPHON,HBHCPRV,HBHCPRVL,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTXT,HBHCWHO,HBHCWHOC,HBHCWHOS,HBHCXREF,HBHCY,HBHCZ,HBHCZIP,X,Y,^TMP("HBHC",$J),%
 Q
PROCESS ; Process record & create ^TMP("HBHC",$J global
 S HBHCNOD0=^HBHC(HBHCFILE,HBHCDFN,0),HBHCNOD1=$G(^HBHC(HBHCFILE,HBHCDFN,1))
 ; Q if no case manager or not selected case manager 
 I HBHCFILE=631 Q:$P(HBHCNOD1,U,13)=""  Q:($D(HBHCPRVL))&('$D(HBHCPRVL($P(HBHCNOD1,U,13))))
 I HBHCFILE=631 Q:(($P(HBHCNOD0,U,40)]"")&($P(HBHCNOD0,U,40)<HBHCEND1))!($P(HBHCNOD0,U,15)=2)!($P(HBHCNOD1,U,13)="")  S HBHCADDT=$E(HBHCDATE,4,5)_"-"_$E(HBHCDATE,6,7)_"-"_$E(HBHCDATE,2,3)
 I HBHCFILE=632 Q:$P(HBHCNOD0,U,4)=""  Q:($D(HBHCPRVL))&('$D(HBHCPRVL($P(HBHCNOD0,U,4))))  ; Q if not selected provider
 I HBHCFILE=632 S (HBHCNBR,HBHCNDX)="" F  S HBHCNBR=$O(^HBHC(631,"B",+HBHCNOD0,HBHCNBR)) Q:HBHCNBR=""  S HBHCNDX=HBHCNBR
 I HBHCFILE=632 Q:HBHCNDX=""  Q:(($P(^HBHC(631,HBHCNDX,0),U,40)]"")&($P(^HBHC(631,HBHCNDX,0),U,40)<HBHCEND1))!($P(^HBHC(631,HBHCNDX,0),U,15)=2)
 I HBHCFILE=632 S HBHCADDT=$P(^HBHC(631,HBHCNDX,0),U,18),HBHCADDT=$E(HBHCADDT,4,5)_"-"_$E(HBHCADDT,6,7)_"-"_$E(HBHCADDT,2,3) Q:$P(HBHCNOD0,U,4)=""
 S HBHCNAM=$S(HBHCFILE=631:$P(^VA(200,$P(^HBHC(631.4,$P(HBHCNOD1,U,13),0),U,2),0),U)_"  ("_$P(^HBHC(631.4,$P(HBHCNOD1,U,13),0),U)_")",1:$P(^VA(200,$P(^HBHC(631.4,$P(HBHCNOD0,U,4),0),U,2),0),U)_"  ("_$P(^HBHC(631.4,$P(HBHCNOD0,U,4),0),U)_")")
 S HBHCDPT0=^DPT($P(HBHCNOD0,U),0),HBHCDPTA=$G(^DPT($P(HBHCNOD0,U),.11))
 S HBHCLST4=$E($P(HBHCDPT0,U,9),6,9),HBHCNM=$E($P(HBHCDPT0,U),1,26)
 S HBHCZIP=$S(($P(HBHCDPTA,U,12)]""):$E($P(HBHCDPTA,U,12),1,5)_$S($E($P(HBHCDPTA,U,12),6,9)]"":"-"_$E($P(HBHCDPTA,U,12),6,9),1:""),1:$E($P(HBHCDPTA,U,6),1,5)_$S($E($P(HBHCDPTA,U,6),6,9)]"":"-"_$E($P(HBHCDPTA,U,6),6,9),1:""))
 S HBHCPHON=$P($G(^DPT($P(HBHCNOD0,U),.13)),U) S:HBHCPHON?7N HBHCPHON=$E(HBHCPHON,1,3)_"-"_$E(HBHCPHON,4,7) S:HBHCPHON?10N HBHCPHON="("_$E(HBHCPHON,1,3)_") "_$E(HBHCPHON,4,6)_"-"_$E(HBHCPHON,7,10)
 S ^TMP("HBHC",$J,HBHCNAM,HBHCNM)=HBHCLST4_U_HBHCADDT_U_$P(HBHCDPTA,U)_U_$P(HBHCDPTA,U,2)_U_$P(HBHCDPTA,U,3)_U_$E($P(HBHCDPTA,U,4),1,15)_U_HBHCZIP_U_HBHCPHON
 Q
PRTLOOP ; Print loop
 S HBHCPRV="" F  S HBHCPRV=$O(^TMP("HBHC",$J,HBHCPRV)) D:HBHCTOT>0 TOT Q:HBHCPRV=""  D HDR S HBHCNM="" F  S HBHCNM=$O(^TMP("HBHC",$J,HBHCPRV,HBHCNM)) Q:HBHCNM=""  D PRT
 Q
HDR ; Report header setup
 S HBHCPAGE=0,HBHCNAM=HBHCPRV,HBHCCLM1=(132-(HBHCC+$L(HBHCNAM))\2) S:HBHCCLM1'>0 HBHCCLM1=1
 W @IOF D HDR132^HBHCUTL
 Q
PRT ; Print report
 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDR132^HBHCUTL
 S HBHCTOT=HBHCTOT+1,HBHCTMP=^TMP("HBHC",$J,HBHCPRV,HBHCNM)
 W !,HBHCNM,?28,$P(HBHCTMP,U),?41,$P(HBHCTMP,U,2),?51,$P(HBHCTMP,U,3),?83,$P(HBHCTMP,U,6),?100,$P(HBHCTMP,U,7),?112,$P(HBHCTMP,U,8)
 W:$P(HBHCTMP,U,4)]"" !?51,$P(HBHCTMP,U,4)
 W:$P(HBHCTMP,U,5)]"" !?51,$P(HBHCTMP,U,5)
 W !,HBHCY
 Q
TOT ; Print case manager/provider total, called by ^HBHCRP4 & ^HBHCRP22
 W !!,HBHCZ,!,HBHCWHOC_": "_HBHCNAM_"  "_HBHCTXT_" Total:  ",HBHCTOT,!,HBHCZ
 S HBHCFTOT=HBHCFTOT+HBHCTOT,HBHCTOT=0
 Q
FTOT ; Print report final total, called by ^HBHCRP4 & ^HBHCRP22
 K HBHCHDR,HBHCNAM S HBHCPAGE=0 W @IOF
 ; for HBHCUTL2 calls (called from HBHCRP6 & HBHCRP9)
 D:$L(HBHCZ)=132 HDR132^HBHCUTL
 ; for HBHCRP4 & HBHCRP22 calls
 D:$L(HBHCZ)=80 HDRRANGE^HBHCUTL
 W !!,HBHCTXT_" Total:  ",HBHCFTOT,!!,HBHCZ
 Q