- 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 Feb 18, 2025@23:25 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
