HBHCRP31 ; LR VAMC(IRMS)/MJT-HBHC report on file 634.7 Form 7 Error(s)), sorted by Medical Foster Home (MFH) Name, & includes MFH file IEN, MFH Name, & Opened Date ; Mar 2008
;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
I $P(^HBHC(631.9,1,0),U,8)]"" W $C(7),!,"File Update in progress. Please try again later." H 3 Q
S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="DQ^HBHCRP31",ZTSAVE("HBHC*")="",ZTDESC="HBPC MFH Form Errors Report" D ^%ZTLOAD G EXIT
DQ ; De-queue
U IO
; Max length for HBHCHEAD = 50
S $P(HBHCY,"-",81)="",HBHCPAGE=0,HBHCHEAD="Medical Foster Home (MFH) Form Errors"
S HBHCHDR="W !,""MFH File IEN"",?17,""Medical Foster Home Name"",?59,""Opened Date"""
S HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL
D:IO'=IO(0)!($D(IO("S"))) HDRPAGE^HBHCUTL
I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDRPAGE^HBHCUTL
LOOP ; Loop thru file 634.7 "B" cross-ref
S HBHCMFHP="" F S HBHCMFHP=$O(^HBHC(634.7,"B",HBHCMFHP)) Q:HBHCMFHP="" S HBHCIEN="" F S HBHCIEN=$O(^HBHC(634.7,"B",HBHCMFHP,HBHCIEN)) Q:HBHCIEN="" D PRINT
D ENDRPT^HBHCUTL1
EXIT ; Exit module
D ^%ZISC
K HBHC,HBHCCC,HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCIEN,HBHCMFHP,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCY,HBHCZ,X,Y
Q
PRINT ; Print record
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10) W:HBHCPAGE>0 @IOF D HDRPAGE^HBHCUTL
S HBHCNOD0=$G(^HBHC(633.2,HBHCMFHP,0)),HBHC="`"_HBHCMFHP
W !,$J(HBHC,6),?17,$P(HBHCNOD0,U)
W:$P(HBHCNOD0,U,2)]"" ?59,$E($P(HBHCNOD0,U,2),4,5)_"-"_$E($P(HBHCNOD0,U,2),6,7)_"-"_$E($P(HBHCNOD0,U,2),2,3)
W !,HBHCY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP31 1601 printed Nov 22, 2024@17:08:45 Page 2
HBHCRP31 ; LR VAMC(IRMS)/MJT-HBHC report on file 634.7 Form 7 Error(s)), sorted by Medical Foster Home (MFH) Name, & includes MFH file IEN, MFH Name, & Opened Date ; Mar 2008
+1 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
+2 IF $PIECE(^HBHC(631.9,1,0),U,8)]""
WRITE $CHAR(7),!,"File Update in progress. Please try again later."
HANG 3
QUIT
+3 SET %ZIS="Q"
SET HBHCCC=0
KILL IOP,ZTIO,ZTSAVE
DO ^%ZIS
if POP
QUIT
+4 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCRP31"
SET ZTSAVE("HBHC*")=""
SET ZTDESC="HBPC MFH Form Errors Report"
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 ; Max length for HBHCHEAD = 50
+3 SET $PIECE(HBHCY,"-",81)=""
SET HBHCPAGE=0
SET HBHCHEAD="Medical Foster Home (MFH) Form Errors"
+4 SET HBHCHDR="W !,""MFH File IEN"",?17,""Medical Foster Home Name"",?59,""Opened Date"""
+5 SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
DO TODAY^HBHCUTL
+6 if IO'=IO(0)!($DATA(IO("S")))
DO HDRPAGE^HBHCUTL
+7 IF '$DATA(IO("S"))
IF (IO=IO(0))
SET HBHCCC=HBHCCC+1
DO HDRPAGE^HBHCUTL
LOOP ; Loop thru file 634.7 "B" cross-ref
+1 SET HBHCMFHP=""
FOR
SET HBHCMFHP=$ORDER(^HBHC(634.7,"B",HBHCMFHP))
if HBHCMFHP=""
QUIT
SET HBHCIEN=""
FOR
SET HBHCIEN=$ORDER(^HBHC(634.7,"B",HBHCMFHP,HBHCIEN))
if HBHCIEN=""
QUIT
DO PRINT
+2 DO ENDRPT^HBHCUTL1
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL HBHC,HBHCCC,HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCIEN,HBHCMFHP,HBHCNOD0,HBHCPAGE,HBHCTDY,HBHCY,HBHCZ,X,Y
+3 QUIT
PRINT ; Print record
+1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10)
if HBHCPAGE>0
WRITE @IOF
DO HDRPAGE^HBHCUTL
+2 SET HBHCNOD0=$GET(^HBHC(633.2,HBHCMFHP,0))
SET HBHC="`"_HBHCMFHP
+3 WRITE !,$JUSTIFY(HBHC,6),?17,$PIECE(HBHCNOD0,U)
+4 if $PIECE(HBHCNOD0,U,2)]""
WRITE ?59,$EXTRACT($PIECE(HBHCNOD0,U,2),4,5)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,2),6,7)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,2),2,3)
+5 WRITE !,HBHCY
+6 QUIT
