- HBHCWORK ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) worksheet, Entry points: BLANK & EN ; 7/20/07
- ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
- BLANK ; Blank worksheet entry point; HBHCNOD0="" & HBHCMFHP="-1" are dummy values
- S HBHCBLNK="Blank",HBHCNOD0="",HBHCMFHP="-1"
- EN ; Entry point
- D MFHS^HBHCUTL3
- ; HBHCMFHS variable set in MFHS^HBHCUTL3
- G:$D(DIRUT)!('$D(HBHCMFHS)) EXIT
- I '$D(HBHCBLNK) K DIC S DIC="^HBHC(633.2,",DIC(0)="AEMQZ" D ^DIC S HBHCMFHP=+Y G:Y=-1 EXIT S HBHCNOD0=$G(^HBHC(633.2,HBHCMFHP,0))
- S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="DQ^HBHCWORK",ZTDESC="HBPC MFH Worksheet",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
- DQ ; De-queue
- U IO
- S $P(HBHCY12,"_",13)="",$P(HBHCY20,"_",21)="",$P(HBHCY30,"_",31)="",$P(HBHCY40,"_",41)="",$P(HBHCY50,"_",51)="",$P(HBHCY65,"_",66)="",HBHCPAGE=0
- I $D(HBHCBLNK) S HBHCHEAD="Medical Foster Home (MFH) Blank Worksheet",HBHCHDR="W ?26,""MFH Name:"""
- I '$D(HBHCBLNK) S HBHCHEAD="Medical Foster Home (MFH) Worksheet",HBHCHDR="W ?26,""MFH Name: ""_$P(HBHCNOD0,U)"
- 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
- D PROCESS
- D ENDRPT^HBHCUTL1
- EXIT ; Exit module
- D ^%ZISC
- K DIC,HBHCBLNK,HBHCCC,HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCI,HBHCJ,HBHCMFHP,HBHCMFHS,HBHCNOD0,HBHCNODE,HBHCPAGE,HBHCPRV,HBHCTDY,HBHCY12,HBHCY20,HBHCY30,HBHCY40,HBHCY50,HBHCY65,HBHCZ,X,Y
- Q
- PROCESS ; Process MFH demographic, inspection, & training data
- W !!,"Address:",?15,$S($P(HBHCNOD0,U,8)]"":$P(HBHCNOD0,U,8),1:HBHCY65)
- W !!,"City:",?15,$S($P(HBHCNOD0,U,9)]"":$P(HBHCNOD0,U,9),1:HBHCY65)
- W !!,"State Code:",?15,$S($P(HBHCNOD0,U,10)]"":$P($G(^DIC(5,$P(^HBHC(631.8,$P(HBHCNOD0,U,10),0),U),0)),U),1:HBHCY65)
- W !!,"County Code:",?15,$S($P(HBHCNOD0,U,15)]"":$P($G(^DIC(5,$P(^HBHC(631.8,$P(HBHCNOD0,U,10),0),U),1,$P(HBHCNOD0,U,15),0)),U)_" ("_$P($G(^DIC(5,$P(^HBHC(631.8,$P(HBHCNOD0,U,10),0),U),1,$P(HBHCNOD0,U,15),0)),U,3)_")",1:HBHCY65)
- W !!,"ZIP Code:",?15,$S($P(HBHCNOD0,U,11)]"":$P(HBHCNOD0,U,11),1:HBHCY65)
- W !!,"Phone Number:",?15,$S($P(HBHCNOD0,U,14)]"":$P(HBHCNOD0,U,14),1:HBHCY65)
- W !!,"Opened Date:" S:$P(HBHCNOD0,U,2)]"" Y=$P(HBHCNOD0,U,2) D DD^%DT W ?30,$S($P(HBHCNOD0,U,2)]"":Y,1:HBHCY50)
- S:$P(HBHCNOD0,U,16)]"" Y=$P(HBHCNOD0,U,16) D DD^%DT
- W !!,"Primary Caregiver Name:",?30,$S($P(HBHCNOD0,U,3)]"":$P(HBHCNOD0,U,3),1:HBHCY50)
- W !!,"Caregiver Date of Birth:",?30,$S($P(HBHCNOD0,U,16)]"":Y,1:HBHCY50)
- W !!,"Maximum Patients:",?20,$S($P(HBHCNOD0,U,4)]"":$P(HBHCNOD0,U,4),1:" 1 2 3"),?34,"Bedbound Patient Maximum:",?62,$S($P(HBHCNOD0,U,5)]"":$P(HBHCNOD0,U,5),1:" 0 1 2")
- W !!,"License Required:",?20,$S($P(HBHCNOD0,U,12)="Y":"Yes",$P(HBHCNOD0,U,12)="N":"No",1:" Yes No"),?34,"License Expiration Date:" S:$P(HBHCNOD0,U,13)]"" Y=$P(HBHCNOD0,U,13) D DD^%DT W ?60,$S($P(HBHCNOD0,U,13)]"":Y,1:HBHCY20)
- W !!,"Closure Date:" S:$P(HBHCNOD0,U,6)]"" Y=$P(HBHCNOD0,U,6) D DD^%DT W ?16,$S($P(HBHCNOD0,U,6)]"":Y,1:HBHCY30),?50,"Voluntary Closure:",?70,$S($P(HBHCNOD0,U,7)="Y":"Yes",$P(HBHCNOD0,U,7)="N":"No",1:" Yes No")
- INSPECT ; Process inspection data
- W !
- F HBHCI=1:1:4 D WRITE D:$D(^HBHC(633.2,HBHCMFHP,HBHCI)) LOOP
- TRAIN ; Process training data
- Q:$D(HBHCBLNK)
- W !
- F HBHCI=5:1:11 D WRITE2 D:$D(^HBHC(633.2,HBHCMFHP,HBHCI)) LOOP
- Q
- WRITE ; Write Inspection headers
- I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10) W:HBHCPAGE>0 @IOF D HDRPAGE^HBHCUTL
- W !! W:HBHCI=1 "Nurse" W:HBHCI=2 "Social Work" W:HBHCI=3 "Dietitian" W:HBHCI=4 "Fire/Safety" W " Inspection:",!!?3,"Date:",?10,HBHCY20,?33,"Name:",?40,HBHCY40 W:'$D(HBHCBLNK) !,?10,"Previous Inspection(s):"
- Q
- WRITE2 ; Write training headers
- I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12) W:HBHCPAGE>0 @IOF D HDRPAGE^HBHCUTL
- W !! W:HBHCI=5 "Home Operation" W:HBHCI=6 "Fire/Safety" W:HBHCI=7 "Medication Management" W:HBHCI=8 "Personal Care" W:HBHCI=9 "Infection Control" W:HBHCI=10 "End of Life Issues" W:HBHCI=11 "Other"
- W " Training Date:",?40,HBHCY40 W:HBHCI=11 !!,?32,"Topic:",?40,HBHCY40 W !?3,"Previous Training Date(s):"
- Q
- LOOP ; Write previous Inspection & Training data
- S HBHCJ=0
- F S HBHCJ=$O(^HBHC(633.2,HBHCMFHP,HBHCI,HBHCJ)) Q:HBHCJ'>0 S HBHCNODE=$G(^HBHC(633.2,HBHCMFHP,HBHCI,HBHCJ,0)) S Y=$P(HBHCNODE,U) D DD^%DT D:HBHCI<5 NAME W:HBHCI<5 !?13,Y,?43,"Name: ",$S(HBHCPRV]"":HBHCPRV,1:"") W:HBHCI>4 !?6,Y D TOPIC
- Q
- TOPIC ; Write Other Training Topic, if exists
- W:HBHCI=11 ?40,"Topic: ",$P(HBHCNODE,U,2)
- Q
- NAME ; Obtain Provider Name from VA(200 file
- N Y
- K DA,DIC,DR,^UTILITY("DIQ1",$J)
- S DIC=200,DR=.01,DA=$P(HBHCNODE,U,2) D EN^DIQ1
- S HBHCPRV=^UTILITY("DIQ1",$J,200,DA,DR)
- K DA,DIC,DR,^UTILITY("DIQ1",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCWORK 4788 printed Feb 18, 2025@23:25:17 Page 2
- HBHCWORK ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) worksheet, Entry points: BLANK & EN ; 7/20/07
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
- BLANK ; Blank worksheet entry point; HBHCNOD0="" & HBHCMFHP="-1" are dummy values
- +1 SET HBHCBLNK="Blank"
- SET HBHCNOD0=""
- SET HBHCMFHP="-1"
- EN ; Entry point
- +1 DO MFHS^HBHCUTL3
- +2 ; HBHCMFHS variable set in MFHS^HBHCUTL3
- +3 if $DATA(DIRUT)!('$DATA(HBHCMFHS))
- GOTO EXIT
- +4 IF '$DATA(HBHCBLNK)
- KILL DIC
- SET DIC="^HBHC(633.2,"
- SET DIC(0)="AEMQZ"
- DO ^DIC
- SET HBHCMFHP=+Y
- if Y=-1
- GOTO EXIT
- SET HBHCNOD0=$GET(^HBHC(633.2,HBHCMFHP,0))
- +5 SET %ZIS="Q"
- SET HBHCCC=0
- KILL IOP,ZTIO,ZTSAVE
- DO ^%ZIS
- if POP
- GOTO EXIT
- +6 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^HBHCWORK"
- SET ZTDESC="HBPC MFH Worksheet"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ; De-queue
- +1 USE IO
- +2 SET $PIECE(HBHCY12,"_",13)=""
- SET $PIECE(HBHCY20,"_",21)=""
- SET $PIECE(HBHCY30,"_",31)=""
- SET $PIECE(HBHCY40,"_",41)=""
- SET $PIECE(HBHCY50,"_",51)=""
- SET $PIECE(HBHCY65,"_",66)=""
- SET HBHCPAGE=0
- +3 IF $DATA(HBHCBLNK)
- SET HBHCHEAD="Medical Foster Home (MFH) Blank Worksheet"
- SET HBHCHDR="W ?26,""MFH Name:"""
- +4 IF '$DATA(HBHCBLNK)
- SET HBHCHEAD="Medical Foster Home (MFH) Worksheet"
- SET HBHCHDR="W ?26,""MFH Name: ""_$P(HBHCNOD0,U)"
- +5 SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
- if HBHCCOLM'>0
- SET HBHCCOLM=1
- +6 DO TODAY^HBHCUTL
- 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
- +8 DO PROCESS
- +9 DO ENDRPT^HBHCUTL1
- EXIT ; Exit module
- +1 DO ^%ZISC
- +2 KILL DIC,HBHCBLNK,HBHCCC,HBHCCOLM,HBHCHDR,HBHCHEAD,HBHCI,HBHCJ,HBHCMFHP,HBHCMFHS,HBHCNOD0,HBHCNODE,HBHCPAGE,HBHCPRV,HBHCTDY,HBHCY12,HBHCY20,HBHCY30,HBHCY40,HBHCY50,HBHCY65,HBHCZ,X,Y
- +3 QUIT
- PROCESS ; Process MFH demographic, inspection, & training data
- +1 WRITE !!,"Address:",?15,$SELECT($PIECE(HBHCNOD0,U,8)]"":$PIECE(HBHCNOD0,U,8),1:HBHCY65)
- +2 WRITE !!,"City:",?15,$SELECT($PIECE(HBHCNOD0,U,9)]"":$PIECE(HBHCNOD0,U,9),1:HBHCY65)
- +3 WRITE !!,"State Code:",?15,$SELECT($PIECE(HBHCNOD0,U,10)]"":$PIECE($GET(^DIC(5,$PIECE(^HBHC(631.8,$PIECE(HBHCNOD0,U,10),0),U),0)),U),1:HBHCY65)
- +4 WRITE !!,"County Code:",?15,$SELECT($PIECE(HBHCNOD0,U,15)]"":$PIECE($GET(^DIC(5,$PIECE(^HBHC(631.8,$PIECE(HBHCNOD0,U,10),0),U),1,...
- ... $PIECE(HBHCNOD0,U,15),0)),U)_" ("_$PIECE($GET(^DIC(5,$PIECE(^HBHC(631.8,$PIECE(HBHCNOD0,U,10),0),U),1,$PIECE(HBHCNOD0,U,15),0)),U,3)_")",1:HBHCY65)
- +5 WRITE !!,"ZIP Code:",?15,$SELECT($PIECE(HBHCNOD0,U,11)]"":$PIECE(HBHCNOD0,U,11),1:HBHCY65)
- +6 WRITE !!,"Phone Number:",?15,$SELECT($PIECE(HBHCNOD0,U,14)]"":$PIECE(HBHCNOD0,U,14),1:HBHCY65)
- +7 WRITE !!,"Opened Date:"
- if $PIECE(HBHCNOD0,U,2)]""
- SET Y=$PIECE(HBHCNOD0,U,2)
- DO DD^%DT
- WRITE ?30,$SELECT($PIECE(HBHCNOD0,U,2)]"":Y,1:HBHCY50)
- +8 if $PIECE(HBHCNOD0,U,16)]""
- SET Y=$PIECE(HBHCNOD0,U,16)
- DO DD^%DT
- +9 WRITE !!,"Primary Caregiver Name:",?30,$SELECT($PIECE(HBHCNOD0,U,3)]"":$PIECE(HBHCNOD0,U,3),1:HBHCY50)
- +10 WRITE !!,"Caregiver Date of Birth:",?30,$SELECT($PIECE(HBHCNOD0,U,16)]"":Y,1:HBHCY50)
- +11 WRITE !!,"Maximum Patients:",?20,$SELECT($PIECE(HBHCNOD0,U,4)]"":$PIECE(HBHCNOD0,U,4),1:" 1 2 3"),?34,"Bedbound Patient Maximum:",?62,$SELECT($PIECE(HBHCNOD0,U,5)]"":$PIECE(HBHCNOD0,U,5),1:" 0 1 2")
- +12 WRITE !!,"License Required:",?20,$SELECT($PIECE(HBHCNOD0,U,12)="Y":"Yes",$PIECE(HBHCNOD0,U,12)="N":"No",1:" Yes No"),?34,"License Expiration Date:"
- if $PIECE(HBHCNOD0,U,13)]""
- SET Y=$PIECE(HBHCNOD0,U,13)
- DO DD^%DT
- WRITE ?60,$SELECT($PIECE(HBHCNOD0,U,13)]"":Y,1:HBHCY20)
- +13 WRITE !!,"Closure Date:"
- if $PIECE(HBHCNOD0,U,6)]""
- SET Y=$PIECE(HBHCNOD0,U,6)
- DO DD^%DT
- WRITE ?16,$SELECT($PIECE(HBHCNOD0,U,6)]"":Y,1:HBHCY30),?50,"Voluntary Closure:",?70,$SELECT($PIECE(HBHCNOD0,U,7)="Y":"Yes",$PIECE(HBHCNOD0,U,7)="N":"No",1:" Yes No")
- INSPECT ; Process inspection data
- +1 WRITE !
- +2 FOR HBHCI=1:1:4
- DO WRITE
- if $DATA(^HBHC(633.2,HBHCMFHP,HBHCI))
- DO LOOP
- TRAIN ; Process training data
- +1 if $DATA(HBHCBLNK)
- QUIT
- +2 WRITE !
- +3 FOR HBHCI=5:1:11
- DO WRITE2
- if $DATA(^HBHC(633.2,HBHCMFHP,HBHCI))
- DO LOOP
- +4 QUIT
- WRITE ; Write Inspection headers
- +1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<10)
- if HBHCPAGE>0
- WRITE @IOF
- DO HDRPAGE^HBHCUTL
- +2 WRITE !!
- if HBHCI=1
- WRITE "Nurse"
- if HBHCI=2
- WRITE "Social Work"
- if HBHCI=3
- WRITE "Dietitian"
- if HBHCI=4
- WRITE "Fire/Safety"
- WRITE " Inspection:",!!?3,"Date:",?10,HBHCY20,?33,"Name:",?40,HBHCY40
- if '$DATA(HBHCBLNK)
- WRITE !,?10,"Previous Inspection(s):"
- +3 QUIT
- WRITE2 ; Write training headers
- +1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12)
- if HBHCPAGE>0
- WRITE @IOF
- DO HDRPAGE^HBHCUTL
- +2 WRITE !!
- if HBHCI=5
- WRITE "Home Operation"
- if HBHCI=6
- WRITE "Fire/Safety"
- if HBHCI=7
- WRITE "Medication Management"
- if HBHCI=8
- WRITE "Personal Care"
- if HBHCI=9
- WRITE "Infection Control"
- if HBHCI=10
- WRITE "End of Life Issues"
- if HBHCI=11
- WRITE "Other"
- +3 WRITE " Training Date:",?40,HBHCY40
- if HBHCI=11
- WRITE !!,?32,"Topic:",?40,HBHCY40
- WRITE !?3,"Previous Training Date(s):"
- +4 QUIT
- LOOP ; Write previous Inspection & Training data
- +1 SET HBHCJ=0
- +2 FOR
- SET HBHCJ=$ORDER(^HBHC(633.2,HBHCMFHP,HBHCI,HBHCJ))
- if HBHCJ'>0
- QUIT
- SET HBHCNODE=$GET(^HBHC(633.2,HBHCMFHP,HBHCI,HBHCJ,0))
- SET Y=$PIECE(HBHCNODE,U)
- DO DD^%DT
- if HBHCI<5
- DO NAME
- if HBHCI<5
- WRITE !?13,Y,?43,"Name: ",$SELECT(HBHCPRV]"":HBHCPRV,1:"")
- if HBHCI>4
- WRITE !?6,Y
- DO TOPIC
- +3 QUIT
- TOPIC ; Write Other Training Topic, if exists
- +1 if HBHCI=11
- WRITE ?40,"Topic: ",$PIECE(HBHCNODE,U,2)
- +2 QUIT
- NAME ; Obtain Provider Name from VA(200 file
- +1 NEW Y
- +2 KILL DA,DIC,DR,^UTILITY("DIQ1",$JOB)
- +3 SET DIC=200
- SET DR=.01
- SET DA=$PIECE(HBHCNODE,U,2)
- DO EN^DIQ1
- +4 SET HBHCPRV=^UTILITY("DIQ1",$JOB,200,DA,DR)
- +5 KILL DA,DIC,DR,^UTILITY("DIQ1",$JOB)
- +6 QUIT