HBHCR15A ;LR VAMC(IRMS)/MJT-HBHC rpt using file 634.6, user selects date/forms from last 12 transmit batchs, fields: form#, pat name, last 4, form date, + action on form 3, prov #, & prov name on visits, & Adm or D/C on form 6 ;2/5/98
;;1.0;HOSPITAL BASED HOME CARE;**6,8,9,13,15,24**;NOV 01, 1993;Build 201
; Medical Foster Home (MFH) recs are only included if MFH Site; sorted alphabetically by MFH Name & includes Form # & Opened Date
; Calls HBHCR15B
; Report can also be generated by Transmit File option [HBHCXMT] if default printer is defined in sys param (631.9). If no printer defined, no report. User selects forms to include, date is transmit date
; HBHCXMT calls entry points: PROMPT2^HBHCR15B & DQ^HBHCR15A
I '$D(^HBHC(634.6,"C")) W $C(7),!,"No transmit history data on file." H 3 Q
I $P(^HBHC(631.9,1,0),U,6)]"" W $C(7),!,"Transmission in progress; history data being updated. Please try again later." H 3 Q
D PROMPT1^HBHCR15B
G:$D(DIRUT) EXIT
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="DQ^HBHCR15A",ZTDESC="HBPC Transmit History Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
DQ ; De-queue
U IO
S (HBHCPAGE,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6,HBHCCNT7)=0,$P(HBHCY,"-",81)="",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
S HBHCHDR=$S(HBHCDIR="S":"W ?36,""Summary""",1:"W ?31,""Last"",!?4,""#"",?8,""Patient Name"",?31,""Four"",?38,""Date""")
LOOP ; Loop thru HBHC(634.6,"C" (transmit date) cross-ref to build report
S HBHCIEN=0 F S HBHCIEN=$O(^HBHC(634.6,"C",HBHCXMDT,HBHCIEN)) Q:HBHCIEN'>0 S HBHCINFO=$P(^HBHC(634.6,HBHCIEN,0),U) D PROCESS
D END^HBHCR15B
EXIT ; Exit module
D ^%ZISC
K DIR,DIRUT,HBHC,HBHCACTN,HBHCCC,HBHCCNT,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6,HBHCCNT7,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDIR,HBHCDSDT,HBHCFLG,HBHCFORM,HBHCHEAD,HBHCHDR,HBHCI,HBHCIEN,HBHCINFO,HBHCIOP,HBHCLST4,HBHCMFHS
K HBHCNAME,HBHCPAGE,HBHCPIEN,HBHCPRV,HBHCPRVN,HBHCTDY,HBHCTIME,HBHCTYPE,HBHCXMDT,HBHCY,HBHCY0,HBHCZ,X,Y,TMP,^TMP("HBHC",$J),^TMP($J)
Q
PROCESS ; Process records
S (HBHCACTN,HBHCPRV)="Z",(HBHCPRVN,HBHCTIME,HBHCTYPE)=""
D:($E(HBHCINFO)=3)&((HBHCDIR=3)!(HBHCDIR="A")!(HBHCDIR="S")) FORM3
D:($E(HBHCINFO)=4)&((HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S")) FORM4
D:($E(HBHCINFO)=5)&((HBHCDIR=5)!(HBHCDIR="A")!(HBHCDIR="S")) FORM5
D:($E(HBHCINFO)=6)&((HBHCDIR=6)!(HBHCDIR="A")!(HBHCDIR="S")) FORM6
I $D(HBHCMFHS) D:($E(HBHCINFO)=7)&((HBHCDIR=7)!(HBHCDIR="A")!(HBHCDIR="S")) FORM7
Q
FORM3 ; Process Form 3 (Admission) records
S HBHCDATE=$E(HBHCINFO,18,25)
S:$E(HBHCINFO,55)=1 HBHCCNTA=HBHCCNTA+1,HBHCACTN="Admit"
S:$E(HBHCINFO,55)=2 HBHCCNTR=HBHCCNTR+1,HBHCACTN="Reject"
Q:HBHCDIR="S"
S HBHCFORM="A"
S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
S HBHCLST4=$E(HBHCINFO,14,17)
D SET
Q
FORM4 ; Process Form 4 (Visit) records
S HBHCCNT4=HBHCCNT4+1
S HBHCFORM="V"
S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
S HBHCLST4=$E(HBHCINFO,14,17)
S HBHCDATE=$E(HBHCINFO,18,25)
S HBHCTIME=$E(HBHCINFO,26,27)_":"_$E(HBHCINFO,28,29)
S HBHCPRVN=+$E(HBHCINFO,30,33)
S (HBHCFLG,HBHCPIEN)=0 F S HBHCPIEN=$O(^HBHC(631.4,"B",HBHCPRVN,HBHCPIEN)) Q:HBHCPIEN'>0 D NAME
D SET
Q
NAME ; Form 4 Name
I HBHCFLG=1 S HBHCPRV="** Duplicate Prov #" Q
S HBHCFLG=1,HBHCPRV=$E($P(^VA(200,$P(^HBHC(631.4,HBHCPIEN,0),U,2),0),U),1,20)
Q
FORM5 ; Process Form 5 (Discharge) records
S HBHCCNT5=HBHCCNT5+1
Q:HBHCDIR="S"
S HBHCFORM="D"
S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
S HBHCLST4=$E(HBHCINFO,14,17)
S HBHCDATE=$E(HBHCINFO,18,25)
D SET
Q
FORM6 ; Process Form 6 (Correction) records
S HBHCCNT6=HBHCCNT6+1
Q:HBHCDIR="S"
S HBHCFORM=6
S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
S HBHCLST4=$E(HBHCINFO,14,17)
S HBHCDSDT=$TR($E(HBHCINFO,56,63)," ","")
; Use Discharge date if exists, otherwise use Admission date
S HBHCDATE=$S(HBHCDSDT]"":HBHCDSDT,1:$E(HBHCINFO,18,25))
S HBHCTYPE=$S(HBHCDSDT]"":"Discharge",1:"Evaluation/Admission")
D SET
Q
FORM7 ; Process Form 7 Medical Foster Home (MFH) records
S HBHCCNT7=HBHCCNT7+1
Q:HBHCDIR="S"
S HBHCFORM="Z"
S HBHCNAME=$E(HBHCINFO,9,38)
S HBHCDATE=$E(HBHCINFO,84,91)
S HBHCLST4=9999
D SET
Q
SET ; Set TMP node
; By design, records are processed/printed in the following order by form number: 6, 3 (A), 5 (D), 4 (V), & 7 (Z)
S:HBHCDIR'="S" ^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)=HBHCPRVN_U_HBHCTYPE_U_HBHCTIME
S:HBHCFORM="V" ^TMP($J,HBHCNAME,HBHCLST4,HBHCDATE_HBHCTIME,HBHCPRV)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCR15A 4859 printed Nov 22, 2024@17:08:20 Page 2
HBHCR15A ;LR VAMC(IRMS)/MJT-HBHC rpt using file 634.6, user selects date/forms from last 12 transmit batchs, fields: form#, pat name, last 4, form date, + action on form 3, prov #, & prov name on visits, & Adm or D/C on form 6 ;2/5/98
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,9,13,15,24**;NOV 01, 1993;Build 201
+2 ; Medical Foster Home (MFH) recs are only included if MFH Site; sorted alphabetically by MFH Name & includes Form # & Opened Date
+3 ; Calls HBHCR15B
+4 ; Report can also be generated by Transmit File option [HBHCXMT] if default printer is defined in sys param (631.9). If no printer defined, no report. User selects forms to include, date is transmit date
+5 ; HBHCXMT calls entry points: PROMPT2^HBHCR15B & DQ^HBHCR15A
+6 IF '$DATA(^HBHC(634.6,"C"))
WRITE $CHAR(7),!,"No transmit history data on file."
HANG 3
QUIT
+7 IF $PIECE(^HBHC(631.9,1,0),U,6)]""
WRITE $CHAR(7),!,"Transmission in progress; history data being updated. Please try again later."
HANG 3
QUIT
+8 DO PROMPT1^HBHCR15B
+9 if $DATA(DIRUT)
GOTO EXIT
+10 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+11 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCR15A"
SET ZTDESC="HBPC Transmit History Report"
SET ZTSAVE("HBHC*")=""
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 SET (HBHCPAGE,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6,HBHCCNT7)=0
SET $PIECE(HBHCY,"-",81)=""
SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
+3 SET HBHCHDR=$SELECT(HBHCDIR="S":"W ?36,""Summary""",1:"W ?31,""Last"",!?4,""#"",?8,""Patient Name"",?31,""Four"",?38,""Date""")
LOOP ; Loop thru HBHC(634.6,"C" (transmit date) cross-ref to build report
+1 SET HBHCIEN=0
FOR
SET HBHCIEN=$ORDER(^HBHC(634.6,"C",HBHCXMDT,HBHCIEN))
if HBHCIEN'>0
QUIT
SET HBHCINFO=$PIECE(^HBHC(634.6,HBHCIEN,0),U)
DO PROCESS
+2 DO END^HBHCR15B
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL DIR,DIRUT,HBHC,HBHCACTN,HBHCCC,HBHCCNT,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6,HBHCCNT7,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDIR,HBHCDSDT,HBHCFLG,HBHCFORM,HBHCHEAD,HBHCHDR,HBHCI,HBHCIEN,HBHCINFO,HBHCIOP,HBHCLST4,HBHCMFHS
+3 KILL HBHCNAME,HBHCPAGE,HBHCPIEN,HBHCPRV,HBHCPRVN,HBHCTDY,HBHCTIME,HBHCTYPE,HBHCXMDT,HBHCY,HBHCY0,HBHCZ,X,Y,TMP,^TMP("HBHC",$JOB),^TMP($JOB)
+4 QUIT
PROCESS ; Process records
+1 SET (HBHCACTN,HBHCPRV)="Z"
SET (HBHCPRVN,HBHCTIME,HBHCTYPE)=""
+2 if ($EXTRACT(HBHCINFO)=3)&((HBHCDIR=3)!(HBHCDIR="A")!(HBHCDIR="S"))
DO FORM3
+3 if ($EXTRACT(HBHCINFO)=4)&((HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S"))
DO FORM4
+4 if ($EXTRACT(HBHCINFO)=5)&((HBHCDIR=5)!(HBHCDIR="A")!(HBHCDIR="S"))
DO FORM5
+5 if ($EXTRACT(HBHCINFO)=6)&((HBHCDIR=6)!(HBHCDIR="A")!(HBHCDIR="S"))
DO FORM6
+6 IF $DATA(HBHCMFHS)
if ($EXTRACT(HBHCINFO)=7)&((HBHCDIR=7)!(HBHCDIR="A")!(HBHCDIR="S"))
DO FORM7
+7 QUIT
FORM3 ; Process Form 3 (Admission) records
+1 SET HBHCDATE=$EXTRACT(HBHCINFO,18,25)
+2 if $EXTRACT(HBHCINFO,55)=1
SET HBHCCNTA=HBHCCNTA+1
SET HBHCACTN="Admit"
+3 if $EXTRACT(HBHCINFO,55)=2
SET HBHCCNTR=HBHCCNTR+1
SET HBHCACTN="Reject"
+4 if HBHCDIR="S"
QUIT
+5 SET HBHCFORM="A"
+6 SET HBHCDFN=""
FOR
SET HBHCDFN=$ORDER(^DPT("SSN",$EXTRACT(HBHCINFO,9,17),HBHCDFN))
if HBHCDFN=""
QUIT
SET HBHCNAME=$EXTRACT($PIECE(^DPT(HBHCDFN,0),U),1,20)
+7 SET HBHCLST4=$EXTRACT(HBHCINFO,14,17)
+8 DO SET
+9 QUIT
FORM4 ; Process Form 4 (Visit) records
+1 SET HBHCCNT4=HBHCCNT4+1
+2 SET HBHCFORM="V"
+3 SET HBHCDFN=""
FOR
SET HBHCDFN=$ORDER(^DPT("SSN",$EXTRACT(HBHCINFO,9,17),HBHCDFN))
if HBHCDFN=""
QUIT
SET HBHCNAME=$EXTRACT($PIECE(^DPT(HBHCDFN,0),U),1,20)
+4 SET HBHCLST4=$EXTRACT(HBHCINFO,14,17)
+5 SET HBHCDATE=$EXTRACT(HBHCINFO,18,25)
+6 SET HBHCTIME=$EXTRACT(HBHCINFO,26,27)_":"_$EXTRACT(HBHCINFO,28,29)
+7 SET HBHCPRVN=+$EXTRACT(HBHCINFO,30,33)
+8 SET (HBHCFLG,HBHCPIEN)=0
FOR
SET HBHCPIEN=$ORDER(^HBHC(631.4,"B",HBHCPRVN,HBHCPIEN))
if HBHCPIEN'>0
QUIT
DO NAME
+9 DO SET
+10 QUIT
NAME ; Form 4 Name
+1 IF HBHCFLG=1
SET HBHCPRV="** Duplicate Prov #"
QUIT
+2 SET HBHCFLG=1
SET HBHCPRV=$EXTRACT($PIECE(^VA(200,$PIECE(^HBHC(631.4,HBHCPIEN,0),U,2),0),U),1,20)
+3 QUIT
FORM5 ; Process Form 5 (Discharge) records
+1 SET HBHCCNT5=HBHCCNT5+1
+2 if HBHCDIR="S"
QUIT
+3 SET HBHCFORM="D"
+4 SET HBHCDFN=""
FOR
SET HBHCDFN=$ORDER(^DPT("SSN",$EXTRACT(HBHCINFO,9,17),HBHCDFN))
if HBHCDFN=""
QUIT
SET HBHCNAME=$EXTRACT($PIECE(^DPT(HBHCDFN,0),U),1,20)
+5 SET HBHCLST4=$EXTRACT(HBHCINFO,14,17)
+6 SET HBHCDATE=$EXTRACT(HBHCINFO,18,25)
+7 DO SET
+8 QUIT
FORM6 ; Process Form 6 (Correction) records
+1 SET HBHCCNT6=HBHCCNT6+1
+2 if HBHCDIR="S"
QUIT
+3 SET HBHCFORM=6
+4 SET HBHCDFN=""
FOR
SET HBHCDFN=$ORDER(^DPT("SSN",$EXTRACT(HBHCINFO,9,17),HBHCDFN))
if HBHCDFN=""
QUIT
SET HBHCNAME=$EXTRACT($PIECE(^DPT(HBHCDFN,0),U),1,20)
+5 SET HBHCLST4=$EXTRACT(HBHCINFO,14,17)
+6 SET HBHCDSDT=$TRANSLATE($EXTRACT(HBHCINFO,56,63)," ","")
+7 ; Use Discharge date if exists, otherwise use Admission date
+8 SET HBHCDATE=$SELECT(HBHCDSDT]"":HBHCDSDT,1:$EXTRACT(HBHCINFO,18,25))
+9 SET HBHCTYPE=$SELECT(HBHCDSDT]"":"Discharge",1:"Evaluation/Admission")
+10 DO SET
+11 QUIT
FORM7 ; Process Form 7 Medical Foster Home (MFH) records
+1 SET HBHCCNT7=HBHCCNT7+1
+2 if HBHCDIR="S"
QUIT
+3 SET HBHCFORM="Z"
+4 SET HBHCNAME=$EXTRACT(HBHCINFO,9,38)
+5 SET HBHCDATE=$EXTRACT(HBHCINFO,84,91)
+6 SET HBHCLST4=9999
+7 DO SET
+8 QUIT
SET ; Set TMP node
+1 ; By design, records are processed/printed in the following order by form number: 6, 3 (A), 5 (D), 4 (V), & 7 (Z)
+2 if HBHCDIR'="S"
SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)=HBHCPRVN_U_HBHCTYPE_U_HBHCTIME
+3 if HBHCFORM="V"
SET ^TMP($JOB,HBHCNAME,HBHCLST4,HBHCDATE_HBHCTIME,HBHCPRV)=""
+4 QUIT
