Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HBHCUTL3

HBHCUTL3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine references the following supported ICRs:
  1. ; 5747 $$CODEC^ICDEX
  1. ; 5747 $$VSTD^ICDEX
  1. ; 5679 $$IMPDATE^LEXU
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;HBH*1.0*25 APR 2012 K GUPTA Support for ICD-10 Coding System
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. PSEUDO ; Print pseudo SSN message
  1. 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"
  1. 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
  1. Q
  1. PCEMSG ; Print PCE correction of errors message
  1. W !!,"Note: Please use Appointment Management to Correct Visit Errors. Run",!?7,"Edit Form Errors Data option when corrections are complete."
  1. Q
  1. DX ; Diagnosis (DX) info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCDX
  1. N HBHCDXCODE,HBHCDXDESC
  1. K HBHCDX S $P(HBHCSP8," ",9)="",HBHCI=0
  1. F S HBHCI=$O(^HBHC(632,HBHCDFN,3,HBHCI)) Q:HBHCI'>0 D
  1. . S HBHCICDP=$P(^HBHC(632,HBHCDFN,3,HBHCI,0),U)
  1. . S HBHCDXCODE=$$CODEC^ICDEX(80,HBHCICDP)
  1. . S HBHCDXDESC=$$VSTD^ICDEX(HBHCICDP)
  1. . S HBHCDX(HBHCI)=HBHCDXCODE_$E(HBHCSP8,1,(10-$L(HBHCDXCODE)))_HBHCDXDESC ;add minimum of 2 spaces between code and desc
  1. K HBHCI,HBHCICDP
  1. Q
  1. DX80 ; Print DX info in 80 column format, HBHCDX( array must be defined prior to call
  1. 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
  1. K HBHCDX,HBHCFLG,HBHCI
  1. Q
  1. CPT ; CPT code info, HBHCDFN must be defined prior to call, returns code plus text in local array HBHCCPTA
  1. 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
  1. K HBHCCPT,HBHCI,HBHCJ,HBHCMOD,HBHCSP3
  1. Q
  1. CPTMOD ; Process CPT Modifier code plus text into local array HBHCCPTA(HBHCCPT,HBHCJ)
  1. 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)
  1. Q
  1. MFHS ; Set Medical Foster Home (MFH) Site variable if Sanctioned site
  1. S:$P($G(^HBHC(631.9,1,0)),U,9)]"" HBHCMFHS=1
  1. Q
  1. MFH ; Prompt for HBPC or MFH population inclusion on report; set Medical Foster Home Report variable: HBHCMFHR
  1. 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
  1. S:Y="M" HBHCMFHR=1
  1. Q
  1. DATE3 ; Calc 3 mo date based on month only for use by MFH Inspection or Training e-mail processing
  1. 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
  1. ; Following line produces the correct date; keep for testing purposes
  1. ;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
  1. Q
  1. DATE6 ; Calc 6 mo date based on month only for use by MFH Inspection or Training report processing
  1. 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
  1. Q
  1. DATE3L ; Calc 3 mo date based on month only for use by MFH License Expiration e-mail processing
  1. 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
  1. Q
  1. DATE6L ; Calc 6 mo date based on month only for use by MFH License Expiration report processing
  1. 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
  1. Q
  1. CHECK ; Check length of HBHCDATE
  1. S:$L(HBHCDATE)=6 HBHCDATE=$E(HBHCDATE)_"0"_$E(HBHCDATE,2,6)
  1. Q
  1. ;
  1. ;Returns the text ICD-9/ICD-10/ICD based on date range
  1. ;Input parameters:
  1. ; HBHCBEG - Report beginning date
  1. ; HBHCEND - Report ending date
  1. ;Output values:
  1. ; "ICD-9" - if start and end dates are before ICD-10 implementation date
  1. ; "ICD" - if start and end dates spans across ICD-10 implementation date
  1. ; "ICD-10" - if start and end dates are on or after ICD-10 implementation date
  1. ;
  1. ICDTEXT(HBHCBEG,HBHCEND) ;
  1. N HBHCICD10DT
  1. S HBHCICD10DT=$$IMPDATE^LEXU("10D")
  1. Q:(HBHCEND<HBHCICD10DT) "ICD-9"
  1. Q:(HBHCBEG>=HBHCICD10DT) "ICD-10"
  1. Q "ICD"
  1. ;
  1. ;Returns the text Coding System based on data range
  1. ;Input parameters:
  1. ; HBHCBEG - Report beginning date
  1. ; HBHCEND - Report ending date
  1. ;Output values:
  1. ; ",1," - ICD-9 coding system if start and end dates are before ICD-10 implementation date
  1. ; ",1,30," - ICD-9 and ICD-10 coding systems if start and end dates spans across ICD-10 implementation date
  1. ; ",30," - ICD-10 coding system if start and end dates are on or after ICD-10 implementation date
  1. ;
  1. ICDCSYS(HBHCBEG,HBHCEND) ;
  1. N HBHCICD10DT,HBHCRET
  1. S HBHCRET=""
  1. S HBHCICD10DT=$$IMPDATE^LEXU("10D")
  1. S:(HBHCBEG<HBHCICD10DT) HBHCRET="1" ;ICD-9
  1. S:(HBHCEND>=HBHCICD10DT) HBHCRET=HBHCRET_$S(HBHCRET]"":",",1:"")_"30" ;ICD-10
  1. S:HBHCRET]"" HBHCRET=","_HBHCRET_","
  1. Q HBHCRET