56 lines
3.9 KiB
Mathematica
56 lines
3.9 KiB
Mathematica
HBHCRP7 ; LR VAMC(IRMS)/MJT-HBHC file 631 rpt, user selects: adm or D/C by date range, & sort alphabetic by pt or date of adm or D/C; includes adm/D/C date, pt name, last four, & primary DX @ adm/D/C (code & text); ; 12/21/05 3:43pm
|
|
;;1.0;HOSPITAL BASED HOME CARE;**5,6,21,22**;NOV 01, 1993;Build 2
|
|
S DIR(0)="SB^A:Admissions;D:Discharges;",DIR("A")="Select Admissions or Discharges",DIR("?")="Enter 'A' to include Admissions on the report, 'D' to choose Discharges." D ^DIR
|
|
G:$D(DIRUT) EXIT
|
|
S HBHCTYPS=Y(0),HBHCTYP=$E(Y(0),1,9),HBHCXREF=$S(Y="A":"AD",1:"AC"),HBHCDXPC=$S(Y="A":19,1:47),HBHCCC=0
|
|
; Prompt user for sort preference: alphabetical by patient or date of admission or D/C
|
|
K DIR S DIR(0)="SB^A:Alphabetical;D:Date of Admission or D/C",DIR("A")="Sort Alphabetically by Patient or by Date",DIR("?")="Sort report alphabetically by patient (A), or by date of admission or D/C (D)." D ^DIR
|
|
G:$D(DIRUT) EXIT
|
|
; HBHCFLG exists if alphabetic sort selected
|
|
S:Y="A" HBHCFLG=1
|
|
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^HBHCRP7",ZTDESC="HBPC "_HBHCTYP_"Alphabetic Date Range Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
|
|
DQ ; De-queue
|
|
U IO
|
|
K ^TMP("HBHC",$J)
|
|
S $P(HBHCY,"-",133)="",$P(HBHCZ,"=",133)=""
|
|
S:'$D(HBHCFLG) HBHCHEAD=HBHCTYPS_" by Date Range, Date Range Sort"
|
|
S:$D(HBHCFLG) HBHCHEAD=HBHCTYPS_" by Date Range, Alphabetic Sort"
|
|
S:'$D(HBHCFLG) HBHCHDR="W HBHCTYP_"" Date"",?19,""Patient Name"",?60,""Last Four"",?82,""ICD9 Code"",?100,""Diagnosis Text"""
|
|
S:$D(HBHCFLG) HBHCHDR="W ""Patient Name"",?38,HBHCTYP_"" Date"",?60,""Last Four"",?82,""ICD9 Code"",?100,""Diagnosis Text"""
|
|
S HBHCCOLM=(132-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
|
|
D TODAY^HBHCUTL
|
|
LOOP ; Loop thru ^HBHC(631) "AD" (admission date) or "AC" (discharge date) cross-ref to build report
|
|
S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCDATE=X
|
|
F S HBHCDATE=$O(^HBHC(631,HBHCXREF,HBHCDATE)) Q:(HBHCDATE="")!(HBHCDATE>HBHCEND1) S HBHCDFN="" F S HBHCDFN=$O(^HBHC(631,HBHCXREF,HBHCDATE,HBHCDFN)) Q:HBHCDFN="" S HBHCNOD0=^HBHC(631,HBHCDFN,0) D:$P(HBHCNOD0,U,15)=1 PROCESS
|
|
D:IO'=IO(0)!($D(IO("S"))) HDR132^HBHCUTL
|
|
I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDR132^HBHCUTL
|
|
W:'$D(^TMP("HBHC",$J)) !!,"No "_HBHCTYPS_" found for Date Range selected."
|
|
I $D(^TMP("HBHC",$J)) D PRTLOOP W !!,HBHCZ,!,"Total "_HBHCTYPS_": ",HBHCTOT,!,HBHCZ
|
|
D END132^HBHCUTL1
|
|
EXIT ; Exit module
|
|
D ^%ZISC
|
|
K DIR,DIRUT,HBHCBEG1,HBHCBEG2,HBHCCOLM,HBHCCC,HBHCDATE,HBHCDFN,HBHCDPT0,HBHCDT,HBHCDXPC,HBHCEND1,HBHCEND2,HBHCFLG,HBHCHDR,HBHCHEAD,HBHCICD0,HBHCNAME,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCTMP,HBHCTOT,HBHCTYP,HBHCTYPS,HBHCXREF,HBHCY,HBHCZ
|
|
K X,X1,X2,Y,^TMP("HBHC",$J)
|
|
Q
|
|
PROCESS ; Process record & create ^TMP("HBHC",$J global
|
|
S HBHCDPT0=^DPT($P(HBHCNOD0,U),0),HBHCICD0=$S($P(HBHCNOD0,U,HBHCDXPC)]"":^ICD9($P(HBHCNOD0,U,HBHCDXPC),0),1:"")
|
|
S:'$D(HBHCFLG) ^TMP("HBHC",$J,HBHCDATE,$P(HBHCDPT0,U))=$E($P(HBHCDPT0,U,9),6,9)_U_$P(HBHCICD0,U)_U_$P(HBHCICD0,U,3)
|
|
S:$D(HBHCFLG) ^TMP("HBHC",$J,$P(HBHCDPT0,U),HBHCDATE)=$E($P(HBHCDPT0,U,9),6,9)_U_$P(HBHCICD0,U)_U_$P(HBHCICD0,U,3)
|
|
Q
|
|
PRTLOOP ; Print loop
|
|
S HBHCTOT=0
|
|
I '$D(HBHCFLG) S HBHCDT="" F S HBHCDT=$O(^TMP("HBHC",$J,HBHCDT)) Q:HBHCDT="" S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCDT,HBHCNAME)) Q:HBHCNAME="" D PRT
|
|
I $D(HBHCFLG) S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCNAME)) Q:HBHCNAME="" S HBHCDT="" F S HBHCDT=$O(^TMP("HBHC",$J,HBHCNAME,HBHCDT)) Q:HBHCDT="" D PRT
|
|
Q
|
|
PRT ; Print report
|
|
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDR132^HBHCUTL
|
|
S HBHCTOT=HBHCTOT+1
|
|
S:'$D(HBHCFLG) HBHCTMP=^TMP("HBHC",$J,HBHCDT,HBHCNAME)
|
|
S:$D(HBHCFLG) HBHCTMP=^TMP("HBHC",$J,HBHCNAME,HBHCDT)
|
|
W:'$D(HBHCFLG) !,$E(HBHCDT,4,5)_"-"_$E(HBHCDT,6,7)_"-"_$E(HBHCDT,2,3),?19,HBHCNAME,?60,$P(HBHCTMP,U),?82,$P(HBHCTMP,U,2),?100,$P(HBHCTMP,U,3),!,HBHCY
|
|
W:$D(HBHCFLG) !,HBHCNAME,?38,$E(HBHCDT,4,5)_"-"_$E(HBHCDT,6,7)_"-"_$E(HBHCDT,2,3),?60,$P(HBHCTMP,U),?82,$P(HBHCTMP,U,2),?100,$P(HBHCTMP,U,3),!,HBHCY
|
|
Q
|