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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1IBCIMSG1 ;DSI/SLM - BUILD MESSAGE FOR CLAIMSMANAGER CONT'D ;16-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 ;
5INIT1 ;continued from ibcimsg, building the line segments message
6 N I
7 S IBCILSEG=0 F S IBCILSEG=$O(^IBA(351.9,IBIFN,5,IBCILSEG)) Q:'IBCILSEG D
8 .S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,0)) D TCK^IBCIUT4() S NODE50=X
9 .S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,1)) D TCK^IBCIUT4() S NODE51=X
10 .S X=$G(^IBA(351.9,IBIFN,5,IBCILSEG,2)) D TCK^IBCIUT4() S NODE52=X K X
11 .S IBCIXLID(IBCILSEG)=$P(NODE50,U,2)
12 .S X=IBCIXLID(IBCILSEG),X1=25,IBCIXLID(IBCILSEG)=$$FILL^IBCIUT2
13 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,20)=IBCIXLID(IBCILSEG)
14 .S IBCIOGID(IBCILSEG)=$P(NODE50,U,3)
15 .S X=IBCIOGID(IBCILSEG),X1=20,IBCIOGID(IBCILSEG)=$$FILL^IBCIUT2
16 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,21)=IBCIOGID(IBCILSEG)
17 .S IBCIOID(IBCILSEG)=$P(NODE50,U,4)
18 .S X=IBCIOID(IBCILSEG),X1=20,IBCIOID(IBCILSEG)=$$FILL^IBCIUT2
19 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,22)=IBCIOID(IBCILSEG)
20 .S IBCILSTA(IBCILSEG)=$$LSTA^IBCIUT1(IBCISNT)
21 .S X=IBCILSTA(IBCILSEG),X1=3,X4="T",IBCILSTA(IBCILSEG)=$$FILL^IBCIUT2 K X4
22 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,23)=IBCILSTA(IBCILSEG)
23 .S IBCIBDOS(IBCILSEG)=$P(NODE50,U,6)
24 .S X=IBCIBDOS(IBCILSEG),X1=16,IBCIBDOS(IBCILSEG)=$$FILL^IBCIUT2
25 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,24)=IBCIBDOS(IBCILSEG)
26 .S IBCIEDOS(IBCILSEG)=$P(NODE50,U,7)
27 .S X=IBCIEDOS(IBCILSEG),X1=16,IBCIEDOS(IBCILSEG)=$$FILL^IBCIUT2
28 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,25)=IBCIEDOS(IBCILSEG)
29 .S IBCIPOS(IBCILSEG)=$P(NODE50,U,8)
30 .S X=IBCIPOS(IBCILSEG),X1=3,X4="T",IBCIPOS(IBCILSEG)=$$FILL^IBCIUT2 K X4
31 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,26)=IBCIPOS(IBCILSEG)
32 .S IBCISPC(IBCILSEG)=$P(NODE50,U,9)
33 .S X=IBCISPC(IBCILSEG),X1=25,IBCISPC(IBCILSEG)=$$FILL^IBCIUT2
34 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,27)=IBCISPC(IBCILSEG)
35 .S IBCIAPC(IBCILSEG)=$P(NODE50,U,10)
36 .S X=IBCIAPC(IBCILSEG),X1=25,IBCIAPC(IBCILSEG)=$$FILL^IBCIUT2
37 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,28)=IBCIAPC(IBCILSEG)
38 .S IBCISAMT(IBCILSEG)=$P(NODE50,U,11)
39 .;
40 .; esg - 7/5/01 - correct the format of the $ amount
41 .S IBCISAMT(IBCILSEG)=+$TR($FN(IBCISAMT(IBCILSEG),"",2),".")
42 .S X=IBCISAMT(IBCILSEG),X1=15,IBCISAMT(IBCILSEG)=$$FILL^IBCIUT2
43 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,29)=IBCISAMT(IBCILSEG)
44 .S IBCIPAC(IBCILSEG)=$P(NODE50,U,12)
45 .S X=IBCIPAC(IBCILSEG),X1=15,IBCIPAC(IBCILSEG)=$$FILL^IBCIUT2
46 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,30)=IBCIPAC(IBCILSEG)
47 .S IBCISPID(IBCILSEG)=$P(NODE50,U,13)
48 .S X=IBCISPID(IBCILSEG),X1=20,IBCISPID(IBCILSEG)=$$FILL^IBCIUT2
49 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,31)=IBCISPID(IBCILSEG)
50 .S IBCISPLA(IBCILSEG)=$P(NODE51,U,1)
51 .S X=IBCISPLA(IBCILSEG),X1=40,IBCISPLA(IBCILSEG)=$$FILL^IBCIUT2
52 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,32)=IBCISPLA(IBCILSEG)
53 .S IBCISPMI(IBCILSEG)=$P(NODE51,U,2)
54 .S X=IBCISPMI(IBCILSEG),X1=20,IBCISPMI(IBCILSEG)=$$FILL^IBCIUT2
55 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,33)=IBCISPMI(IBCILSEG)
56 .S IBCISPFI(IBCILSEG)=$P(NODE51,U,3)
57 .S X=IBCISPFI(IBCILSEG),X1=20,IBCISPFI(IBCILSEG)=$$FILL^IBCIUT2
58 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,34)=IBCISPFI(IBCILSEG)
59 .S IBCISPTI(IBCILSEG)=$P(NODE51,U,4)
60 .S X=IBCISPTI(IBCILSEG),X1=5,X4="T",IBCISPTI(IBCILSEG)=$$FILL^IBCIUT2 K X4
61 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,35)=IBCISPTI(IBCILSEG)
62 .S IBCISPDE(IBCILSEG)=$P(NODE51,U,5)
63 .S X=IBCISPDE(IBCILSEG),X1=20,IBCISPDE(IBCILSEG)=$$FILL^IBCIUT2
64 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,36)=IBCISPDE(IBCILSEG)
65 .S IBCISPSP(IBCILSEG)=$P(NODE51,U,6)
66 .S X=IBCISPSP(IBCILSEG),X1=10,IBCISPSP(IBCILSEG)=$$FILL^IBCIUT2
67 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,37)=IBCISPSP(IBCILSEG)
68 .S IBCISPDI(IBCILSEG)=$P(NODE51,U,7)
69 .S X=IBCISPDI(IBCILSEG),X1=10,IBCISPDI(IBCILSEG)=$$FILL^IBCIUT2
70 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,38)=IBCISPDI(IBCILSEG)
71 .S IBCISPUP(IBCILSEG)=$P(NODE51,U,8)
72 .S X=IBCISPUP(IBCILSEG),X1=10,IBCISPUP(IBCILSEG)=$$FILL^IBCIUT2
73 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,39)=IBCISPUP(IBCILSEG)
74 .S IBCIBPID(IBCILSEG)=$P(NODE51,U,9)
75 .S X=IBCIBPID(IBCILSEG),X1=20,IBCIBPID(IBCILSEG)=$$FILL^IBCIUT2
76 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,40)=IBCIBPID(IBCILSEG)
77 .S IBCIBPLA(IBCILSEG)=$P(NODE52,U,1)
78 .S X=IBCIBPLA(IBCILSEG),X1=40,IBCIBPLA(IBCILSEG)=$$FILL^IBCIUT2
79 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,41)=IBCIBPLA(IBCILSEG)
80 .S IBCIBPMI(IBCILSEG)=$P(NODE52,U,2)
81 .S X=IBCIBPMI(IBCILSEG),X1=20,IBCIBPMI(IBCILSEG)=$$FILL^IBCIUT2
82 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,42)=IBCIBPMI(IBCILSEG)
83 .S IBCIBPFI(IBCILSEG)=$P(NODE52,U,3)
84 .S X=IBCIBPFI(IBCILSEG),X1=20,IBCIBPFI(IBCILSEG)=$$FILL^IBCIUT2
85 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,43)=IBCIBPFI(IBCILSEG)
86 .S IBCIBPTI(IBCILSEG)=$P(NODE52,U,4)
87 .S X=IBCIBPTI(IBCILSEG),X1=5,X4="T",IBCIBPTI(IBCILSEG)=$$FILL^IBCIUT2 K X4
88 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,44)=IBCIBPTI(IBCILSEG)
89 .S IBCIBPDE(IBCILSEG)=$P(NODE52,U,5)
90 .S X=IBCIBPDE(IBCILSEG),X1=20,X4="T",IBCIBPDE(IBCILSEG)=$$FILL^IBCIUT2 K X4
91 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,45)=IBCIBPDE(IBCILSEG)
92 .S IBCIBPSP(IBCILSEG)=$P(NODE52,U,6)
93 .S X=IBCIBPSP(IBCILSEG),X1=10,IBCIBPSP(IBCILSEG)=$$FILL^IBCIUT2
94 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,46)=IBCIBPSP(IBCILSEG)
95 .S IBCIBPDI(IBCILSEG)=$P(NODE52,U,7)
96 .S X=IBCIBPDI(IBCILSEG),X1=10,IBCIBPDI(IBCILSEG)=$$FILL^IBCIUT2
97 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,47)=IBCIBPDI(IBCILSEG)
98 .S IBCIBPUP(IBCILSEG)=$P(NODE52,U,8)
99 .S X=IBCIBPUP(IBCILSEG),X1=10,IBCIBPUP(IBCILSEG)=$$FILL^IBCIUT2
100 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,48)=IBCIBPUP(IBCILSEG)
101 .S IBCIPPID(IBCILSEG)=$P(NODE52,U,9)
102 .S X=IBCIPPID(IBCILSEG),X1=20,IBCIPPID(IBCILSEG)=$$FILL^IBCIUT2
103 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,49)=IBCIPPID(IBCILSEG)
104 .S IBCISPAI(IBCILSEG)=$P(NODE52,U,10)
105 .S X=IBCISPAI(IBCILSEG),X1=20,IBCISPAI(IBCILSEG)=$$FILL^IBCIUT2
106 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,50)=IBCISPAI(IBCILSEG)
107 .S IBCITOS(IBCILSEG)=$P(NODE52,U,11)
108 .S X=IBCITOS(IBCILSEG),X1=3,X4="T",IBCITOS(IBCILSEG)=$$FILL^IBCIUT2 K X4
109 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,51)=IBCITOS(IBCILSEG)
110 .S IBCIUNIT(IBCILSEG)=$P(NODE52,U,12)
111 .S X=IBCIUNIT(IBCILSEG),X1=5,X4="T",IBCIUNIT(IBCILSEG)=$$FILL^IBCIUT2 K X4
112 .S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,52)=IBCIUNIT(IBCILSEG)
113CPT .;get cpt modifiers
114 .S IBCICPT(IBCILSEG,0)=$P($G(^IBA(351.9,IBIFN,5,IBCILSEG,3)),U)
115 .I IBCICPT(IBCILSEG,0)["," F I=1:1 Q:$P(IBCICPT(IBCILSEG,0),",",I)']"" D
116 ..S IBCICPT(IBCILSEG,I)=$P(IBCICPT(IBCILSEG,0),",",I)
117 .E S IBCICPT(IBCILSEG,1)=IBCICPT(IBCILSEG,0)
118 .S (CT,I)=0 F S I=$O(IBCICPT(IBCILSEG,I)) Q:'I D
119 ..S X=IBCICPT(IBCILSEG,I) D CCK^IBCIUT4(),TCK^IBCIUT4()
120 ..S ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,54,I)=IBCICPT(IBCILSEG,I)
121 ..S CT=CT+1,^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,IBCILSEG,54,0)=CT_U
122Q Q
Note: See TracBrowser for help on using the repository browser.