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

HBHCXMD1.m

Go to the documentation of this file. 
  1. HBHCXMD1 ;LR VAMC(IRMS)/MJT - HBHC, called by ^HBHCXMD, calls HOSP^HBHCUTL1 ;9/2/09
  1.  ;;1.0;HOSPITAL BASED HOME CARE;**2,6,19,24,25**;NOV 01, 1993;Build 45
  1.  ;
  1.  ; This routine references the following supported ICRs:
  1.  ; 5747    $$CODEC^ICDEX
  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. START ; Initialization
  1.  W !,"Processing Discharge/Form 5 Data"
  1.  S HBHCFORM=5,HBHC12="^1^2^",HBHC359="^3^5^9^",$P(HBHCSP1," ",2)="",$P(HBHCSP4," ",5)="",$P(HBHCSP8," ",9)="",$P(HBHCS129," ",130)="",HBHCLNTH=5
  1.  D HOSP^HBHCUTL1
  1.  S HBHCFLD1="HBHCELGD^HBHCMARD^HBHCLIVD^HBHCSTAT"
  1.  S HBHCFLD2="HBHCVISD^HBHCHERD^HBHCEXCD^HBHCRECD^HBHCBTHD^HBHCDRSD^HBHCTLTD^HBHCTRND"
  1.  S HBHCFLD3="HBHCEATD^HBHCWLKD^HBHCBWLD^HBHCBLDD^HBHCMOBD^HBHCADTD^HBHCBHVD^HBHCDSOD^HBHCMODD^HBHCLMTD"
  1.  K %DT S X="T" D ^%DT S HBHCTDY=Y
  1.  Q
  1. DFLT1 ; Process fields 5, 10, & 11 as default values for fields 40, 41 & 42
  1.  S HBHCX=$S(HBHCI=1:6,HBHCI=2:11,HBHCI=3:12,1:""),HBHCDFLT=""
  1.  S:$P(HBHCNOD0,U,HBHCX)]"" HBHCDFLT=$P($P(^DD(631,(HBHCX-1),0),($P(HBHCNOD0,U,HBHCX)_":"),2),";")
  1.  S HBHCDR1=$S(HBHCDFLT]"":HBHCDR1_(HBHCI+39)_"//"_HBHCDFLT_";",1:HBHCDR1_(HBHCI+39)_";")
  1.  Q
  1. ICDDFLT ; Process field 18 as default value for field 46
  1.  S HBHCDFLT=""
  1.  S HBHCDFLT=$$DFLTDCDX^HBHCLKU1(HBHCDFN)  ;default only if same coding system
  1.  S:HBHCDFLT]"" HBHCDFLT=$$CODEC^ICDEX(80,HBHCDFLT)
  1.  S HBHCDR1=HBHCDR1_"46"_$S(HBHCDFLT]"":"//"_HBHCDFLT,1:"")_";"
  1.  Q
  1. DFLT2 ; Process fields 19 - 26 as default values for fields 47 - 54
  1.  S HBHCDFLT=""
  1.  S:(HBHCJ=3)&($P(HBHCNOD0,U,22)]"") HBHCDFLT=$P(^HBHC(631.2,$P(HBHCNOD0,U,22),0),U)
  1.  S:(HBHCJ=4)&($P(HBHCNOD0,U,23)]"") HBHCDFLT=$P(^HBHC(631.3,$P(HBHCNOD0,U,23),0),U)
  1.  S:(HBHCJ'=3)&(HBHCJ'=4)&($P(HBHCNOD0,U,HBHCJ+19)]"") HBHCDFLT=$P($P(^DD(631,(HBHCJ+18),0),($P(HBHCNOD0,U,HBHCJ+19)_":"),2),";")
  1.  S:(HBHCJ=1)!(HBHCJ=2) HBHCDR1=$S(HBHCDFLT]"":HBHCDR1_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR1_(HBHCJ+46)_";")
  1.  S:(HBHCJ=3)!(HBHCJ=4)!(HBHCJ=5) HBHCDR2=$S(HBHCDFLT]"":HBHCDR2_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR2_(HBHCJ+46)_";")
  1.  S:(HBHCJ=6)!(HBHCJ=7)!(HBHCJ=8) HBHCDR3=$S(HBHCDFLT]"":HBHCDR3_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR3_(HBHCJ+46)_";")
  1.  Q
  1. DFLT3 ; Process fields 27 - 36 as default values for fields 55 - 64
  1.  S HBHCDFLT=""
  1.  S:$P(HBHCNOD0,U,HBHCK+27)]"" HBHCDFLT=$P($P(^DD(631,(HBHCK+26),0),($P(HBHCNOD0,U,HBHCK+27)_":"),2),";")
  1.  S:HBHCK=1 HBHCDR3=$S(HBHCDFLT]"":HBHCDR3_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR3_(HBHCK+54)_";")
  1.  S:(HBHCK>1)&(HBHCK<6) HBHCDR4=$S(HBHCDFLT]"":HBHCDR4_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR4_(HBHCK+54)_";")
  1.  S:HBHCK>5 HBHCDR5=$S(HBHCDFLT]"":HBHCDR5_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR5_(HBHCK+54)_";")
  1.  Q
  1. EXIT ; Exit module
  1.  K DILOCKTM,HBHC12,HBHC359,HBHCADDT,HBHCADTD,HBHCAGCY,HBHCBHVD,HBHCBLDD,HBHCBTHD,HBHCBWLD,HBHCCONT,HBHCDATE,HBHCDDTA,HBHCDEST,HBHCDFLG,HBHCDFLT,HBHCDFN,HBHCDR1,HBHCDR2,HBHCDR3,HBHCDR3,HBHCDR4,HBHCDR5,HBHCDRSD,HBHCDSDT,HBHCDSOD,HBHCEATD
  1.  K HBHCELGD,HBHCEXCD,HBHCFLD,HBHCFLD1,HBHCFLD2,HBHCFLD3,HBHCFLG,HBHCFORM,HBHCHERD,HBHCHOSP,HBHCI,HBHCICDD,HBHCJ,HBHCK,HBHCL,HBHCLIVD,HBHCLMTD,HBHCLNTH,HBHCM,HBHCMARD,HBHCMOBD,HBHCMODD,HBHCNAME,HBHCNDX1,HBHCNDX2,HBHCNOD0
  1.  K HBHCNOD1,HBHCREC,HBHCRECD,HBHCSP1,HBHCS129,HBHCSP4,HBHCSP8,HBHCSSN,HBHCSTAT,HBHCTDY,HBHCTFLG,HBHCTLTD,HBHCTRND,HBHCVISD,HBHCWLKD,HBHCX,HBHCXMT5,X,Y,%DT
  1.  Q