| 1 | IBCIMSG ;DSI/SLM - BUILD MESSAGE FOR CLAIMSMANAGER ;12-JAN-2001
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;
|
|---|
| 6 | KILL ^TMP("IBCIMSG",$J) ; kill scratch global before building it
|
|---|
| 7 | Q:'$D(IBIFN)
|
|---|
| 8 | D INIT
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | INIT ;initialize variables for building the message
|
|---|
| 12 | S NODE3=$G(^IBA(351.9,IBIFN,3)),NODE4=$G(^IBA(351.9,IBIFN,4))
|
|---|
| 13 | S X=NODE3 D TCK^IBCIUT4() S NODE3=X
|
|---|
| 14 | S X=NODE4 D TCK^IBCIUT4() S NODE4=X
|
|---|
| 15 | I '$D(IBCISNT) S IBCISNT=1
|
|---|
| 16 | S IBCICL=$P(^DGCR(399,IBIFN,0),U),IBCICLNP=IBCICL
|
|---|
| 17 | S X=IBCICL,X1=25,IBCICL=$$FILL^IBCIUT2
|
|---|
| 18 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,2)=IBCICL
|
|---|
| 19 | S IBCIEBID=$$NOW^XLFDT,X=IBCIEBID D NOW^IBCIUT1 S IBCIEBID=Y K Y
|
|---|
| 20 | S X=IBCIEBID,X1=25,IBCIEBID=$$FILL^IBCIUT2
|
|---|
| 21 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,1)=IBCIEBID
|
|---|
| 22 | S IBCIPID=$P(NODE3,U,1),X=IBCIPID,X1=20,IBCIPID=$$FILL^IBCIUT2
|
|---|
| 23 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,3)=IBCIPID
|
|---|
| 24 | S IBCIAPID="",X=$G(IBCIAPID),X1=20,IBCIAPID=$$FILL^IBCIUT2
|
|---|
| 25 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,4)=IBCIAPID
|
|---|
| 26 | S IBCIPTLA=$P(NODE3,U,2),X=IBCIPTLA,X1=40,IBCIPTLA=$$FILL^IBCIUT2
|
|---|
| 27 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,5)=IBCIPTLA
|
|---|
| 28 | S IBCIPTMI=$P(NODE3,U,3),X=IBCIPTMI,X1=20,IBCIPTMI=$$FILL^IBCIUT2
|
|---|
| 29 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,6)=IBCIPTMI
|
|---|
| 30 | S IBCIPTFI=$P(NODE3,U,4),X=IBCIPTFI,X1=20,IBCIPTFI=$$FILL^IBCIUT2
|
|---|
| 31 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,7)=IBCIPTFI
|
|---|
| 32 | S IBCIDOB=$P(NODE3,U,5),X=IBCIDOB D NOW^IBCIUT1
|
|---|
| 33 | S X=Y,X1=16,IBCIDOB=$$FILL^IBCIUT2 K Y
|
|---|
| 34 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,8)=IBCIDOB
|
|---|
| 35 | S IBCISEX=$P(NODE3,U,6),X=IBCISEX,X1=1,X4="T",IBCISEX=$$FILL^IBCIUT2
|
|---|
| 36 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,9)=IBCISEX K X4
|
|---|
| 37 | S IBCIET=$P(NODE3,U,7),X=IBCIET D NOW^IBCIUT1 S IBCIET=Y K Y
|
|---|
| 38 | S X=IBCIET,X1=16,IBCIET=$$FILL^IBCIUT2
|
|---|
| 39 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,10)=IBCIET
|
|---|
| 40 | S IBCIRPID=$P(NODE3,U,8),X=IBCIRPID,X1=20,IBCIRPID=$$FILL^IBCIUT2
|
|---|
| 41 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,11)=IBCIRPID
|
|---|
| 42 | S IBCIRPLA=$P(NODE3,U,9),X=IBCIRPLA,X1=40,IBCIRPLA=$$FILL^IBCIUT2
|
|---|
| 43 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,12)=IBCIRPLA
|
|---|
| 44 | S IBCIRPMI=$P(NODE3,U,10),X=IBCIRPMI,X1=20,IBCIRPMI=$$FILL^IBCIUT2
|
|---|
| 45 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,13)=IBCIRPMI
|
|---|
| 46 | S IBCIRPFI=$P(NODE3,U,11),X=IBCIRPFI,X1=20,IBCIRPFI=$$FILL^IBCIUT2
|
|---|
| 47 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,14)=IBCIRPFI
|
|---|
| 48 | S IBCIRPTI=$P(NODE3,U,12),X=IBCIRPTI,X1=5,X4="T",IBCIRPTI=$$FILL^IBCIUT2
|
|---|
| 49 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,15)=IBCIRPTI K X4
|
|---|
| 50 | S IBCIRPDE=$P(NODE4,U,1),X=IBCIRPDE,X1=20,IBCIRPDE=$$FILL^IBCIUT2
|
|---|
| 51 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,16)=IBCIRPDE
|
|---|
| 52 | S IBCIRPSP=$P(NODE4,U,2),X=IBCIRPSP,X1=10,IBCIRPSP=$$FILL^IBCIUT2
|
|---|
| 53 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,17)=IBCIRPSP
|
|---|
| 54 | S IBCIRPDI=$P(NODE4,U,3),X=IBCIRPDI,X1=10,IBCIRPDI=$$FILL^IBCIUT2
|
|---|
| 55 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,18)=IBCIRPDI
|
|---|
| 56 | S IBCIRPUP=$P(NODE4,U,4),X=IBCIRPUP,X1=10,IBCIRPUP=$$FILL^IBCIUT2
|
|---|
| 57 | S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,19)=IBCIRPUP
|
|---|
| 58 | ICD9 ;build and check icd9 code array
|
|---|
| 59 | N LITM,DNUM,IBCIMSG K ^TMP("IBCIMSG",$J,IBIFN,"ICD")
|
|---|
| 60 | S IBCIMSG=1 D DIAG^IBCIUT1(IBIFN)
|
|---|
| 61 | S LITM=0 F S LITM=$O(^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM)) Q:'LITM D
|
|---|
| 62 | .S DNUM=0 F S DNUM=$O(^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM)) Q:'DNUM D
|
|---|
| 63 | ..S X=^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM) D CCK^IBCIUT4(),TCK^IBCIUT4()
|
|---|
| 64 | ..S ^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM)=X
|
|---|
| 65 | D INIT1^IBCIMSG1
|
|---|
| 66 | Q
|
|---|
