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

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1IBXX17 ; COMPILED XREF FOR FILE #399.0222 ; 07/22/08
2 ;
3 I X'="" D
4 .N DIK,DIV,DIU,DIN
5 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $$COBN^IBCEF(DA)=1 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(399,101,1,2,1.1) X ^DD(399,101,1,2,1.4)
6 S X=$P(DIKZ("M"),U,1)
7 I X'="" D
8 .N DIK,DIV,DIU,DIN
9 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$S($$MCRWNR^IBEFUNC(X):$$COBN^IBCEF(DA)=1,1:0) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X="" X ^DD(399,101,1,3,1.4)
10 S X=$P(DIKZ("M"),U,1)
11 I X'="" D
12 .N DIK,DIV,DIU,DIN
13 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=$$PRVQUAL^IBCU(DA,X,1) X ^DD(399,101,1,4,1.4)
14 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
15 S X=$P(DIKZ("M"),U,2)
16 I X'="" D
17 .N DIK,DIV,DIU,DIN
18 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=$$PRVNUM^IBCU(DA,X,2) X ^DD(399,102,1,2,1.4)
19 S X=$P(DIKZ("M"),U,2)
20 I X'="" D
21 .N DIK,DIV,DIU,DIN
22 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $$COBN^IBCEF(DA)=2 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y X ^DD(399,102,1,3,1.1) X ^DD(399,102,1,3,1.4)
23 S X=$P(DIKZ("M"),U,2)
24 I X'="" D
25 .N DIK,DIV,DIU,DIN
26 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$S($$MCRWNR^IBEFUNC(X):$$COBN^IBCEF(DA)=2,1:0) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X="" X ^DD(399,102,1,4,1.4)
27 S X=$P(DIKZ("M"),U,2)
28 I X'="" D
29 .N DIK,DIV,DIU,DIN
30 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X=DIV S X=$$PRVQUAL^IBCU(DA,X,2) X ^DD(399,102,1,5,1.4)
31 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
32 S X=$P(DIKZ("M"),U,3)
33 I X'="" D
34 .N DIK,DIV,DIU,DIN
35 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=$$PRVNUM^IBCU(DA,X,3) X ^DD(399,103,1,2,1.4)
36 S X=$P(DIKZ("M"),U,3)
37 I X'="" D
38 .N DIK,DIV,DIU,DIN
39 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M1")):^("M1"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV S X=$$PRVQUAL^IBCU(DA,X,3) X ^DD(399,103,1,3,1.4)
40 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
41 S X=$P(DIKZ("M"),U,11)
42 I X'="" D MAILIN^IBCU5
43 S X=$P(DIKZ("M"),U,11)
44 I X'="" S DGRVRCAL=1
45 S X=$P(DIKZ("M"),U,12)
46 I X'="" D
47 .N DIK,DIV,DIU,DIN
48 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(399,112,1,1,1.1) X ^DD(399,112,1,1,1.4)
49 S X=$P(DIKZ("M"),U,12)
50 I X'="" D IX^IBCNS2(DA,"I1")
51 S X=$P(DIKZ("M"),U,12)
52 I X'="" D
53 .N DIK,DIV,DIU,DIN
54 .X ^DD(399,112,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=$$BPP^IBCNS2(DA,1) X ^DD(399,112,1,3,1.4)
55 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
56 S X=$P(DIKZ("M"),U,13)
57 I X'="" D
58 .N DIK,DIV,DIU,DIN
59 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y X ^DD(399,113,1,1,1.1) X ^DD(399,113,1,1,1.4)
60 S X=$P(DIKZ("M"),U,13)
61 I X'="" D IX^IBCNS2(DA,"I2")
62 S X=$P(DIKZ("M"),U,13)
63 I X'="" D
64 .N DIK,DIV,DIU,DIN
65 .X ^DD(399,113,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=$$BPP^IBCNS2(DA,1) X ^DD(399,113,1,3,1.4)
66 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
67 S X=$P(DIKZ("M"),U,14)
68 I X'="" D
69 .N DIK,DIV,DIU,DIN
70 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"M")):^("M"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y X ^DD(399,114,1,1,1.1) X ^DD(399,114,1,1,1.4)
71 S X=$P(DIKZ("M"),U,14)
72 I X'="" D IX^IBCNS2(DA,"I3")
73 S X=$P(DIKZ("M"),U,14)
74 I X'="" D
75 .N DIK,DIV,DIU,DIN
76 .X ^DD(399,114,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=$$BPP^IBCNS2(DA) X ^DD(399,114,1,3,1.4)
77 S DIKZ("MP")=$G(^DGCR(399,DA,"MP"))
78 S X=$P(DIKZ("MP"),U,1)
79 I X'="" D
80 .N DIK,DIV,DIU,DIN
81 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,19),X=X S DIU=X K Y S X=DIV S X=$$FT^IBCU3(DA,1) X ^DD(399,135,1,2,1.4)
82 S X=$P(DIKZ("MP"),U,1)
83 I X'="" D MAILA^IBCU5
84 S X=$P(DIKZ("MP"),U,1)
85 I X'="" S DGRVRCAL=1
86 S DIKZ("MP")=$G(^DGCR(399,DA,"MP"))
87 S X=$P(DIKZ("MP"),U,2)
88 I X'="" D
89 .N DIK,DIV,DIU,DIN
90 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X='$$WNRBILL^IBEFUNC(DA) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"MP")):^("MP"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y X ^DD(399,136,1,1,1.1) X ^DD(399,136,1,1,1.4)
91 S DIKZ("U")=$G(^DGCR(399,DA,"U"))
92 S X=$P(DIKZ("U"),U,1)
93 I X'="" D
94 .N DIK,DIV,DIU,DIN
95 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),U,5)<3 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$LOS1^IBCU64(DA) X ^DD(399,151,1,1,1.4)
96 S X=$P(DIKZ("U"),U,1)
97 I X'="" S DGRVRCAL=1
98 S X=$P(DIKZ("U"),U,1)
99 I X'="" D
100 .N DIK,DIV,DIU,DIN
101 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I +$G(^DGCR(399,DA,"U1"))=0 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,1),X=X S DIU=X K Y S X=DIV S X=0 X ^DD(399,151,1,3,1.4)
102 S X=$P(DIKZ("U"),U,1)
103 I X'="" S:$P(^DGCR(399,DA,0),"^",2) ^DGCR(399,"APDS",$P(^(0),U,2),-X,DA)=""
104 S DIKZ("U")=$G(^DGCR(399,DA,"U"))
105 S X=$P(DIKZ("U"),U,2)
106 I X'="" D
107 .N DIK,DIV,DIU,DIN
108 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X I $P(^DGCR(399,DA,0),U,5)<3 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=$$LOS1^IBCU64(DA) X ^DD(399,152,1,1,1.4)
109 S X=$P(DIKZ("U"),U,2)
110 I X'="" S DGRVRCAL=1
111 S DIKZ("U")=$G(^DGCR(399,DA,"U"))
112 S X=$P(DIKZ("U"),U,11)
113 I X'="" D
114 .N DIK,DIV,DIU,DIN
115 .X ^DD(399,161,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U")):^("U"),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV D DIS^IBCU S X=X S DIH=$G(^DGCR(399,DIV(0),"U")),DIV=X S $P(^("U"),U,12)=DIV,DIH=399,DIG=162 D ^DICR
116 S DIKZ("U")=$G(^DGCR(399,DA,"U"))
117 S X=$P(DIKZ("U"),U,15)
118 I X'="" D
119 .N DIK,DIV,DIU,DIN
120 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=($P($G(^DGCR(399,DA,"U2")),U,2)=""&$$INPAT^IBCEF(DA,1)) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U2")):^("U2"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIV X ^DD(399,165,1,1,1.4)
121 S X=$P(DIKZ("U"),U,15)
122 I X'="" D
123 .N DIK,DIV,DIU,DIN
124 .X ^DD(399,165,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"U2")):^("U2"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV N Z S X=$$LOS1^IBCU64(DA,.Z),X=+$G(Z) X ^DD(399,165,1,2,1.4)
125 S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
126 S X=$P(DIKZ("U2"),U,4)
127 I X'="" D
128 .N DIK,DIV,DIU,DIN
129 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,218,1,1,1.4)
130 S X=$P(DIKZ("U2"),U,4)
131 I X'="" D
132 .N DIK,DIV,DIU,DIN
133 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X="PRIOR PAYMENT(S)" X ^DD(399,218,1,2,1.4)
134 S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
135 S X=$P(DIKZ("U2"),U,5)
136 I X'="" D
137 .N DIK,DIV,DIU,DIN
138 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,219,1,1,1.4)
139 S X=$P(DIKZ("U2"),U,5)
140 I X'="" D
141 .N DIK,DIV,DIU,DIN
142 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X="PRIOR PAYMENT(S)" X ^DD(399,219,1,2,1.4)
143 S DIKZ("U2")=$G(^DGCR(399,DA,"U2"))
144 S X=$P(DIKZ("U2"),U,6)
145 I X'="" D
146 .N DIK,DIV,DIU,DIN
147 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"U1")):^("U1"),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X=DIV S X=DIU+DIV X ^DD(399,220,1,1,1.4)
148 S X=$P(DIKZ("U2"),U,6)
149END G ^IBXX18
Note: See TracBrowser for help on using the repository browser.