| 1 | HBHCXMD1 ; LR VAMC(IRMS)/MJT-HBHC, called by ^HBHCXMD ;9203
|
|---|
| 2 | ;;1.0;HOSPITAL BASED HOME CARE;**2,6,19**;NOV 01, 1993
|
|---|
| 3 | START ; Initialization
|
|---|
| 4 | W !,"Processing Discharge/Form 5 Data"
|
|---|
| 5 | S HBHCFORM=5,HBHC12="^1^2^",HBHC359="^3^5^9^",$P(HBHCSP1," ",2)="",$P(HBHCSP4," ",5)="",$P(HBHCSP6," ",7)="",$P(HBHCSP81," ",82)="",HBHCLNTH=5
|
|---|
| 6 | S HBHCHOSP=$P($G(^DIC(4,$P(^HBHC(631.9,1,0),U,5),99)),U) S:$L(HBHCHOSP)'=7 HBHCHOSP=HBHCHOSP_$E(HBHCSP4,1,(7-($L(HBHCHOSP))))
|
|---|
| 7 | S HBHCFLD1="HBHCELGD^HBHCMARD^HBHCLIVD^HBHCSTAT"
|
|---|
| 8 | S HBHCFLD2="HBHCVISD^HBHCHERD^HBHCEXCD^HBHCRECD^HBHCBTHD^HBHCDRSD^HBHCTLTD^HBHCTRND"
|
|---|
| 9 | S HBHCFLD3="HBHCEATD^HBHCWLKD^HBHCBWLD^HBHCBLDD^HBHCMOBD^HBHCADTD^HBHCBHVD^HBHCDSOD^HBHCMODD^HBHCLMTD"
|
|---|
| 10 | K %DT S X="T" D ^%DT S HBHCTDY=Y
|
|---|
| 11 | Q
|
|---|
| 12 | DFLT1 ; Process fields 5, 10, & 11 as default values for fields 40, 41 & 42
|
|---|
| 13 | S HBHCX=$S(HBHCI=1:6,HBHCI=2:11,HBHCI=3:12,1:""),HBHCDFLT=""
|
|---|
| 14 | S:$P(HBHCNOD0,U,HBHCX)]"" HBHCDFLT=$P($P(^DD(631,(HBHCX-1),0),($P(HBHCNOD0,U,HBHCX)_":"),2),";")
|
|---|
| 15 | S HBHCDR1=$S(HBHCDFLT]"":HBHCDR1_(HBHCI+39)_"//"_HBHCDFLT_";",1:HBHCDR1_(HBHCI+39)_";")
|
|---|
| 16 | Q
|
|---|
| 17 | ICDDFLT ; Process field 18 as default value for field 46
|
|---|
| 18 | S HBHCDFLT=""
|
|---|
| 19 | S:$P(HBHCNOD0,U,19)]"" HBHCDFLT=$P(^ICD9($P(HBHCNOD0,U,19),0),U)
|
|---|
| 20 | S HBHCDR1=$S(HBHCDFLT]"":HBHCDR1_"46//"_HBHCDFLT_";",1:HBHCDR1_"46;")
|
|---|
| 21 | Q
|
|---|
| 22 | DFLT2 ; Process fields 19 - 26 as default values for fields 47 - 54
|
|---|
| 23 | S HBHCDFLT=""
|
|---|
| 24 | S:(HBHCJ=3)&($P(HBHCNOD0,U,22)]"") HBHCDFLT=$P(^HBHC(631.2,$P(HBHCNOD0,U,22),0),U)
|
|---|
| 25 | S:(HBHCJ=4)&($P(HBHCNOD0,U,23)]"") HBHCDFLT=$P(^HBHC(631.3,$P(HBHCNOD0,U,23),0),U)
|
|---|
| 26 | S:(HBHCJ'=3)&(HBHCJ'=4)&($P(HBHCNOD0,U,HBHCJ+19)]"") HBHCDFLT=$P($P(^DD(631,(HBHCJ+18),0),($P(HBHCNOD0,U,HBHCJ+19)_":"),2),";")
|
|---|
| 27 | S:(HBHCJ=1)!(HBHCJ=2) HBHCDR1=$S(HBHCDFLT]"":HBHCDR1_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR1_(HBHCJ+46)_";")
|
|---|
| 28 | S:(HBHCJ=3)!(HBHCJ=4)!(HBHCJ=5) HBHCDR2=$S(HBHCDFLT]"":HBHCDR2_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR2_(HBHCJ+46)_";")
|
|---|
| 29 | S:(HBHCJ=6)!(HBHCJ=7)!(HBHCJ=8) HBHCDR3=$S(HBHCDFLT]"":HBHCDR3_(HBHCJ+46)_"//"_HBHCDFLT_";",1:HBHCDR3_(HBHCJ+46)_";")
|
|---|
| 30 | Q
|
|---|
| 31 | DFLT3 ; Process fields 27 - 36 as default values for fields 55 - 64
|
|---|
| 32 | S HBHCDFLT=""
|
|---|
| 33 | S:$P(HBHCNOD0,U,HBHCK+27)]"" HBHCDFLT=$P($P(^DD(631,(HBHCK+26),0),($P(HBHCNOD0,U,HBHCK+27)_":"),2),";")
|
|---|
| 34 | S:HBHCK=1 HBHCDR3=$S(HBHCDFLT]"":HBHCDR3_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR3_(HBHCK+54)_";")
|
|---|
| 35 | S:(HBHCK>1)&(HBHCK<6) HBHCDR4=$S(HBHCDFLT]"":HBHCDR4_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR4_(HBHCK+54)_";")
|
|---|
| 36 | S:HBHCK>5 HBHCDR5=$S(HBHCDFLT]"":HBHCDR5_(HBHCK+54)_"//"_HBHCDFLT_";",1:HBHCDR5_(HBHCK+54)_";")
|
|---|
| 37 | Q
|
|---|
| 38 | EXIT ; Exit module
|
|---|
| 39 | K 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
|
|---|
| 40 | 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
|
|---|
| 41 | K HBHCNOD1,HBHCREC,HBHCRECD,HBHCSP1,HBHCSP4,HBHCSP6,HBHCSP81,HBHCSSN,HBHCSTAT,HBHCTDY,HBHCTFLG,HBHCTLTD,HBHCTRND,HBHCVISD,HBHCWLKD,HBHCX,HBHCXMT5,X,Y,%DT
|
|---|
| 42 | Q
|
|---|
