source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXX16.m@ 619

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

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1IBXX16 ; COMPILED XREF FOR FILE #399.0222 ; 01/03/09
2 ;
3END G ^IBXX16
4 .N DIK,DIV,DIU,DIN
5 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,4)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,4),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,3,1,1,1.4)
6 S X=$P(DIKZ("S"),U,3)
7 I X'="" D
8 .N DIK,DIV,DIU,DIN
9 .X ^DD(399,3,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,5),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,3,1,2,1.4)
10 S DIKZ("S")=$G(^DGCR(399,DA,"S"))
11 S X=$P(DIKZ("S"),U,7)
12 I X'="" S ^DGCR(399,"APM",$E(X,1,30),DA)=""
13 S X=$P(DIKZ("S"),U,9)
14 I X'="" D
15 .N DIK,DIV,DIU,DIN
16 .X ^DD(399,9,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,9,1,1,1.4)
17 S X=$P(DIKZ("S"),U,9)
18 I X'="" D
19 .N DIK,DIV,DIU,DIN
20 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X X ^DD(399,9,1,2,69.2) S X=X="YES",Y=X,X=Y(2),X=X&Y I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,9,1,2,1.4)
21 S X=$P(DIKZ("S"),U,9)
22 I X'="" D
23 .N DIK,DIV,DIU,DIN
24 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y=Y(0) X:$D(^DD(399,9,2)) ^(2) S X=Y="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=3 X ^DD(399,9,1,3,1.4)
25 S X=$P(DIKZ("S"),U,9)
26 I X'="" D
27 .N DIK,DIV,DIU,DIN
28 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$$EXTERNAL^DIDU(399,9,"",Y(0))="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X="" X ^DD(399,9,1,4,1.4)
29 S DIKZ("S")=$G(^DGCR(399,DA,"S"))
30 S X=$P(DIKZ("S"),U,10)
31 I X'="" S ^DGCR(399,"APD3",$E(X,1,30),DA)=""
32 S X=$P(DIKZ("S"),U,12)
33 I X'="" D
34 .N DIK,DIV,DIU,DIN
35 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,14)="" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,14),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,12,1,1,1.4)
36 S X=$P(DIKZ("S"),U,12)
37 I X'="" D
38 .N DIK,DIV,DIU,DIN
39 .X ^DD(399,12,1,2,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=DUZ S DIH=$G(^DGCR(399,DIV(0),"S")),DIV=X S $P(^("S"),U,15)=DIV,DIH=399,DIG=15 D ^DICR
40 S X=$P(DIKZ("S"),U,12)
41 I X'="" D
42 .N DIK,DIV,DIU,DIN
43 .X ^DD(399,12,1,3,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=DUZ S DIH=$G(^DGCR(399,DIV(0),"S")),DIV=X S $P(^("S"),U,13)=DIV,DIH=399,DIG=13 D ^DICR
44 S X=$P(DIKZ("S"),U,12)
45 I X'="" S ^DGCR(399,"AP",$E(X,1,30),DA)=""
46 S DIKZ("S")=$G(^DGCR(399,DA,"S"))
47 S X=$P(DIKZ("S"),U,14)
48 I X'="" D
49 .N DIK,DIV,DIU,DIN
50 .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,13),X=X S DIU=X K Y S X=DIV S X=4 S DIH=$G(^DGCR(399,DIV(0),0)),DIV=X S $P(^(0),U,13)=DIV,DIH=399,DIG=.13 D ^DICR
51 S X=$P(DIKZ("S"),U,14)
52 I X'="" D
53 .N DIK,DIV,DIU,DIN
54 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X=DIV S X=DUZ S DIH=$G(^DGCR(399,DIV(0),"S")),DIV=X S $P(^("S"),U,15)=DIV,DIH=399,DIG=15 D ^DICR
55 S DIKZ("S")=$G(^DGCR(399,DA,"S"))
56 S X=$P(DIKZ("S"),U,16)
57 I X'="" D
58 .N DIK,DIV,DIU,DIN
59 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$$EXTERNAL^DIDU(399,16,"",Y(0))="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,17),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,16,1,1,1.4)
60 S X=$P(DIKZ("S"),U,16)
61 I X'="" D
62 .N DIK,DIV,DIU,DIN
63 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=$$EXTERNAL^DIDU(399,16,"",Y(0))="YES" I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,18),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,16,1,2,1.4)
64 S DIKZ("S")=$G(^DGCR(399,DA,"S"))
65 S X=$P(DIKZ("S"),U,17)
66 I X'="" D
67 .N DIK,DIV,DIU,DIN
68 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,16),X=X S X=X=1 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=7 X ^DD(399,17,1,1,1.4)
69 S DIKZ("TX")=$G(^DGCR(399,DA,"TX"))
70 S X=$P(DIKZ("TX"),U,2)
71 I X'="" S ^DGCR(399,"ALEX",$E(X,1,30),DA)=""
72 S X=$P(DIKZ("TX"),U,5)
73 I X'="" D
74 .N DIK,DIV,DIU,DIN
75 .X ^DD(399,24,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"TX")):^("TX"),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,24,1,1,1.4)
76 S DIKZ("TX")=$G(^DGCR(399,DA,"TX"))
77 S X=$P(DIKZ("TX"),U,6)
78 I X'="" D
79 .N DIK,DIV,DIU,DIN
80 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S X=Y(0),X=X S X=X=1 I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,13),X=X S DIU=X K Y S X=DIV S X=2 X ^DD(399,25,1,1,1.4)
81 S X=$P(DIKZ("TX"),U,6)
82 I X'="" D
83 .N DIK,DIV,DIU,DIN
84 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X X ^DD(399,25,1,2,69.2) S X=X S X=X="",Y=X,X=Y(2),X=X&Y I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,8),X=X S DIU=X K Y S X=DIV S X=DUZ X ^DD(399,25,1,2,1.4)
85 S X=$P(DIKZ("TX"),U,6)
86 I X'="" D
87 .N DIK,DIV,DIU,DIN
88 .K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X X ^DD(399,25,1,3,69.2) S X=X S X=X="",Y=X,X=Y(2),X=X&Y I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"S")):^("S"),1:"") S X=$P(Y(1),U,7),X=X S DIU=X K Y S X=DIV S X=DT X ^DD(399,25,1,3,1.4)
89 S DIKZ("C")=$G(^DGCR(399,DA,"C"))
90 S X=$P(DIKZ("C"),U,14)
91 I X'="" D
92 .N DIK,DIV,DIU,DIN
93 .X ^DD(399,64,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"C")):^("C"),1:"") S X=$P(Y(1),U,10),X=X S DIU=X K Y S X=DIV S X=$P(^ICD9(+X,0),"^",3) X ^DD(399,64,1,1,1.4)
94 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
95 S X=$P(DIKZ("M"),U,1)
96 I X'="" D
97 .N DIK,DIV,DIU,DIN
98 .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,2),X=X S DIU=X K Y S X=DIV S X=$$PRVNUM^IBCU(DA,X,1) X ^DD(399,101,1,1,1.4)
99 S X=$P(DIKZ("M"),U,1)
100 I X'="" D
101 .N DIK,DIV,DIU,DIN
102 .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)
103 S X=$P(DIKZ("M"),U,1)
104 I X'="" D
105 .N DIK,DIV,DIU,DIN
106 .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)
107 S X=$P(DIKZ("M"),U,1)
108 I X'="" D
109 .N DIK,DIV,DIU,DIN
110 .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)
111 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
112 S X=$P(DIKZ("M"),U,2)
113 I X'="" D
114 .N DIK,DIV,DIU,DIN
115 .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)
116 S X=$P(DIKZ("M"),U,2)
117 I X'="" D
118 .N DIK,DIV,DIU,DIN
119 .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)
120 S X=$P(DIKZ("M"),U,2)
121 I X'="" D
122 .N DIK,DIV,DIU,DIN
123 .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)
124 S X=$P(DIKZ("M"),U,2)
125 I X'="" D
126 .N DIK,DIV,DIU,DIN
127 .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)
128 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
129 S X=$P(DIKZ("M"),U,3)
130 I X'="" D
131 .N DIK,DIV,DIU,DIN
132 .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)
133 S X=$P(DIKZ("M"),U,3)
134 I X'="" D
135 .N DIK,DIV,DIU,DIN
136 .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)
137 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
138 S X=$P(DIKZ("M"),U,11)
139 I X'="" D MAILIN^IBCU5
140 S X=$P(DIKZ("M"),U,11)
141 I X'="" S DGRVRCAL=1
142 S X=$P(DIKZ("M"),U,12)
143 I X'="" D
144 .N DIK,DIV,DIU,DIN
145 .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)
146 S X=$P(DIKZ("M"),U,12)
147 I X'="" D IX^IBCNS2(DA,"I1")
148 S X=$P(DIKZ("M"),U,12)
149 I X'="" D
150 .N DIK,DIV,DIU,DIN
151 .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)
152 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
153 S X=$P(DIKZ("M"),U,13)
154 I X'="" D
155 .N DIK,DIV,DIU,DIN
156 .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)
157 S X=$P(DIKZ("M"),U,13)
158 I X'="" D IX^IBCNS2(DA,"I2")
159 S X=$P(DIKZ("M"),U,13)
160 I X'="" D
161 .N DIK,DIV,DIU,DIN
162 .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)
163 S DIKZ("M")=$G(^DGCR(399,DA,"M"))
164 S X=$P(DIKZ("M"),U,14)
165 I X'="" D
166 .N DIK,DIV,DIU,DIN
167 .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)
168 S X=$P(DIKZ("M"),U,14)
169 I X'="" D IX^IBCNS2(DA,"I3")
170 S X=$P(DIKZ("M"),U,14)
171 I X'="" D
172 .N DIK,DIV,DIU,DIN
173 .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)
174 S DIKZ("MP")=$G(^DGCR(399,DA,"MP"))
175 S X=$P(DIKZ("MP"),U,1)
176END G ^IBXX17
Note: See TracBrowser for help on using the repository browser.