source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIMSG.m@ 1671

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