67 lines
3.2 KiB
Mathematica
67 lines
3.2 KiB
Mathematica
IBCIMSG ;DSI/SLM - BUILD MESSAGE FOR CLAIMSMANAGER ;12-JAN-2001
|
|
;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
EN ;
|
|
KILL ^TMP("IBCIMSG",$J) ; kill scratch global before building it
|
|
Q:'$D(IBIFN)
|
|
D INIT
|
|
Q
|
|
;
|
|
INIT ;initialize variables for building the message
|
|
S NODE3=$G(^IBA(351.9,IBIFN,3)),NODE4=$G(^IBA(351.9,IBIFN,4))
|
|
S X=NODE3 D TCK^IBCIUT4() S NODE3=X
|
|
S X=NODE4 D TCK^IBCIUT4() S NODE4=X
|
|
I '$D(IBCISNT) S IBCISNT=1
|
|
S IBCICL=$P(^DGCR(399,IBIFN,0),U),IBCICLNP=IBCICL
|
|
S X=IBCICL,X1=25,IBCICL=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,2)=IBCICL
|
|
S IBCIEBID=$$NOW^XLFDT,X=IBCIEBID D NOW^IBCIUT1 S IBCIEBID=Y K Y
|
|
S X=IBCIEBID,X1=25,IBCIEBID=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,1)=IBCIEBID
|
|
S IBCIPID=$P(NODE3,U,1),X=IBCIPID,X1=20,IBCIPID=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,3)=IBCIPID
|
|
S IBCIAPID="",X=$G(IBCIAPID),X1=20,IBCIAPID=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,4)=IBCIAPID
|
|
S IBCIPTLA=$P(NODE3,U,2),X=IBCIPTLA,X1=40,IBCIPTLA=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,5)=IBCIPTLA
|
|
S IBCIPTMI=$P(NODE3,U,3),X=IBCIPTMI,X1=20,IBCIPTMI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,6)=IBCIPTMI
|
|
S IBCIPTFI=$P(NODE3,U,4),X=IBCIPTFI,X1=20,IBCIPTFI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,7)=IBCIPTFI
|
|
S IBCIDOB=$P(NODE3,U,5),X=IBCIDOB D NOW^IBCIUT1
|
|
S X=Y,X1=16,IBCIDOB=$$FILL^IBCIUT2 K Y
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,8)=IBCIDOB
|
|
S IBCISEX=$P(NODE3,U,6),X=IBCISEX,X1=1,X4="T",IBCISEX=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,9)=IBCISEX K X4
|
|
S IBCIET=$P(NODE3,U,7),X=IBCIET D NOW^IBCIUT1 S IBCIET=Y K Y
|
|
S X=IBCIET,X1=16,IBCIET=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,10)=IBCIET
|
|
S IBCIRPID=$P(NODE3,U,8),X=IBCIRPID,X1=20,IBCIRPID=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,11)=IBCIRPID
|
|
S IBCIRPLA=$P(NODE3,U,9),X=IBCIRPLA,X1=40,IBCIRPLA=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,12)=IBCIRPLA
|
|
S IBCIRPMI=$P(NODE3,U,10),X=IBCIRPMI,X1=20,IBCIRPMI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,13)=IBCIRPMI
|
|
S IBCIRPFI=$P(NODE3,U,11),X=IBCIRPFI,X1=20,IBCIRPFI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,14)=IBCIRPFI
|
|
S IBCIRPTI=$P(NODE3,U,12),X=IBCIRPTI,X1=5,X4="T",IBCIRPTI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,15)=IBCIRPTI K X4
|
|
S IBCIRPDE=$P(NODE4,U,1),X=IBCIRPDE,X1=20,IBCIRPDE=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,16)=IBCIRPDE
|
|
S IBCIRPSP=$P(NODE4,U,2),X=IBCIRPSP,X1=10,IBCIRPSP=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,17)=IBCIRPSP
|
|
S IBCIRPDI=$P(NODE4,U,3),X=IBCIRPDI,X1=10,IBCIRPDI=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,18)=IBCIRPDI
|
|
S IBCIRPUP=$P(NODE4,U,4),X=IBCIRPUP,X1=10,IBCIRPUP=$$FILL^IBCIUT2
|
|
S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,19)=IBCIRPUP
|
|
ICD9 ;build and check icd9 code array
|
|
N LITM,DNUM,IBCIMSG K ^TMP("IBCIMSG",$J,IBIFN,"ICD")
|
|
S IBCIMSG=1 D DIAG^IBCIUT1(IBIFN)
|
|
S LITM=0 F S LITM=$O(^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM)) Q:'LITM D
|
|
.S DNUM=0 F S DNUM=$O(^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM)) Q:'DNUM D
|
|
..S X=^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM) D CCK^IBCIUT4(),TCK^IBCIUT4()
|
|
..S ^TMP("IBCIMSG",$J,IBIFN,"ICD",LITM,DNUM)=X
|
|
D INIT1^IBCIMSG1
|
|
Q
|