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 Dec 13, 2024@01:58:53 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
