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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1IBCIMSG ;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 ;
5EN ;
6 KILL ^TMP("IBCIMSG",$J) ; kill scratch global before building it
7 Q:'$D(IBIFN)
8 D INIT
9 Q
10 ;
11INIT ;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
58ICD9 ;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
Note: See TracBrowser for help on using the repository browser.