- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB00.m
r613 r623 1 IBCEOB00 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003 2 ;;2.0;INTEGRATED BILLING;**155,349,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check - 7 ; Total up outbound line items by revenue code and compare with 8 ; incoming EOB 40 record to see if it has been rolled up 9 ; 10 ; IBZDATA - UB output formatter array, passed by reference 11 ; IB0 - 40 record data 12 ; IBLN - output parameter, passed by reference 13 ; 14 NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH 15 I $P(IB0,U,4)="" G RCRUX 16 S IBLN="",Z=0 17 F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D 18 . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3) 19 . I REV="" Q 20 . ; 21 . S RUD=$G(RUD(REV)) ; roll up data array for rev code 22 . S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges 23 . S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units 24 . S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items 25 . S RUD(REV)=RUD 26 . S RUD(REV,Z)="" 27 . ; 28 . S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code 29 . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges 30 . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units 31 . S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items 32 . S RUD2(REV,UCH)=RUD2 33 . S RUD2(REV,UCH,Z)="" 34 . ; 35 . Q 36 ; 37 I '$D(RUD),'$D(RUD2) G RCRUX 38 ; 39 ; delete the revenue code roll-up, if only 1 line item. 40 S REV="" ; this is not a roll up situation 41 F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV) 42 ; 43 S (REV,UCH)="" 44 F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH) 45 ; 46 I '$D(RUD),'$D(RUD2) G RCRUX 47 ; 48 S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data 49 I RUD="" G RCRU2 ; make sure it exists 50 I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges 51 I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units 52 S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found 53 G RCRUX 54 ; 55 RCRU2 ; check roll-up data by rev code and unit charge 56 S MRAUCH=0 57 I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16) 58 S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data 59 I RUD2="" G RCRUX ; make sure it exists 60 I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges 61 I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units 62 S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found 63 ; 64 RCRUX ; 65 Q 66 ; 67 ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill 68 ; 69 ; Input parameters 70 ; IBEOB - ien to file 361.1 71 ; ICN - the ICN# from the 835 transmission 72 ; COBN - the insurance sequence# 73 ; 74 ; Output parameter 75 ; IBOK - returns as 0 if we get a filing error here 76 ; 77 ; The field in file 399 depends on the current payer sequence 78 ; 399,453 - primary ICN 79 ; 399,454 - secondary ICN 80 ; 399,455 - tertiary ICN 81 ; 82 NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 83 S IBEOB=+$G(IBEOB),COBN=+$G(COBN) 84 I 'IBEOB!'COBN G ICNX 85 S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1) 86 I '$D(^DGCR(399,IBIFN)) G ICNX 87 I $G(ICN)="" G ICNX 88 I '$F(".1.2.3.","."_COBN_".") G ICNX 89 ; 90 S FIELD=452+COBN 91 S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE 92 S IBOK=($D(Y)=0) 93 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file" 94 ICNX ; 95 Q 96 ; 97 15(IB0,IBEGBL,IBEOB) ; Record '15' 98 ; 99 N A,IBOK 100 ; 101 S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0" 102 ; 103 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 104 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15 105 ; 106 ; For Medicare MRA's only: 107 ; If the Covered Amount is present (15 record, piece 3), then file 108 ; a claim level adjustment with Group code=OA, Reason code=AB3. 109 ; 110 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D 111 . N IB20 112 . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000" 113 . S IB20=IB20_U_"Covered Amount" 114 . S IBOK=$$20(IB20,IBEGBL,IBEOB) 115 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount" 116 . K ^TMP($J,20) 117 . Q 118 ; 119 Q15 Q IBOK 120 ; 121 20(IB0,IBEGBL,IBEOB) ; Record '20' 122 ; 123 N A,LEVEL,IBGRP,IBDA,IBOK 124 ; 125 S IBGRP=$P(IB0,U,3) 126 I IBGRP'="" S ^TMP($J,20)=IBGRP 127 I IBGRP="" S IBGRP=$G(^TMP($J,20)) 128 I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20 129 ; 130 S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0)) 131 ; 132 I 'IBDA(1) D ;Needs a new entry at group level 133 . N X,Y,DA,DD,DO,DIC,DLAYGO 134 . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB 135 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10) 136 . S X=IBGRP 137 . D FILE^DICN K DIC,DO,DD,DLAYGO 138 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q 139 . S IBDA(1)=+Y 140 ; 141 I $G(IBDA(1)) D ;Add a new entry at the reason code level 142 . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1) 143 . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1) 144 . S X=$P(IB0,U,4) 145 . D FILE^DICN K DIC,DO,DD,DLAYGO 146 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q 147 . S IBDA=+Y 148 ; 149 I $G(IBDA) D 150 . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1," 151 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB 152 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0" 153 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) 154 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q 155 Q20 Q $G(IBOK) 156 ; 157 35(IB0,IBEGBL,IBEOB) ; Record '35' 158 ; 159 N A,IBOK 160 ; 161 S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0" 162 ; 163 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 164 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data" 165 Q35 Q $G(IBOK) 166 ; 167 37(IB0,IBEGBL,IBEOB) ; Record '37' 168 ; 169 N IBOK,IBCT 170 S IBCT=$G(^TMP($J,37))+1 171 I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed 172 S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0" 173 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 174 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data" 175 ; 176 ; 4/22/03 - esg - If claim level remark code MA15 is reported, then 177 ; this is a split EOB and we need to change the REVIEW STATUS 178 ; of this EOB to be ACCEPTED-INTERIM EOB. 179 ; 180 I $P(IB0,U,4)["MA15" D 181 . N DA,DIE,DR,DIC 182 . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0) 183 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly" 184 . Q 185 ; 186 Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records 187 Q $G(IBOK) 188 ; 189 ; 190 DET40(IB0,ARRAY) ; Format important details of record 40 for error 191 ; IB0 = data on 40 record (some pieces pre-formatted) 192 ; ARRAY(n)=formatted line is returned if passed by ref 193 N Q 194 S ARRAY(1)="Payer reported the following was billed to them:" 195 S ARRAY(2)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"Same as adjudicated")_" Chg: "_$J($P(IB0,U,15)/100,"",2)_" Units: "_$S($P(IB0,U,16):$P(IB0,U,16),1:1) 196 S ARRAY(3)=" Svc Date(s): "_$S($P(IB0,U,19)'="":$$FDT($P(IB0,U,19)),1:"??")_$S($P(IB0,U,20)'="":"-"_$$FDT($P(IB0,U,20)),1:"") 197 I $P(IB0,U,11)'="" S ARRAY(3)=ARRAY(3)_" Mods: " F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(3)=ARRAY(3)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"") 198 S ARRAY(4)="Payer reported adjudication on:" 199 S ARRAY(5)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IB0,U,4)) 200 S ARRAY(5)=ARRAY(5)_" Type: "_$P(IB0,U,21)_$S($P(IB0,U,21)'="NU":" Rev Cd: "_$P(IB0,U,4),1:"")_" Units: "_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)_" Amt: "_$J($P(IB0,U,17)/100,"",2) 201 I $P(IB0,U,5)'="" S ARRAY(5)=ARRAY(5)_" Mods: " F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(5)=ARRAY(5)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"") 202 Q 203 ; 204 DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-45 for error 205 ; RECID = 41,42,45 206 ; IB0 = data on RECID record 207 ; ARRAY(n)=formatted line is returned if passed by ref 208 N CT,Q 209 I RECID=41 D Q 210 . S ARRAY(1)="Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2) 211 ; 212 I RECID=42 D Q 213 . S ARRAY(1)="Line Item Remark Code: "_$P(IB0,U,3) 214 . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80) 215 ; 216 I RECID=45 D 217 . S ARRAY(1)="Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6) 218 . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80) 219 Q 220 ; 221 FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY 222 S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4) 223 Q X 224 ; 1 IBCEOB00 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003 2 ;;2.0;INTEGRATED BILLING;**155,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check - 7 ; Total up outbound line items by revenue code and compare with 8 ; incoming EOB 40 record to see if it has been rolled up 9 ; 10 ; IBZDATA - UB output formatter array, passed by reference 11 ; IB0 - 40 record data 12 ; IBLN - output parameter, passed by reference 13 ; 14 NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH 15 I $P(IB0,U,4)="" G RCRUX 16 S IBLN="",Z=0 17 F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D 18 . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3) 19 . I REV="" Q 20 . ; 21 . S RUD=$G(RUD(REV)) ; roll up data array for rev code 22 . S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges 23 . S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units 24 . S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items 25 . S RUD(REV)=RUD 26 . S RUD(REV,Z)="" 27 . ; 28 . S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code 29 . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges 30 . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units 31 . S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items 32 . S RUD2(REV,UCH)=RUD2 33 . S RUD2(REV,UCH,Z)="" 34 . ; 35 . Q 36 ; 37 I '$D(RUD),'$D(RUD2) G RCRUX 38 ; 39 ; delete the revenue code roll-up, if only 1 line item. 40 S REV="" ; this is not a roll up situation 41 F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV) 42 ; 43 S (REV,UCH)="" 44 F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH) 45 ; 46 I '$D(RUD),'$D(RUD2) G RCRUX 47 ; 48 S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data 49 I RUD="" G RCRU2 ; make sure it exists 50 I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges 51 I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units 52 S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found 53 G RCRUX 54 ; 55 RCRU2 ; check roll-up data by rev code and unit charge 56 S MRAUCH=0 57 I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16) 58 S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data 59 I RUD2="" G RCRUX ; make sure it exists 60 I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges 61 I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units 62 S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found 63 ; 64 RCRUX ; 65 Q 66 ; 67 ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill 68 ; 69 ; Input parameters 70 ; IBEOB - ien to file 361.1 71 ; ICN - the ICN# from the 835 transmission 72 ; COBN - the insurance sequence# 73 ; 74 ; Output parameter 75 ; IBOK - returns as 0 if we get a filing error here 76 ; 77 ; The field in file 399 depends on the current payer sequence 78 ; 399,453 - primary ICN 79 ; 399,454 - secondary ICN 80 ; 399,455 - tertiary ICN 81 ; 82 NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y 83 S IBEOB=+$G(IBEOB),COBN=+$G(COBN) 84 I 'IBEOB!'COBN G ICNX 85 S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1) 86 I '$D(^DGCR(399,IBIFN)) G ICNX 87 I $G(ICN)="" G ICNX 88 I '$F(".1.2.3.","."_COBN_".") G ICNX 89 ; 90 S FIELD=452+COBN 91 S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE 92 S IBOK=($D(Y)=0) 93 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file" 94 ICNX ; 95 Q 96 ; 97 35(IB0,IBEGBL,IBEOB) ; Record '35' 98 ; 99 N A,IBOK 100 ; 101 S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0" 102 ; 103 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 104 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data" 105 Q35 Q $G(IBOK) 106 ; 107 37(IB0,IBEGBL,IBEOB) ; Record '37' 108 ; 109 N IBOK,IBCT 110 S IBCT=$G(^TMP($J,37))+1 111 I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed 112 S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0" 113 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) 114 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data" 115 ; 116 ; 4/22/03 - esg - If claim level remark code MA15 is reported, then 117 ; this is a split EOB and we need to change the REVIEW STATUS 118 ; of this EOB to be ACCEPTED-INTERIM EOB. 119 ; 120 I $P(IB0,U,4)["MA15" D 121 . N DA,DIE,DR,DIC 122 . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0) 123 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly" 124 . Q 125 ; 126 Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records 127 Q $G(IBOK) 128 ; 129 ; 130 DET40(IB0,ARRAY) ; Format important details of record 40 for error 131 ; IB0 = data on 40 record (some pieces pre-formatted) 132 ; ARRAY(n)=formatted line is returned if passed by ref 133 N Q 134 S ARRAY(1)="Payer reported the following was billed to them:" 135 S ARRAY(2)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"Same as adjudicated")_" Chg: "_$J($P(IB0,U,15)/100,"",2)_" Units: "_$S($P(IB0,U,16):$P(IB0,U,16),1:1) 136 S ARRAY(3)=" Svc Date(s): "_$S($P(IB0,U,19)'="":$$FDT($P(IB0,U,19)),1:"??")_$S($P(IB0,U,20)'="":"-"_$$FDT($P(IB0,U,20)),1:"") 137 I $P(IB0,U,11)'="" S ARRAY(3)=ARRAY(3)_" Mods: " F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(3)=ARRAY(3)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"") 138 S ARRAY(4)="Payer reported adjudication on:" 139 S ARRAY(5)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IB0,U,4)) 140 S ARRAY(5)=ARRAY(5)_" Type: "_$P(IB0,U,21)_$S($P(IB0,U,21)'="NU":" Rev Cd: "_$P(IB0,U,4),1:"")_" Units: "_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)_" Amt: "_$J($P(IB0,U,17)/100,"",2) 141 I $P(IB0,U,5)'="" S ARRAY(5)=ARRAY(5)_" Mods: " F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(5)=ARRAY(5)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"") 142 Q 143 ; 144 DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-45 for error 145 ; RECID = 41,42,45 146 ; IB0 = data on RECID record 147 ; ARRAY(n)=formatted line is returned if passed by ref 148 N CT,Q 149 I RECID=41 D Q 150 . S ARRAY(1)="Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2) 151 ; 152 I RECID=42 D Q 153 . S ARRAY(1)="Line Item Remark Code: "_$P(IB0,U,3) 154 . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80) 155 ; 156 I RECID=45 D 157 . S ARRAY(1)="Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6) 158 . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80) 159 Q 160 ; 161 FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY 162 S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4) 163 Q X 164 ; 165 UPDNM(IBEOB,IB0,IBBULL,IBDR) ; Update name on claim if it comes back changed 166 ; IBEOB = the internal entry # of the entry in file 361.1 167 ; IB0 = the raw data returned from the 835 flat file 168 ; IBBULL = holds result of name change check in piece 1 - if name 169 ; changed, first '^' piece is 1, 3rd '^' piece is the old 170 ; insured's name 171 ; IBDR = returned as the updated 'DR' string with the name changed 172 ; fields to use to update the EOB file (361.1) - pass by reference 173 ; 174 N IBCHGED,IBIFN,IBNEW,IBCOB,DIE,DR,X,Y 175 I $P(IB0,U,7) D 176 . S IBNEW=$P(IB0,U,3)_","_$P(IB0,U,4)_$S($P(IB0,U,5)'="":" "_$P(IB0,U,5),1:""),$P(IBBULL,U)=1 177 . S IBCOB=+$P($G(^IBM(361.1,IBEOB,0)),U,15) 178 . S IBIFN=+$G(^IBM(361.1,+IBEOB,0)) 179 . S IB=$G(^DGCR(399,IBIFN,"I"_IBCOB)) 180 . ; 181 . I IB'="",$P(IB,U,17)'=IBNEW D 182 .. ; Update the claim data only 183 .. S $P(IBBULL,U,3)=$P(IB,U,17) ; save old value 184 .. S $P(IB,U,17)=IBNEW 185 .. S DIE="^DGCR(399,",DA=IBIFN,DR="30"_IBCOB_"////"_IB 186 .. D:DA ^DIE 187 .. S IBCHGED=1 188 . S IBDR=$G(IBDR)_"6.01////"_$P(IB0,U,3)_","_$P(IB0,U,4)_" "_$P(IB0,U,5)_";" 189 ; 190 Q $G(IBCHGED) 191 ; 192 UPDID(IBEOB,IB0,IBBULL,IBDR) ; Update id # on claim and policy if it comes back 193 ; changed 194 ; IBEOB = the internal entry # of the entry in file 361.1 195 ; IB0 = the raw data returned from the 835 flat file 196 ; IBBULL = holds result of id change check in piece 2 - if id changed, 197 ; second '^' piece = 1,4th '^' piece is the old insured's id 198 ; IBDR = returned as the updated 'DR' string with the id changed fields 199 ; to use to update the EOB file (361.1) - pass by reference 200 ; 201 N IBCHGED,IBNEW,IBCOB,IB,DIE,DR,DA,X,Y 202 I $P(IB0,U,8) D 203 . S IBNEW=$P(IB0,U,6),$P(IBBULL,U,2)=1 204 . S IBIFN=+$G(^IBM(361.1,+IBEOB,0)) 205 . S IBCOB=+$P($G(^IBM(361.1,IBEOB,0)),U,15) 206 . S IB=$G(^DGCR(399,IBIFN,"I"_IBCOB)) 207 . ; 208 . I IB'="",$P(IB,U,2)'=IBNEW D 209 .. ; Update the claim 210 .. S $P(IBBULL,U,4)=$P(IB,U,2) ; save old value 211 .. S $P(IB,U,2)=IBNEW 212 .. S DIE="^DGCR(399,",DA=IBIFN,DR="30"_IBCOB_"////"_IB D ^DIE 213 .. ; 214 .. ; Update the policy 215 .. S DA(1)=$P($G(^DGCR(399,IBIFN,0)),U,2),DA=$P($G(^("M")),U,(11+IBCOB)),DR="1////"_IBNEW,DIE="^DPT("_DA(1)_",.312," 216 .. I DA(1),DA D ^DIE 217 .. S IBCHGED=1 218 . S IBDR=$G(IBDR)_"6.02////"_$P(IB0,U,6)_";" 219 ; 220 Q $G(IBCHGED) 221 ;
Note:
See TracChangeset
for help on using the changeset viewer.
