- HBHCTXT2 ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) delimited text file output, user selects Inspection or Training data, includes all data on file ; Dec 2007
- ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
- EN ; Prompt for whether Inspection or Training report
- K DIR S DIR(0)="SB^I:Inspection;T:Training",DIR("A")="Include Inspection or Training data",DIR("?")="Include Inspection (I) or Training (T) data on report." D ^DIR
- G:$D(DIRUT) EXIT
- S HBHCTYP=Y
- S %ZIS="Q" K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="DQ^HBHCTXT2",ZTDESC="HBPC MFH Inspection/Training Delimited File Output",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
- DQ ; De-queue
- U IO
- S HBHCDLMT=U
- W "Medical Foster Home Name"_HBHCDLMT_"MFH Closure Date"_HBHCDLMT
- I HBHCTYP="I" W "Inspection Discipline"_HBHCDLMT_"Inspection Date"_HBHCDLMT_"Inspector Name"
- I HBHCTYP="T" W "Training Category"_HBHCDLMT_"Training Date"_HBHCDLMT_"Other Training Topic"
- LOOP ; Loop thru ^HBHC(633.2 Inspection multiples; 1 = Nurse, 2 = Social Work, 3 = Dietitian, 4 = Fire/Safety
- I HBHCTYP="I" S HBHCI=0 F S HBHCI=$O(^HBHC(633.2,HBHCI)) Q:HBHCI'>0 F HBHCJ=1:1:4 S HBHCK=0 F S HBHCK=$O(^HBHC(633.2,HBHCI,HBHCJ,HBHCK)) Q:HBHCK'>0 D SET
- LOOP2 ; Loop thru ^HBHC(633.2 Training multiples; 5 = Home Operation, 6 = Fire/Safety, 7 = Medication Management, 8 = Personal Care, 9 = Infection Control, 10 = End of Life, 11 = Other
- I HBHCTYP="T" S HBHCI=0 F S HBHCI=$O(^HBHC(633.2,HBHCI)) Q:HBHCI'>0 F HBHCJ=5:1:11 S HBHCK=0 F S HBHCK=$O(^HBHC(633.2,HBHCI,HBHCJ,HBHCK)) Q:HBHCK'>0 D SET
- EXIT ; Exit module
- D ^%ZISC
- K DIR,HBHCCLOS,HBHCDAT,HBHCDLMT,HBHCI,HBHCJ,HBHCK,HBHCNODE,HBHCPRV,HBHCTYP,X,Y
- Q
- SET ; Set ^TMP node for valid record
- ; quit if no Inspection or Training data
- Q:'$D(^HBHC(633.2,HBHCI,HBHCJ))
- ; notate if MFH closed
- S (HBHCDAT,HBHCCLOS)="" S:$P(^HBHC(633.2,HBHCI,0),U,6)]"" HBHCDAT=$P(^HBHC(633.2,HBHCI,0),U,6),HBHCCLOS=$E(HBHCDAT,4,5)_"-"_$E(HBHCDAT,6,7)_"-"_$S($E(HBHCDAT)=3:20,1:19)_$E(HBHCDAT,2,3)
- S HBHCNODE=^HBHC(633.2,HBHCI,HBHCJ,HBHCK,0)
- W !,$P(^HBHC(633.2,HBHCI,0),U)_HBHCDLMT_HBHCCLOS_HBHCDLMT
- I HBHCTYP="I" W $S(HBHCJ=1:"Nurse",HBHCJ=2:"Social Work",HBHCJ=3:"Dietitian",1:"Fire/Safety")
- I HBHCTYP="T" W $S(HBHCJ=5:"Home Operation",HBHCJ=6:"Fire/Safety",HBHCJ=7:"Medication Management",HBHCJ=8:"Personal Care",HBHCJ=9:"Infection Control",HBHCJ=10:"End of Life",1:"Other")
- W HBHCDLMT_$E($P(HBHCNODE,U),4,5)_"-"_$E($P(HBHCNODE,U),6,7)_"-"_$S($E($P(HBHCNODE,U))=3:20,1:19)_$E($P(HBHCNODE,U),2,3)
- I HBHCTYP="I" D NAME W HBHCDLMT_$S(HBHCPRV]"":HBHCPRV,1:"")
- I HBHCTYP="T" W:$P(HBHCNODE,U,2)]"" HBHCDLMT_$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[HHBHCTXT2 2886 printed Feb 18, 2025@23:25:09 Page 2
- HBHCTXT2 ; LR VAMC(IRMS)/MJT-HBHC Medical Foster Home (MFH) delimited text file output, user selects Inspection or Training data, includes all data on file ; Dec 2007
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**24**;NOV 01, 1993;Build 201
- EN ; Prompt for whether Inspection or Training report
- +1 KILL DIR
- SET DIR(0)="SB^I:Inspection;T:Training"
- SET DIR("A")="Include Inspection or Training data"
- SET DIR("?")="Include Inspection (I) or Training (T) data on report."
- DO ^DIR
- +2 if $DATA(DIRUT)
- GOTO EXIT
- +3 SET HBHCTYP=Y
- +4 SET %ZIS="Q"
- KILL IOP,ZTIO,ZTSAVE
- DO ^%ZIS
- if POP
- GOTO EXIT
- +5 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^HBHCTXT2"
- SET ZTDESC="HBPC MFH Inspection/Training Delimited File Output"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ; De-queue
- +1 USE IO
- +2 SET HBHCDLMT=U
- +3 WRITE "Medical Foster Home Name"_HBHCDLMT_"MFH Closure Date"_HBHCDLMT
- +4 IF HBHCTYP="I"
- WRITE "Inspection Discipline"_HBHCDLMT_"Inspection Date"_HBHCDLMT_"Inspector Name"
- +5 IF HBHCTYP="T"
- WRITE "Training Category"_HBHCDLMT_"Training Date"_HBHCDLMT_"Other Training Topic"
- LOOP ; Loop thru ^HBHC(633.2 Inspection multiples; 1 = Nurse, 2 = Social Work, 3 = Dietitian, 4 = Fire/Safety
- +1 IF HBHCTYP="I"
- SET HBHCI=0
- FOR
- SET HBHCI=$ORDER(^HBHC(633.2,HBHCI))
- if HBHCI'>0
- QUIT
- FOR HBHCJ=1:1:4
- SET HBHCK=0
- FOR
- SET HBHCK=$ORDER(^HBHC(633.2,HBHCI,HBHCJ,HBHCK))
- if HBHCK'>0
- QUIT
- DO SET
- LOOP2 ; Loop thru ^HBHC(633.2 Training multiples; 5 = Home Operation, 6 = Fire/Safety, 7 = Medication Management, 8 = Personal Care, 9 = Infection Control, 10 = End of Life, 11 = Other
- +1 IF HBHCTYP="T"
- SET HBHCI=0
- FOR
- SET HBHCI=$ORDER(^HBHC(633.2,HBHCI))
- if HBHCI'>0
- QUIT
- FOR HBHCJ=5:1:11
- SET HBHCK=0
- FOR
- SET HBHCK=$ORDER(^HBHC(633.2,HBHCI,HBHCJ,HBHCK))
- if HBHCK'>0
- QUIT
- DO SET
- EXIT ; Exit module
- +1 DO ^%ZISC
- +2 KILL DIR,HBHCCLOS,HBHCDAT,HBHCDLMT,HBHCI,HBHCJ,HBHCK,HBHCNODE,HBHCPRV,HBHCTYP,X,Y
- +3 QUIT
- SET ; Set ^TMP node for valid record
- +1 ; quit if no Inspection or Training data
- +2 if '$DATA(^HBHC(633.2,HBHCI,HBHCJ))
- QUIT
- +3 ; notate if MFH closed
- +4 SET (HBHCDAT,HBHCCLOS)=""
- if $PIECE(^HBHC(633.2,HBHCI,0),U,6)]""
- SET HBHCDAT=$PIECE(^HBHC(633.2,HBHCI,0),U,6)
- SET HBHCCLOS=$EXTRACT(HBHCDAT,4,5)_"-"_$EXTRACT(HBHCDAT,6,7)_"-"_$SELECT($EXTRACT(HBHCDAT)=3:20,1:19)_$EXTRACT(HBHCDAT,2,3)
- +5 SET HBHCNODE=^HBHC(633.2,HBHCI,HBHCJ,HBHCK,0)
- +6 WRITE !,$PIECE(^HBHC(633.2,HBHCI,0),U)_HBHCDLMT_HBHCCLOS_HBHCDLMT
- +7 IF HBHCTYP="I"
- WRITE $SELECT(HBHCJ=1:"Nurse",HBHCJ=2:"Social Work",HBHCJ=3:"Dietitian",1:"Fire/Safety")
- +8 IF HBHCTYP="T"
- WRITE $SELECT(HBHCJ=5:"Home Operation",HBHCJ=6:"Fire/Safety",HBHCJ=7:"Medication Management",HBHCJ=8:"Personal Care",HBHCJ=9:"Infection Control",HBHCJ=10:"End of Life",1:"Other")
- +9 WRITE HBHCDLMT_$EXTRACT($PIECE(HBHCNODE,U),4,5)_"-"_$EXTRACT($PIECE(HBHCNODE,U),6,7)_"-"_$SELECT($EXTRACT($PIECE(HBHCNODE,U))=3:20,1:19)_$EXTRACT($PIECE(HBHCNODE,U),2,3)
- +10 IF HBHCTYP="I"
- DO NAME
- WRITE HBHCDLMT_$SELECT(HBHCPRV]"":HBHCPRV,1:"")
- +11 IF HBHCTYP="T"
- if $PIECE(HBHCNODE,U,2)]""
- WRITE HBHCDLMT_$PIECE(HBHCNODE,U,2)
- +12 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