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

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

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1IBCEOB0 ;ALB/TMP - 835 EDI EOB MSG PROCESSING ;18-FEB-99
2 ;;2.0;INTEGRATED BILLING;**135,280,155**;21-MAR-94
3 Q
4 ;
530(IB0,IBEOB,IBOK) ; Process record type 30 for EOB
6 ; IB0 = the record being processed
7 ; IBEOB = the ien of the EOB entry in file 361.1
8 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
9 ;
10 N A
11 S A="3;4.01;0;1;1^5;4.02;0;1;1^6;4.03;1;0;0^7;4.05;1;0;0^8;4.06;1;0;0^9;4.07;1;0;0^10;4.08;1;0;0^11;4.09;1;0;0^12;4.1;1;0;0^13;4.11;1;0;0^14;4.19;0;1;1"
12 ;
13 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
14 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
15Q30 Q
16 ;
1740(IB0,IBEOB,IBOK) ; Process record type 40 for EOB
18 ; IB0 = the record being processed
19 ; IBEOB = the ien of the EOB entry in file 361.1
20 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
21 ;
22 ; IBZDATA is also assumed to exist or if not, it is created in FINDLN
23 ;
24 N A,LEVEL,IBSEQ,IBDA,IBPC,IBLREF,IBIFN,Q,X,Y,DA,DD,DO,DIC,DLAYGO
25 K ^TMP($J,40) ; the entry # for corresponding 41, 42, and 45 records
26 ;
27 S IBIFN=+$G(^IBM(361.1,IBEOB,0))
28 L +^IBM(361.1,IBEOB,15):0 I $T S IBSEQ=+$O(^IBM(361.1,IBEOB,15," "),-1)+1
29 I '$G(IBSEQ) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Record lock failure - could not acquire next service line number" G Q40
30 ;
31 ; Update the 40 record data a little bit (pieces 3/4/16)
32 I $P(IB0,U,21)="NU" S $P(IB0,U,4)=$P(IB0,U,3),$P(IB0,U,3)=""
33 S $P(IB0,U,16)=$S(+$P(IB0,U,16):$P(IB0,U,16)/100,1:+$P(IB0,U,18)/100)
34 I $P(IB0,U,4)?1.N S $P(IB0,U,4)=+$P(IB0,U,4)
35 ;
36 ; Find the line item from original bill for this adjustment
37 S IBLREF=+$$FINDLN^IBCEOB1(IB0,IBEOB,.IBZDATA)
38 I 'IBLREF D G Q40
39 . N Z,Z0,CT
40 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line detail could not be matched to a billed item"
41 . D DET40^IBCEOB00(IB0,.Z0)
42 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
43 ;
44 S DIC="^IBM(361.1,"_IBEOB_",15,",DIC(0)="L",DLAYGO=361.115,DA(1)=IBEOB
45 S X=IBSEQ
46 S DIC("DR")=".12////"_+IBLREF_$S($P(IBLREF,U,2)="":"",1:";.15////"_$P(IBLREF,U,2))_";.16////"_$$DATE^IBCEU($P(IB0,U,19))_$S($P(IB0,U,20):";.17////"_$$DATE^IBCEU($P(IB0,U,20)),1:"")
47 D FILE^DICN K DIC,DO,DD,DLAYGO ;Add a new LINE LEVEL ADJUSTMENT ('SVC')
48 I Y<0 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add a LINE LEVEL ADJUSTMENT ("_IBSEQ_")" G Q40
49 ;
50 L -^IBM(361.1,IBEOB,15)
51 ;
52 S LEVEL=15.1,LEVEL(0)=+Y,LEVEL(1)=IBEOB,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"
53 S A="3;.04;0;0;0^4;.1;0;0;0^9;.09;0;0;0^17;.03;1;0;0^18;.11;0;1;D2^21;.18;0;0;0"
54 I '$P(IB0,U,18),$P(IB0,U,16) S $P(A,U,5)="16;.11;0;1;1"
55 I $$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) S ^TMP($J,40)=LEVEL(0),IBOK=1
56 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for line level adjustment "_IBSEQ G Q40
57 ;
58 ; Store modifiers in multiple
59 S DIC="^IBM(361.1,"_IBEOB_",15,"_LEVEL(0)_",2,",DIC(0)="L",DLAYGO=361.1152,DA(2)=IBEOB,DA(1)=LEVEL(0)
60 F Q=5:1:8 S X=$P(IB0,U,Q) I X'="" D FILE^DICN K DO,DD I Y<0 S IBOK=0 Q
61 K DLAYGO,DIC,DR,DA
62 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file modifier data for line level adjustment "_IBSEQ G Q40
63Q40 Q
64 ;
6541(IB0,IBEOB,IBOK) ; Process record type 41 for EOB
66 ; IB0 = the record being processed
67 ; IBEOB = the ien of the EOB entry in file 361.1
68 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
69 ;
70 N DA,DR,DIE,X,Y,Z,Z0,CT
71 I '$G(^TMP($J,40)) D G Q41
72 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
73 . D DET4X^IBCEOB00(41,IB0,.Z0)
74 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
75 ;
76 S DR="",IBOK=1
77 S DA=+^TMP($J,40),DA(1)=IBEOB
78 S DIE="^IBM(361.1,"_DA(1)_",15,"
79 I +$P(IB0,U,3) S DR=".13///"_$$DOLLAR^IBCEOB($P(IB0,U,3))
80 I +$P(IB0,U,4) S DR=DR_$S(DR="":"",1:";")_".14///"_$$DOLLAR^IBCEOB($P(IB0,U,4))
81 I DR'="" D ^DIE S IBOK=($D(Y)=0)
82 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for service line adjustment-2"
83 ;
84 ; For Medicare MRA's only:
85 ; If the Allowed Amount field is present, then we need to file an
86 ; adjustment: Group code PR, Reason code AAA, Amount, Quantity, and
87 ; Reason Text. This is data normally found on the 45 record, so we're
88 ; going to create our own "45" record and file it.
89 ;
90 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
91 . N IB45,IBSAV40
92 . S IB45=45_U_$P(IB0,U,2)_U_"PR"_U_"AAA"_U_$P(IB0,U,3)_U_"0000000001"
93 . S IB45=IB45_U_"Allowed Amount"
94 . S IBSAV40=$G(^TMP($J,40))
95 . D 45(IB45,IBEOB,.IBOK)
96 . S ^TMP($J,40)=IBSAV40
97 . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the PR-AAA adjustment for the Allowed Amount at line "_+^TMP($J,40)
98 . Q
99 ;
100Q41 Q
101 ;
10242(IB0,IBEOB,IBOK) ; Process record type 42 for EOB
103 ; IB0 = the record being processed
104 ; IBEOB = the ien of the EOB entry in file 361.1
105 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
106 ;
107 N DO,DD,DLAYGO,DIC,DA,X,Y,Z,Z0,CT
108 S IBOK=0
109 I '$G(^TMP($J,40)) D G Q42
110 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
111 . D DET4X^IBCEOB00(42,IB0,.Z0)
112 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
113 ;
114 K DO,DD,DLAYGO
115 S IBOK=1
116 S DA(1)=+^TMP($J,40),DA(2)=IBEOB
117 S X=+$O(^IBM(361.1,DA(2),15,DA(1),4," "),-1)+1,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L",DLAYGO=361.1154
118 S DIC("DR")=$S($P(IB0,U,3)'="":".02////"_$P(IB0,U,3),1:"")
119 S DIC("DR")=DIC("DR")_$S($P(IB0,U,4)'="":$S($L(DIC("DR")):";",1:"")_".03////"_$TR($P(IB0,U,4),";"," "))
120 D FILE^DICN K DO,DD,DLAYGO
121 I Y'>0 S IBOK=0
122 I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for service line adjustment-3"
123 ;
124 ; For Medicare MRA's only:
125 ; Process and store the line level remark code as an LQ kludge line
126 ; level adjustment.
127 ;
128 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,$P(IB0,U,3)'="" D
129 . N IB45,IBSAV40
130 . S IB45=45_U_$P(IB0,U,2)_U_"LQ"_U_$P(IB0,U,3)_U_0_U_0_U_$P(IB0,U,4)
131 . S IBSAV40=$G(^TMP($J,40))
132 . D 45(IB45,IBEOB,.IBOK)
133 . S ^TMP($J,40)=IBSAV40
134 . I '$G(IBOK) S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the LQ-remark code adjustment at line "_+^TMP($J,40)
135 . Q
136Q42 Q
137 ;
13845(IB0,IBEOB,IBOK) ; Process record type 45 for EOB
139 ; IB0 = the record being processed
140 ; IBEOB = the ien of the EOB entry in file 361.1
141 ; IBOK = Returned as 1 if record filed OK, 0 if error occurred
142 ;
143 N IBDA,LEVEL,A,Z0,CT,Z
144 I '$G(^TMP($J,40)) D G Q45
145 . S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment has no corresponding service line"
146 . D DET4X^IBCEOB00(45,IB0,.Z0)
147 . S CT=+$O(^TMP(IBEGBL,$J,""),-1),Z=0 F S Z=$O(Z0(Z)) Q:'Z S CT=CT+1,^TMP(IBEGBL,$J,CT)=Z0(Z)
148 ;
149 I $P(IB0,U,3)'="" S $P(^TMP($J,40),U,2)=$P(IB0,U,3)
150 I $P(IB0,U,3)="" S $P(IB0,U,3)=$P(^TMP($J,40),U,2)
151 I $P(IB0,U,3)="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Service line adjustment is missing its group code" G Q45
152 ;
153 S IBDA(2)=+^TMP($J,40)
154 S IBDA(1)=+$O(^IBM(361.1,IBEOB,15,IBDA(2),1,"B",$P(IB0,U,3),0))
155 ;
156 I 'IBDA(1) D ;Needs a new entry at group level
157 . N X,Y,DA,DD,DO,DIC,DLAYGO
158 . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,",DIC(0)="L",DLAYGO=361.1151,DA(2)=IBEOB,DA(1)=IBDA(2)
159 . S DIC("P")=$$GETSPEC^IBEFUNC(361.115,1)
160 . S X=$P(IB0,U,3)
161 . D FILE^DICN K DIC,DO,DD,DLAYGO
162 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
163 . S IBDA(1)=+Y
164 ;
165 ;Add a new entry at the reason code level
166 I $G(IBDA(1)) D
167 . S DIC="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.11511,DA(1)=IBDA(1),DA(2)=IBDA(2),DA(3)=IBEOB
168 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1151,1)
169 . S X=$P(IB0,U,4)
170 . D FILE^DICN K DIC,DO,DD,DLAYGO
171 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not add reason code ("_$P(IB0,U,4)_") for adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
172 . S IBDA=+Y
173 ;
174 I $G(IBDA) D
175 . S LEVEL=15,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",15,"_IBDA(2)_",1,"_IBDA(1)_",1,"
176 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBDA(2),LEVEL(3)=IBEOB
177 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
178 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
179 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad data for reason code ("_$P(IB0,U,4)_"), adjustment group code ("_$P(IB0,U,3)_") at line adjustment "_+^TMP($J,40) Q
180 ;
181Q45 Q
182 ;
Note: See TracBrowser for help on using the repository browser.