HBHCUTL3 ;LR VAMC(IRMS)/MJT - HBHC Utility module, Entry points: PSEUDO, PCEMSG, DX, DX80, CPT, MFHS, MFH, DATE3, DATE6, DATE3L, & DATE6L ;Jan 2000
;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,15,16,14,24,25**;NOV 01, 1993;Build 45
;
; This routine references the following supported ICRs:
; 5747 $$CODEC^ICDEX
; 5747 $$VSTD^ICDEX
; 5679 $$IMPDATE^LEXU
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;HBH*1.0*25 APR 2012 K GUPTA Support for ICD-10 Coding System
;******************************************************************************
;******************************************************************************
;
PSEUDO ; Print pseudo SSN message
W $C(7),!!,"Patient visit records with pseudo social security numbers (SSNs) exist.",!,"Print the 'Pseudo Social Security Number Report' located on the HBHC Reports"
W !,"Menu to obtain a list of patients with invalid SSNs. HBHC must determine",!,"what corrective action is appropriate to eliminate these records from the",!,"HBHC Information System.",!! H 5
Q
PCEMSG ; Print PCE correction of errors message
W !!,"Note: Please use Appointment Management to Correct Visit Errors. Run",!?7,"Edit Form Errors Data option when corrections are complete."
Q
DX ; Diagnosis (DX) info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCDX
N HBHCDXCODE,HBHCDXDESC
K HBHCDX S $P(HBHCSP8," ",9)="",HBHCI=0
F S HBHCI=$O(^HBHC(632,HBHCDFN,3,HBHCI)) Q:HBHCI'>0 D
. S HBHCICDP=$P(^HBHC(632,HBHCDFN,3,HBHCI,0),U)
. S HBHCDXCODE=$$CODEC^ICDEX(80,HBHCICDP)
. S HBHCDXDESC=$$VSTD^ICDEX(HBHCICDP)
. S HBHCDX(HBHCI)=HBHCDXCODE_$E(HBHCSP8,1,(10-$L(HBHCDXCODE)))_HBHCDXDESC ;add minimum of 2 spaces between code and desc
K HBHCI,HBHCICDP
Q
DX80 ; Print DX info in 80 column format, HBHCDX( array must be defined prior to call
S (HBHCFLG,HBHCI)=0 F S HBHCI=$O(HBHCDX(HBHCI)) Q:HBHCI'>0 W ! W:HBHCFLG=0 "Diagnosis: " W:HBHCFLG=1 ?13 W HBHCDX(HBHCI) S HBHCFLG=1
K HBHCDX,HBHCFLG,HBHCI
Q
CPT ; CPT code info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCCPTA
K HBHCCPTA S $P(HBHCSP3," ",4)="",HBHCI=0 F S HBHCI=$O(^HBHC(632,HBHCDFN,2,HBHCI)) Q:HBHCI'>0 S HBHCCPT=$$CPT^ICPTCOD(^HBHC(632,HBHCDFN,2,HBHCI,0)),HBHCCPTA(HBHCI)=$P(HBHCCPT,U,2)_HBHCSP3_$P(HBHCCPT,U,3) D CPTMOD
K HBHCCPT,HBHCI,HBHCJ,HBHCMOD,HBHCSP3
Q
CPTMOD ; Process CPT Modifier code plus text into local array HBHCCPTA(HBHCCPT,HBHCJ)
S HBHCJ=0 F S HBHCJ=$O(^HBHC(632,HBHCDFN,2,HBHCI,1,HBHCJ)) Q:HBHCJ'>0 S HBHCMOD=$$MOD^ICPTMOD($P(^HBHC(632,HBHCDFN,2,HBHCI,1,HBHCJ,0),U),"I"),HBHCCPTA(HBHCI,HBHCJ)=$P(HBHCMOD,U,2)_HBHCSP3_$P(HBHCMOD,U,3)
Q
MFHS ; Set Medical Foster Home (MFH) Site variable if Sanctioned site
S:$P($G(^HBHC(631.9,1,0)),U,9)]"" HBHCMFHS=1
Q
MFH ; Prompt for HBPC or MFH population inclusion on report; set Medical Foster Home Report variable: HBHCMFHR
K DIR S DIR(0)="SB^H:Home Based Primary Care (HBPC);M:Medical Foster Home (MFH)",DIR("A")="Include HBPC or MFH census",DIR("?")="Include HBPC (H), or MFH (M) population on report" D ^DIR
S:Y="M" HBHCMFHR=1
Q
DATE3 ; Calc 3 mo date based on month only for use by MFH Inspection or Training e-mail processing
S HBHCMO=+$E(DT,4,5),HBHCDATE=3_$S(HBHCMO>9:$E(DT,2,3),1:($E(DT,2,3)-1))_$S(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01" D CHECK
; Following line produces the correct date; keep for testing purposes
;F HBHCMO=1:1:12 S HBHCDATE=3_$S(HBHCMO>9:$E(DT,2,3),1:($E(DT,2,3)-1))_$S(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01" D CHECK
Q
DATE6 ; Calc 6 mo date based on month only for use by MFH Inspection or Training report processing
S HBHCMO=+$E(DT,4,5),HBHCDATE=3_$S(HBHCMO>6:$E(DT,2,3),1:($E(DT,2,3)-1))_$S(HBHCMO=7:"01",HBHCMO=8:"02",HBHCMO=9:"03",HBHCMO=10:"04",HBHCMO=11:"05",HBHCMO=12:"06",HBHCMO=1:"07",HBHCMO=2:"08",HBHCMO=3:"09",1:HBHCMO+6)_"01" D CHECK
Q
DATE3L ; Calc 3 mo date based on month only for use by MFH License Expiration e-mail processing
S HBHCMO=+$E(DT,4,5),HBHCDATE=3_$S(HBHCMO>9:($E(DT,2,3)+1),1:($E(DT,2,3)))_$S(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01" D CHECK
Q
DATE6L ; Calc 6 mo date based on month only for use by MFH License Expiration report processing
S HBHCMO=+$E(DT,4,5),HBHCDATE=3_$S(HBHCMO>6:($E(DT,2,3)+1),1:($E(DT,2,3)))_$S(HBHCMO=7:"01",HBHCMO=8:"02",HBHCMO=9:"03",HBHCMO=10:"04",HBHCMO=11:"05",HBHCMO=12:"06",HBHCMO=1:"07",HBHCMO=2:"08",HBHCMO=3:"09",1:HBHCMO+6)_"01" D CHECK
Q
CHECK ; Check length of HBHCDATE
S:$L(HBHCDATE)=6 HBHCDATE=$E(HBHCDATE)_"0"_$E(HBHCDATE,2,6)
Q
;
;Returns the text ICD-9/ICD-10/ICD based on date range
;Input parameters:
; HBHCBEG - Report beginning date
; HBHCEND - Report ending date
;Output values:
; "ICD-9" - if start and end dates are before ICD-10 implementation date
; "ICD" - if start and end dates spans across ICD-10 implementation date
; "ICD-10" - if start and end dates are on or after ICD-10 implementation date
;
ICDTEXT(HBHCBEG,HBHCEND) ;
N HBHCICD10DT
S HBHCICD10DT=$$IMPDATE^LEXU("10D")
Q:(HBHCEND<HBHCICD10DT) "ICD-9"
Q:(HBHCBEG>=HBHCICD10DT) "ICD-10"
Q "ICD"
;
;Returns the text Coding System based on data range
;Input parameters:
; HBHCBEG - Report beginning date
; HBHCEND - Report ending date
;Output values:
; ",1," - ICD-9 coding system if start and end dates are before ICD-10 implementation date
; ",1,30," - ICD-9 and ICD-10 coding systems if start and end dates spans across ICD-10 implementation date
; ",30," - ICD-10 coding system if start and end dates are on or after ICD-10 implementation date
;
ICDCSYS(HBHCBEG,HBHCEND) ;
N HBHCICD10DT,HBHCRET
S HBHCRET=""
S HBHCICD10DT=$$IMPDATE^LEXU("10D")
S:(HBHCBEG<HBHCICD10DT) HBHCRET="1" ;ICD-9
S:(HBHCEND>=HBHCICD10DT) HBHCRET=HBHCRET_$S(HBHCRET]"":",",1:"")_"30" ;ICD-10
S:HBHCRET]"" HBHCRET=","_HBHCRET_","
Q HBHCRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCUTL3 6555 printed Sep 23, 2025@19:34:54 Page 2
HBHCUTL3 ;LR VAMC(IRMS)/MJT - HBHC Utility module, Entry points: PSEUDO, PCEMSG, DX, DX80, CPT, MFHS, MFH, DATE3, DATE6, DATE3L, & DATE6L ;Jan 2000
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,15,16,14,24,25**;NOV 01, 1993;Build 45
+2 ;
+3 ; This routine references the following supported ICRs:
+4 ; 5747 $$CODEC^ICDEX
+5 ; 5747 $$VSTD^ICDEX
+6 ; 5679 $$IMPDATE^LEXU
+7 ;
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;HBH*1.0*25 APR 2012 K GUPTA Support for ICD-10 Coding System
+15 ;******************************************************************************
+16 ;******************************************************************************
+17 ;
PSEUDO ; Print pseudo SSN message
+1 WRITE $CHAR(7),!!,"Patient visit records with pseudo social security numbers (SSNs) exist.",!,"Print the 'Pseudo Social Security Number Report' located on the HBHC Reports"
+2 WRITE !,"Menu to obtain a list of patients with invalid SSNs. HBHC must determine",!,"what corrective action is appropriate to eliminate these records from the",!,"HBHC Information System.",!!
HANG 5
+3 QUIT
PCEMSG ; Print PCE correction of errors message
+1 WRITE !!,"Note: Please use Appointment Management to Correct Visit Errors. Run",!?7,"Edit Form Errors Data option when corrections are complete."
+2 QUIT
DX ; Diagnosis (DX) info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCDX
+1 NEW HBHCDXCODE,HBHCDXDESC
+2 KILL HBHCDX
SET $PIECE(HBHCSP8," ",9)=""
SET HBHCI=0
+3 FOR
SET HBHCI=$ORDER(^HBHC(632,HBHCDFN,3,HBHCI))
if HBHCI'>0
QUIT
Begin DoDot:1
+4 SET HBHCICDP=$PIECE(^HBHC(632,HBHCDFN,3,HBHCI,0),U)
+5 SET HBHCDXCODE=$$CODEC^ICDEX(80,HBHCICDP)
+6 SET HBHCDXDESC=$$VSTD^ICDEX(HBHCICDP)
+7 ;add minimum of 2 spaces between code and desc
SET HBHCDX(HBHCI)=HBHCDXCODE_$EXTRACT(HBHCSP8,1,(10-$LENGTH(HBHCDXCODE)))_HBHCDXDESC
End DoDot:1
+8 KILL HBHCI,HBHCICDP
+9 QUIT
DX80 ; Print DX info in 80 column format, HBHCDX( array must be defined prior to call
+1 SET (HBHCFLG,HBHCI)=0
FOR
SET HBHCI=$ORDER(HBHCDX(HBHCI))
if HBHCI'>0
QUIT
WRITE !
if HBHCFLG=0
WRITE "Diagnosis: "
if HBHCFLG=1
WRITE ?13
WRITE HBHCDX(HBHCI)
SET HBHCFLG=1
+2 KILL HBHCDX,HBHCFLG,HBHCI
+3 QUIT
CPT ; CPT code info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCCPTA
+1 KILL HBHCCPTA
SET $PIECE(HBHCSP3," ",4)=""
SET HBHCI=0
FOR
SET HBHCI=$ORDER(^HBHC(632,HBHCDFN,2,HBHCI))
if HBHCI'>0
QUIT
SET HBHCCPT=$$CPT^ICPTCOD(^HBHC(632,HBHCDFN,2,HBHCI,0))
SET HBHCCPTA(HBHCI)=$PIECE(HBHCCPT,U,2)_HBHCSP3_$PIECE(HBHCCPT,U,3)
DO CPTMOD
+2 KILL HBHCCPT,HBHCI,HBHCJ,HBHCMOD,HBHCSP3
+3 QUIT
CPTMOD ; Process CPT Modifier code plus text into local array HBHCCPTA(HBHCCPT,HBHCJ)
+1 SET HBHCJ=0
FOR
SET HBHCJ=$ORDER(^HBHC(632,HBHCDFN,2,HBHCI,1,HBHCJ))
if HBHCJ'>0
QUIT
SET HBHCMOD=$$MOD^ICPTMOD($PIECE(^HBHC(632,HBHCDFN,2,HBHCI,1,HBHCJ,0),U),"I")
SET HBHCCPTA(HBHCI,HBHCJ)=$PIECE(HBHCMOD,U,2)_HBHCSP3_$PIECE(HBHCMOD,U,3)
+2 QUIT
MFHS ; Set Medical Foster Home (MFH) Site variable if Sanctioned site
+1 if $PIECE($GET(^HBHC(631.9,1,0)),U,9)]""
SET HBHCMFHS=1
+2 QUIT
MFH ; Prompt for HBPC or MFH population inclusion on report; set Medical Foster Home Report variable: HBHCMFHR
+1 KILL DIR
SET DIR(0)="SB^H:Home Based Primary Care (HBPC);M:Medical Foster Home (MFH)"
SET DIR("A")="Include HBPC or MFH census"
SET DIR("?")="Include HBPC (H), or MFH (M) population on report"
DO ^DIR
+2 if Y="M"
SET HBHCMFHR=1
+3 QUIT
DATE3 ; Calc 3 mo date based on month only for use by MFH Inspection or Training e-mail processing
+1 SET HBHCMO=+$EXTRACT(DT,4,5)
SET HBHCDATE=3_$SELECT(HBHCMO>9:$EXTRACT(DT,2,3),1:($EXTRACT(DT,2,3)-1))_$SELECT(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01"
DO CHECK
+2 ; Following line produces the correct date; keep for testing purposes
+3 ;F HBHCMO=1:1:12 S HBHCDATE=3_$S(HBHCMO>9:$E(DT,2,3),1:($E(DT,2,3)-1))_$S(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01" D CHECK
+4 QUIT
DATE6 ; Calc 6 mo date based on month only for use by MFH Inspection or Training report processing
+1 SET HBHCMO=+$EXTRACT(DT,4,5)
SET HBHCDATE=3_$SELECT(HBHCMO>6:$EXTRACT(DT,2,3),1:($EXTRACT(DT,2,3)-1))_$SELECT(HBHCMO=7:"01",HBHCMO=8:"02",HBHCMO=9:"03",HBHCMO=10:"04",HBHCMO=11:"05",HBHCMO=12:"06",HBHCMO=1:"07",HBHCMO=2:"08",HBHCMO=3:"09",1:HBHCMO+6)_"01"
DO CHECK
+2 QUIT
DATE3L ; Calc 3 mo date based on month only for use by MFH License Expiration e-mail processing
+1 SET HBHCMO=+$EXTRACT(DT,4,5)
SET HBHCDATE=3_$SELECT(HBHCMO>9:($EXTRACT(DT,2,3)+1),1:($EXTRACT(DT,2,3)))_$SELECT(HBHCMO=10:"01",HBHCMO=11:"02",HBHCMO=12:"03",HBHCMO=1:"04",HBHCMO=2:"05",HBHCMO=3:"06",HBHCMO=4:"07",HBHCMO=5:"08",HBHCMO=6:"09",1:HBHCMO+3)_"01"
DO CHECK
+2 QUIT
DATE6L ; Calc 6 mo date based on month only for use by MFH License Expiration report processing
+1 SET HBHCMO=+$EXTRACT(DT,4,5)
SET HBHCDATE=3_$SELECT(HBHCMO>6:($EXTRACT(DT,2,3)+1),1:($EXTRACT(DT,2,3)))_$SELECT(HBHCMO=7:"01",HBHCMO=8:"02",HBHCMO=9:"03",HBHCMO=10:"04",HBHCMO=11:"05",HBHCMO=12:"06",HBHCMO=1:"07",HBHCMO=2:"08",HBHCMO=3:"09",1:HBHCMO+6)_"01"
DO CHECK
+2 QUIT
CHECK ; Check length of HBHCDATE
+1 if $LENGTH(HBHCDATE)=6
SET HBHCDATE=$EXTRACT(HBHCDATE)_"0"_$EXTRACT(HBHCDATE,2,6)
+2 QUIT
+3 ;
+4 ;Returns the text ICD-9/ICD-10/ICD based on date range
+5 ;Input parameters:
+6 ; HBHCBEG - Report beginning date
+7 ; HBHCEND - Report ending date
+8 ;Output values:
+9 ; "ICD-9" - if start and end dates are before ICD-10 implementation date
+10 ; "ICD" - if start and end dates spans across ICD-10 implementation date
+11 ; "ICD-10" - if start and end dates are on or after ICD-10 implementation date
+12 ;
ICDTEXT(HBHCBEG,HBHCEND) ;
+1 NEW HBHCICD10DT
+2 SET HBHCICD10DT=$$IMPDATE^LEXU("10D")
+3 if (HBHCEND<HBHCICD10DT)
QUIT "ICD-9"
+4 if (HBHCBEG>=HBHCICD10DT)
QUIT "ICD-10"
+5 QUIT "ICD"
+6 ;
+7 ;Returns the text Coding System based on data range
+8 ;Input parameters:
+9 ; HBHCBEG - Report beginning date
+10 ; HBHCEND - Report ending date
+11 ;Output values:
+12 ; ",1," - ICD-9 coding system if start and end dates are before ICD-10 implementation date
+13 ; ",1,30," - ICD-9 and ICD-10 coding systems if start and end dates spans across ICD-10 implementation date
+14 ; ",30," - ICD-10 coding system if start and end dates are on or after ICD-10 implementation date
+15 ;
ICDCSYS(HBHCBEG,HBHCEND) ;
+1 NEW HBHCICD10DT,HBHCRET
+2 SET HBHCRET=""
+3 SET HBHCICD10DT=$$IMPDATE^LEXU("10D")
+4 ;ICD-9
if (HBHCBEG<HBHCICD10DT)
SET HBHCRET="1"
+5 ;ICD-10
if (HBHCEND>=HBHCICD10DT)
SET HBHCRET=HBHCRET_$SELECT(HBHCRET]"":",",1:"")_"30"
+6 if HBHCRET]""
SET HBHCRET=","_HBHCRET_","
+7 QUIT HBHCRET
