- 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/IBCEU6.m
r613 r623 1 IBCEU6 ;ALB/ESG - EDI UTILITIES FOR EOB PROCESSING ;29-JUL-2003 2 ;;2.0;INTEGRATED BILLING;**155,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ; 6 COBLINE(IBIFN,IBI,IBXDATA,SORT,IBXTRA) ; Extract all COB data for line item 7 ; from file 361.1 (EOB), subfile 15 into IBXDATA(IBI,"COB",n) 8 ; 9 ; IBIFN = bill entry # 10 ; IBI = VistA outbound line item # 11 ; IBXDATA = array returned with COB line item data/pass by reference 12 ; SORT = flag that determines whether the data should be sorted for 13 ; output for the 837 record ('PR' group always there and has 14 ; a reason code for deductible first and co-insurance second - 15 ; even if they are 0). 16 ; 1 = sort, 0 = no sort needed 17 ; 18 ; Returns IBXDATA(IBI,"COB",COB,n) with COB data for each line item 19 ; found in an accepted EOB for the bill and = the '0' node data of 20 ; file 361.115 (LINE LEVEL ADJUSTMENTS) 21 ; -- AND -- 22 ; IBXDATA(IBI,"COB",COB,n,z,p)= 23 ; the data on the '0' node for each subordinate entry of file 24 ; 361.11511 (REASONS) (Only first 3 pieces for 837 output) 25 ; z = this is either piece 1 of the 0-node for subfile 26 ; 361.1151 (ADJUSTMENTS) 27 ; OR 28 ; for the 837 COB 'sorted' output, this will be ' PR' 29 ; for the forced/extracted entries for deductible 30 ; and co-insurance so they are always output first 31 ; The space needs to be stripped off on output 32 ; -- AND -- 33 ; IBXTRA = array returned if passed by reference if line is found 34 ; associated with line IBI due to bundling/unbundling 35 ; IBXTRA("ALL",x,paid procedure)=COB SEQ ^ seq # corresponding 36 ; to subscript n in IBXDATA(,"COB",COB,n 37 ; (x = line #-original proc-service dt) 38 ; 39 N A,B,B1,C,D,IBDATA,IB0,IB00,IBA,IBB,IBDED,IBCOI,IBS,IBN,IBDT 40 ; 41 ; If multiple EOB's reference this line for the same COB sequence, 42 ; extract only the last one marked accepted containing this line item. 43 ; 44 S A=0 45 F S A=$O(^IBM(361.1,"B",IBIFN,A)) Q:'A D 46 . I '$$EOBELIG^IBCEU1(A) Q ; eob not eligible for secondary claim 47 . I '$D(^IBM(361.1,A,15,"AC",IBI)) Q ; this EOB does not reference VistA line# IBI 48 . S IBA=0 49 . S IBDATA=$G(^IBM(361.1,A,0)) 50 . S IBS=$P(IBDATA,U,15) ; insurance sequence# 51 . S IBN=+$O(IBXDATA(IBI,"COB",IBS,0)) 52 . I IBN D Q:IBN ; check for later EOB 53 .. I $G(IBDT(IBI,IBS)),IBDT(IBI,IBS)<$P(IBDATA,U,6) K IBDT(IBI,IBS),IBXDATA(IBI,"COB",IBS) S IBN=0 54 . ; 55 . S IBDT(IBI,IBS)=$P(IBDATA,U,6) 56 . S B=0 57 . F S B=$O(^IBM(361.1,A,15,"AC",IBI,B)) Q:'B S IB0=$G(^IBM(361.1,A,15,B,0)),IB0=IB0_U_IBDT(IBI,IBS) D 58 .. Q:$TR(IB0,U)="" 59 .. S IBA=IBA+1,IBXDATA(IBI,"COB",IBS,IBA)=IBI_U_IB0 60 .. ; 61 .. ; capture the modifiers (361.1152) 62 .. I $D(^IBM(361.1,A,15,B,2)) M IBXDATA(IBI,"COBMOD")=^IBM(361.1,A,15,B,2) 63 .. I $P(IB0,U,15)'="" D ;Line involved in bundling/unbundling 64 ... N Z0 S Z0=IBI_"-"_$P(IB0,U,15)_"-"_$P(IB0,U,16) 65 ... S IBXTRA("ALL",Z0,$P(IB0,U,4))=IBS_U_IBA,$P(IBXDATA(IBI,"COB",IBS,IBA),U)="" 66 .. S C=0,(IBDED(IBA),IBCOI(IBA))="0^0" ;Assume 0 if not found in list 67 .. F S C=$O(^IBM(361.1,A,15,B,1,C)) Q:'C S IB0=$G(^(C,0)) D 68 ... S D=0 69 ... F S D=$O(^IBM(361.1,A,15,B,1,C,1,D)) Q:'D S IB00=$S($G(SORT):$P($G(^(D,0)),U,1,3),1:$G(^(D,0))) D 70 .... I $G(SORT),$P(IB0,U)="PR" D ;Check for deductible or co-ins 71 ..... I 'IBDED(IBA),$P(IB00,U)=1 S IBDED(IBA)=IB00,IB00="" Q 72 ..... I 'IBCOI(IBA),$P(IB00,U)=2 S IBCOI(IBA)=IB00,IB00="" Q 73 .... I $TR(IB00,U)'="" S IBB=$O(IBXDATA(IBI,"COB",IBS,IBA,$P(IB0,U),""),-1)+1,IBXDATA(IBI,"COB",IBS,IBA,$P(IB0,U),IBB)=IB00 74 .. Q:'$G(SORT) 75 .. S IBXDATA(IBI,"COB",IBS,IBA," PR",1)=IBDED(IBA) 76 .. S IBXDATA(IBI,"COB",IBS,IBA," PR",2)=IBCOI(IBA) 77 Q 78 ; 1 IBCEU6 ;ALB/ESG - EDI UTILITIES FOR EOB PROCESSING ;29-JUL-2003 2 ;;2.0;INTEGRATED BILLING;**155**;21-MAR-94 3 ; 4 Q 5 ; 6 COBLINE(IBIFN,IBI,IBXDATA,SORT,IBXTRA) ; Extract all COB data for line item 7 ; from file 361.1 (EOB), subfile 15 into IBXDATA(IBI,"COB",n) 8 ; 9 ; IBIFN = bill entry # 10 ; IBI = VistA outbound line item # 11 ; IBXDATA = array returned with COB line item data/pass by reference 12 ; SORT = flag that determines whether the data should be sorted for 13 ; output for the 837 record ('PR' group always there and has 14 ; a reason code for deductible first and co-insurance second - 15 ; even if they are 0). 16 ; 1 = sort, 0 = no sort needed 17 ; 18 ; Returns IBXDATA(IBI,"COB",COB,n) with COB data for each line item 19 ; found in an accepted EOB for the bill and = the '0' node data of 20 ; file 361.115 (LINE LEVEL ADJUSTMENTS) 21 ; -- AND -- 22 ; IBXDATA(IBI,"COB",COB,n,z,p)= 23 ; the data on the '0' node for each subordinate entry of file 24 ; 361.11511 (REASONS) (Only first 3 pieces for 837 output) 25 ; z = this is either piece 1 of the 0-node for subfile 26 ; 361.1151 (ADJUSTMENTS) 27 ; OR 28 ; for the 837 COB 'sorted' output, this will be ' PR' 29 ; for the forced/extracted entries for deductible 30 ; and co-insurance so they are always output first 31 ; The space needs to be stripped off on output 32 ; -- AND -- 33 ; IBXTRA = array returned if passed by reference if line is found 34 ; associated with line IBI due to bundling/unbundling 35 ; IBXTRA("ALL",x,paid procedure)=COB SEQ ^ seq # corresponding 36 ; to subscript n in IBXDATA(,"COB",COB,n 37 ; (x = line #-original proc-service dt) 38 ; 39 N A,B,B1,C,D,IBDATA,IB0,IB00,IBA,IBB,IBDED,IBCOI,IBS,IBN,IBDT 40 ; 41 ; If multiple EOB's reference this line for the same COB sequence, 42 ; extract only the last one marked accepted containing this line item. 43 ; 44 S A=0 45 F S A=$O(^IBM(361.1,"B",IBIFN,A)) Q:'A D 46 . I '$$EOBELIG^IBCEU1(A) Q ; eob not eligible for secondary claim 47 . S IBA=0 48 . S IBDATA=$G(^IBM(361.1,A,0)) 49 . S IBS=$P(IBDATA,U,15) ; insurance sequence# 50 . S IBN=+$O(IBXDATA(IBI,"COB",IBS,0)) 51 . I IBN D Q:IBN ; check for later EOB 52 .. I $G(IBDT(IBI,IBS)),IBDT(IBI,IBS)<$P(IBDATA,U,6) K IBDT(IBI,IBS),IBXDATA(IBI,"COB",IBS) S IBN=0 53 . ; 54 . S IBDT(IBI,IBS)=$P(IBDATA,U,6) 55 . S B=0 56 . F S B=$O(^IBM(361.1,A,15,"AC",IBI,B)) Q:'B S IB0=$G(^IBM(361.1,A,15,B,0)),IB0=IB0_U_IBDT(IBI,IBS) D 57 .. Q:$TR(IB0,U)="" 58 .. S IBA=IBA+1,IBXDATA(IBI,"COB",IBS,IBA)=IBI_U_IB0 59 .. ; 60 .. ; capture the modifiers (361.1152) 61 .. I $D(^IBM(361.1,A,15,B,2)) M IBXDATA(IBI,"COBMOD")=^IBM(361.1,A,15,B,2) 62 .. I $P(IB0,U,15)'="" D ;Line involved in bundling/unbundling 63 ... N Z0 S Z0=IBI_"-"_$P(IB0,U,15)_"-"_$P(IB0,U,16) 64 ... S IBXTRA("ALL",Z0,$P(IB0,U,4))=IBS_U_IBA,$P(IBXDATA(IBI,"COB",IBS,IBA),U)="" 65 .. S C=0,(IBDED(IBA),IBCOI(IBA))="0^0" ;Assume 0 if not found in list 66 .. F S C=$O(^IBM(361.1,A,15,B,1,C)) Q:'C S IB0=$G(^(C,0)) D 67 ... S D=0 68 ... F S D=$O(^IBM(361.1,A,15,B,1,C,1,D)) Q:'D S IB00=$S($G(SORT):$P($G(^(D,0)),U,1,3),1:$G(^(D,0))) D 69 .... I $G(SORT),$P(IB0,U)="PR" D ;Check for deductible or co-ins 70 ..... I 'IBDED(IBA),$P(IB00,U)=1 S IBDED(IBA)=IB00,IB00="" Q 71 ..... I 'IBCOI(IBA),$P(IB00,U)=2 S IBCOI(IBA)=IB00,IB00="" Q 72 .... I $TR(IB00,U)'="" S IBB=$O(IBXDATA(IBI,"COB",IBS,IBA,$P(IB0,U),""),-1)+1,IBXDATA(IBI,"COB",IBS,IBA,$P(IB0,U),IBB)=IB00 73 .. Q:'$G(SORT) 74 .. S IBXDATA(IBI,"COB",IBS,IBA," PR",1)=IBDED(IBA) 75 .. S IBXDATA(IBI,"COB",IBS,IBA," PR",2)=IBCOI(IBA) 76 Q 77 ;
Note:
See TracChangeset
for help on using the changeset viewer.
