IBCE837P ;EDE/JWSP - OUTPUT FOR 837 TRANSMISSION - CONTINUED ;
;;2.0;INTEGRATED BILLING;**718,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
POST ;POST execute for 837, called by IBCE837A@POST
;FSC Work Arounds - moved from FSC to VistA
;
; WCJ;IB718v22;quit if flag is not set to do the post workarounds
Q:$G(IBXPOSTWA)'=1
;WCJ;IB718;SQA
N I
;TPF;EBILL-2629;IB*2.0*718v20 remove EBILL-1641 (label 3 below) because of story implementation sequence issues
F I=1,2,6,7,9,8,10 D @I
Q
;;
1 ;;IB*2.0*718;JWS;11/30/21;EBILL-1629;Incorporate FSC Override - clear PRF9 and PRF10 when there is an RX1 segment
;;for the same service line with a Service Date (refill)
N X1,X2,XLN
S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,180,X1)) Q:X1="" S XLN=$G(^TMP("IBXDATA",$J,1,180,X1,2)) I XLN D
. S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,190,X2)) Q:X2="" I XLN=$G(^TMP("IBXDATA",$J,1,190,X2,2)),$G(^TMP("IBXDATA",$J,1,190,X2,7))'="" D
.. K ^TMP("IBXDATA",$J,1,180,X1,9)
.. K ^TMP("IBXDATA",$J,1,180,X1,10)
.. Q
. Q
Q
;
2 ;;IB*2.0*718;JWS;12/8/21;EBILL-1633;Incorporate FSC Override - remove all NPIs when payer is Medicare
N IBPID,X1
S IBPID=$G(^TMP("IBXDATA",$J,1,37,1,3))
I IBPID="SMTX1"!(IBPID="12M61") D
. K ^TMP("IBXDATA",$J,1,15,1,9) ;PRV-9 : Billing Provider Primary ID
. K ^TMP("IBXDATA",$J,1,15,1,12) ;PRV-12 : Billing Provider Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,57,1,5) ;SUB2-5 : Lab/Facility Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,57,1,6) ;SUB2-6 : Lab/Facility Primary ID
. K ^TMP("IBXDATA",$J,1,97,1,2) ;OPR1-2 : Attending Prov Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,97,1,3) ;OPR1-3 : Attending Prov Primary ID
. K ^TMP("IBXDATA",$J,1,97,1,5) ;OPR1-5 : Other Operating Prov Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,97,1,6) ;OPR1-6 : Other Operating Provider Primary ID
. K ^TMP("IBXDATA",$J,1,97,1,8) ;OPR1-8 : Operating Phy Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,97,1,9) ;OPR1-9 : Operating Phy Primary ID
. K ^TMP("IBXDATA",$J,1,97,1,11) ;OPR1-11 : Referring Prov Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,97,1,12) ;OPR1-12 : Referring Provider Primary ID
. K ^TMP("IBXDATA",$J,1,103,1,6) ;OPR7-6 : Supervising Prov Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,103,1,7) ;OPR7-7 : Supervising Provider Primary ID
. K ^TMP("IBXDATA",$J,1,104.2,1,8) ;OPR9-8 : Rendering Provider Primary ID Qualifier
. K ^TMP("IBXDATA",$J,1,104.2,1,9) ;OPR9-9 : Rendering Provider Primary ID
. ;;K ^TMP("IBXDATA",$J,1,104.6,1,8) ;Asst Surgeon Primary ID Qualifier
. ;;K ^TMP("IBXDATA",$J,1,104.6,1,9) ;Asst Surgeon Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,192,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,192,X1,8) ;LOPE-8 : Operating Physician Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,192,X1,9) ;LOPE-9 : Operating Physician Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,193,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,193,X1,8) ;LOP1-8 : Other Operating Provider Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,193,X1,9) ;LOP1-9 : Other Operating Provider Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,193.3,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,193.3,X1,8) ;LREN-8 : Rendering Provider Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,193.3,X1,9) ;LREN-9 : Rendering Provider Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,193.6,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,193.6,X1,4) ;LPUR-4 : Purchase Service Provider Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,193.6,X1,5) ;LPUR-5 : Purchase Service Provider Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,194,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,194,X1,8) ;LSUP-8 : Supervising Provider Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,194,X1,9) ;LSUP-9 : Supervising Provider Primary ID
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,194.3,X1)) Q:X1="" D
.. K ^TMP("IBXDATA",$J,1,194.3,X1,8) ;LREF-8 : Referring Provider Primary ID Qualifier
.. K ^TMP("IBXDATA",$J,1,194.3,X1,9) ;LREF-9 : Referring Provider Primary ID
.. Q
. Q
Q
;
3 ;IB*2.0*718;JWS;12/8/21;EBILL-1641;Incorporate FSC Override #3 - if PAYER PRIMARY ID (CI5-3) is not 'IPRNT' or 'PPRNT' and claim
;;Adjustment Group Code (LCAS-3) is 'LQ', then delete LCAS segment
;;ref to var IBPID (IB Payer ID)
N IBPID,X1
N CNT,SEQTMP ;TPF;EBILL-2629;IB*2.0*718v20
S CNT=0
S IBPID=$G(^TMP("IBXDATA",$J,1,37,1,3))
I IBPID'="IPRNT",IBPID'="PPRNT",$D(^TMP("IBXDATA",$J,1,200)) D
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,200,X1)) Q:X1="" D
.. ;I $G(^TMP("IBXDATA",$J,1,200,X1,3))="LQ" K ^TMP("IBXDATA",$J,1,200,X1)
.. I $G(^TMP("IBXDATA",$J,1,200,X1,3))="LQ" K ^TMP("IBXDATA",$J,1,200,X1) Q ;TPF;EBILL-2629;IB*2.0*718v20
.. S CNT=CNT+1
.. M SEQTMP(CNT)=^TMP("IBXDATA",$J,1,200,X1)
.. Q
. Q
K ^TMP("IBXDATA",$J,1,200) ;TPF;EBILL-2629;IB*2.0*718v20
M ^TMP("IBXDATA",$J,1,200)=SEQTMP
Q
;
4 ;IB*2.0*XXX;JWS;12/14/21;EBILL-1637;remove adjustment reason code (AB3) and associated amounts when not submitted on a paper Medicare
; secondary claim. The AB3 value is used by HCCH for printing MRA files. It should only appear for IPRINT claims
N X1
I $G(^TMP("IBXDATA",$J,1,37,1,3))="IPRNT" Q
I '$D(^TMP("IBXDATA",$J,1,135)) Q
S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,135,X1)) Q:X1="" D
. I $G(^TMP("IBXDATA",$J,1,135,X1,4))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,4),^(5),^(6)
. I $G(^TMP("IBXDATA",$J,1,135,X1,7))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,7),^(8),^(9)
. I $G(^TMP("IBXDATA",$J,1,135,X1,10))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,10),^(11),^(12)
. I $G(^TMP("IBXDATA",$J,1,135,X1,13))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,13),^(14),^(15)
. I $G(^TMP("IBXDATA",$J,1,135,X1,16))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,16),^(17),^(18)
. I $G(^TMP("IBXDATA",$J,1,135,X1,19))="AB3" D
.. K ^TMP("IBXDATA",$J,1,135,X1,19),^(20),^(21)
. I $G(^TMP("IBXDATA",$J,1,135,X1,4))="",$G(^(7))="",$G(^(10))="",$G(^(13))="",$G(^(16))="",$G(^(19))="" K ^TMP("IBXDATA",$J,1,135,X1) Q
. I $G(^TMP("IBXDATA",$J,1,135,X1,4))="" D
.. I $G(^TMP("IBXDATA",$J,1,135,X1,7))'="" D 41(4,7) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,10))'="" D 41(4,10) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,13))'="" D 41(4,13) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,16))'="" D 41(4,16) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,19))'="" D 41(4,19) Q
. I $G(^TMP("IBXDATA",$J,1,135,X1,7))="" D
.. I $G(^TMP("IBXDATA",$J,1,135,X1,10))'="" D 41(7,10) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,13))'="" D 41(7,13) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,16))'="" D 41(7,16) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,19))'="" D 41(7,19) Q
. I $G(^TMP("IBXDATA",$J,1,135,X1,10))="" D
.. I $G(^TMP("IBXDATA",$J,1,135,X1,13))'="" D 41(10,13) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,16))'="" D 41(10,16) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,19))'="" D 41(10,19) Q
. I $G(^TMP("IBXDATA",$J,1,135,X1,13))="" D
.. I $G(^TMP("IBXDATA",$J,1,135,X1,16))'="" D 41(13,16) Q
.. I $G(^TMP("IBXDATA",$J,1,135,X1,19))'="" D 41(13,19) Q
. I $G(^TMP("IBXDATA",$J,1,135,X1,16))="" D
.. I $G(^TMP("IBXDATA",$J,1,135,X1,19))'="" D 41(16,19) Q
. Q
Q
;
41(XT,XF) ;shuffle adjustment reason codes
S ^(XT)=^TMP("IBXDATA",$J,1,135,X1,XF),^(XT+1)=$G(^(XF+1)),^(XT+2)=$G(^(XF+2)) K ^(XF+1),^(XF+2),^(XF+3)
Q
;
5 ;IB*2.0*XXX;JWS;12/14/21;EBILL-1645;remove adjustment reason code (AAA) and associated amounts when not submitted on a paper Medicare
; secondary claim. The AAA value is used by HCCH for printing MRA files. It should only appear for IPRINT and PPRNT IDs
N X1
I $G(^TMP("IBXDATA",$J,1,37,1,3))="IPRNT"!($G(^(3))="PPRNT") Q
I '$D(^TMP("IBXDATA",$J,1,200)) Q
S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,200,X1)) Q:X1="" D
. I $G(^TMP("IBXDATA",$J,1,200,X1,4))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,4),^(5),^(6)
. I $G(^TMP("IBXDATA",$J,1,200,X1,7))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,7),^(8),^(9)
. I $G(^TMP("IBXDATA",$J,1,200,X1,10))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,10),^(11),^(12)
. I $G(^TMP("IBXDATA",$J,1,200,X1,13))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,13),^(14),^(15)
. I $G(^TMP("IBXDATA",$J,1,200,X1,16))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,16),^(17),^(18)
. I $G(^TMP("IBXDATA",$J,1,200,X1,19))="AAA" D
.. K ^TMP("IBXDATA",$J,1,200,X1,19),^(20),^(21)
. I $G(^TMP("IBXDATA",$J,1,200,X1,4))="",$G(^(7))="",$G(^(10))="",$G(^(13))="",$G(^(16))="",$G(^(19))="" K ^TMP("IBXDATA",$J,1,200,X1) Q
. I $G(^TMP("IBXDATA",$J,1,200,X1,4))="" D
.. I $G(^TMP("IBXDATA",$J,1,200,X1,7))'="" D 51(4,7) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,10))'="" D 51(4,10) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,13))'="" D 51(4,13) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,16))'="" D 51(4,16) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,19))'="" D 51(4,19) Q
. I $G(^TMP("IBXDATA",$J,1,200,X1,7))="" D
.. I $G(^TMP("IBXDATA",$J,1,200,X1,10))'="" D 51(7,10) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,13))'="" D 51(7,13) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,16))'="" D 51(7,16) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,19))'="" D 51(7,19) Q
. I $G(^TMP("IBXDATA",$J,1,200,X1,10))="" D
.. I $G(^TMP("IBXDATA",$J,1,200,X1,13))'="" D 51(10,13) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,16))'="" D 51(10,16) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,19))'="" D 51(10,19) Q
. I $G(^TMP("IBXDATA",$J,1,200,X1,13))="" D
.. I $G(^TMP("IBXDATA",$J,1,200,X1,16))'="" D 51(13,16) Q
.. I $G(^TMP("IBXDATA",$J,1,200,X1,19))'="" D 51(13,19) Q
. I $G(^TMP("IBXDATA",$J,1,200,X1,16))="" D
.. I $G(^TMP("IBXDATA",$J,1,200,X1,19))'="" D 51(16,19) Q
. Q
Q
;
51(XT,XF) ;shuffle adjustment reason codes
S ^(XT)=^TMP("IBXDATA",$J,1,200,X1,XF),^(XT+1)=$G(^(XF+1)),^(XT+2)=$G(^(XF+2)) K ^(XF+1),^(XF+2),^(XF+3)
Q
;
6 ;IB*2.0*727;JWS;12/14/21;EBILL-1649;remove Secondary ID and Qualifier when Second ID Qualifier = '2U' and payer is Medicare
;
N X1
S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,114,X1)) Q:X1="" D
. ;JWS;5/9/22;added payer ID 'SMDEV' (Medicare DME claims) to below list
. I $G(^TMP("IBXDATA",$J,1,114,X1,4))="12M61"!($G(^(4))="SMTX1")!($G(^(4))="SMDEV") D
.. I $G(^TMP("IBXDATA",$J,1,114,X1,5))="2U" K ^TMP("IBXDATA",$J,1,114,X1,5),^(6)
.. I $G(^TMP("IBXDATA",$J,1,114,X1,7))="2U" K ^TMP("IBXDATA",$J,1,114,X1,7),^(8)
.. Q
. Q
Q
;
7 ;IB*2.0*727;JWS;5/4/22;EBILL-1657;remove provider secondary ID and qualifer if Dest Payer is Medicare Part-A
; removes valid 5010 provider IDs that are not allowed by Medicare
N X1,X2,I
S X1=0
I $G(^TMP("IBXDATA",$J,1,37,1,3))="12M61" D ;Medicare Part A payer ID (changeHealth care)
. F I=2,4,6,8 D 71(98,1,I) D ;seq=98 : OPR2 attending provider sec id
. D 72(98,1,2)
. F I=2,4,6,8 D 71(99,1,I) ;seq=99 : OPR3 operating provider sec id
. D 72(99,1,2)
. F I=2,4,6,8 D 71(100,1,I) ;seq=100 : OPR4 other operating provider sec id
. D 72(100,1,2)
. F I=2,4,6,8 D 71(104.4,1,I) ;seq=104.4 : OPRA rendering provider sec id
. D 72(104.4,1,2)
. F I=2,4,6 D 71(101,1,I) ;seq=101 : OPR5 referring provider sec id
. D 72(101,1,2)
. F I=7:1:12 K ^TMP("IBXDATA",$J,1,57,1,I) ;seq=57 : SUB2 service facility data
. S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,192,X2)) Q:X2="" D ;seq=192 : LOPE line operating physician data
.. F I=10,12,14 D 71(192,X2,I)
.. D 72(192,X2,10)
. S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,193,X2)) Q:X2="" D ;seq=193 : LOP1 line other operating physician data
.. F I=10,12,14 D 71(193,X2,I)
.. D 72(193,X2,10)
. S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,193.3,X2)) Q:X2="" D ;seq=193.3 : LREN line rendering provider data
.. F I=10,12,14 D 71(193.3,X2,I)
.. D 72(193.3,X2,10)
. S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,194.3,X2)) Q:X2="" D ;seq=194.3 : LREF line referring provider data
.. F I=10,12,14 D 71(194.3,X2,I)
.. D 72(194.3,X2,10)
. Q
Q
;
71(SEQ,REC,FLD) ;function to delete entries
I $G(^TMP("IBXDATA",$J,1,SEQ,REC,FLD))'="1G" K ^TMP("IBXDATA",$J,1,SEQ,REC,FLD),^(FLD+1)
Q
;
72(SEQ,REC,FLD) ;reshuffle entries to prevent any FSC issues; should not be necessary, but just incase it is.
I FLD=2 D
. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,2))="" D
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,4))'="" S ^(2)=^(4),^(3)=^(5) K ^(4),^(5) Q
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,6))'="" S ^(2)=^(6),^(3)=^(7) K ^(6),^(7) Q
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,8))'="" S ^(2)=^(8),^(3)=^(9) K ^(8),^(9) Q
. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,4))="" D
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,6))'="" S ^(4)=^(6),^(5)=^(7) K ^(6),^(7) Q
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,8))'="" S ^(4)=^(8),^(5)=^(9) K ^(8),^(9) Q
. I SEQ=101 Q
. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,6))="" D
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,8))'="" S ^(6)=^(8),^(7)=^(9) K ^(8),^(9) Q
I FLD=10 D
. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,10))="" D
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,12))'="" S ^(10)=^(12),^(11)=^(13) K ^(12),^(13) Q
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,14))'="" S ^(10)=^(14),^(11)=^(15) K ^(14),^(15) Q
. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,12))="" D
.. I $G(^TMP("IBXDATA",$J,1,SEQ,REC,14))'="" S ^(12)=^(14),^(13)=^(15) K ^(14),^(15) Q
Q
;
8 ;TPF;IB*2.0*727;EBILL-1665;6/23/2022;Remove Remaining Patient Liability Amount and Other Payer Check Date when the Other Payer is a Primary or Secondary Payer
N X1,X2,LCOBPRIM,LCOBSEC
Q:'$D(^TMP("IBXDATA",$J,1,195)) ;NO LCOBs FOR THIS CLAIM
;GO THROUGH THE LCOB ENTRIES AND SEE IF ANY APPLY TO THESE SPECS. PROCESS ONLY ONE PRIMARY AND ONE SECONDARY LCOB
S (LCOBPRIM,LCOBSEC)=0
S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,195,X1)) Q:X1="" D Q:$G(LCOBPRIM)&(LCOBSEC) ;ONCE ONE SECONDARY AND ONE PRIMARY HAS BEEN PROCESSED QUIT
.;
.Q:$G(^TMP("IBXDATA",$J,1,195,X1,18))="T" ;DO NOT PROCESS TERTIARY LCOBS
.Q:$G(LCOBPRIM)&($G(^TMP("IBXDATA",$J,1,195,X1,18))="P") ;ALREADY PROCESSED A PRIMARY.
.Q:$G(LCOBSEC)&($G(^TMP("IBXDATA",$J,1,195,X1,18))="S") ;ALREADY PROCESSED A SECONDARY.
.S LCOBPRIM=$G(^TMP("IBXDATA",$J,1,195,X1,18))="P"
.S LCOBSEC=$G(^TMP("IBXDATA",$J,1,195,X1,18))="S"
.;
.I LCOBPRIM D
..S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,107,X2)) Q:X2="" D
...I $G(^TMP("IBXDATA",$J,1,107,X2,2))="P" D Q
....S ^TMP("IBXDATA",$J,1,107,X2,6)=""
....S ^TMP("IBXDATA",$J,1,107,X2,7)=""
..;
..S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,112,X2)) Q:X2="" D
...I $G(^TMP("IBXDATA",$J,1,112,X2,2))="P" D Q
....S ^TMP("IBXDATA",$J,1,112,X2,8)=""
....S ^TMP("IBXDATA",$J,1,112,X2,9)=""
.;
.I LCOBSEC D
..S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,107,X2)) Q:X2="" D
...I $G(^TMP("IBXDATA",$J,1,107,X2,2))="S" D Q
....S ^TMP("IBXDATA",$J,1,107,X2,6)=""
....S ^TMP("IBXDATA",$J,1,107,X2,7)=""
..;
..S X2=0 F S X2=$O(^TMP("IBXDATA",$J,1,112,X2)) Q:X2="" D
...I $G(^TMP("IBXDATA",$J,1,112,X2,2))="S" D Q
....S ^TMP("IBXDATA",$J,1,112,X2,8)=""
....S ^TMP("IBXDATA",$J,1,112,X2,9)=""
Q
;
9 ; IB*2.0*727;JWS;5/4/22;EBILL-2602;remove or change provider secondary ID and qualifier if Dest Payer is Medicare Part B
N I,X1
I $G(^TMP("IBXDATA",$J,1,37,1,3))="SMTX1" D ;Medicare Part B payer ID (changeHealth care)
. I $G(^TMP("IBXDATA",$J,1,28,1,6))="1C" S ^(6)="G2" ;seq=28 : CI1A billing provider secondary id data
. F I=2,4,6 I $G(^TMP("IBXDATA",$J,1,101,1,I))'="1G",$G(^(I))'="0B" K ^(I),^(I+1) ;seq=101 : OPR5 referring provider secondary id
. F I=2,4,6,8 I $G(^TMP("IBXDATA",$J,1,104.4,1,I))="1C" S ^(I)="G2" ;seq=104.4 : OPRA rendering provider sec id
. F I=7:1:12 K ^TMP("IBXDATA",$J,1,57,1,I) ;seq=57 : SUB2 service facility data
. F I=2,4,6,8 I $G(^TMP("IBXDATA",$J,1,104,1,I))="EI" S ^(I)="G2" ;seq=104 : OPR8 supervising provider secondary id data
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,193.6,X1)) Q:X1="" D ;seq=193.6 : LPUR line purchase service provider data
.. ;JWS;8/15/22;IB*2.0*727v12;FSC workaround documentation was incorrect - Set LPUR-6 = "1G" and LPUR-7 = 'VAD001'
.. ;JWS;10/19/22;EBILL-2979;IB*2.0*727v14;should only set if LPUR line exists
.. I $G(^TMP("IBXDATA",$J,1,193.6,X1,2))'="" D
... S ^TMP("IBXDATA",$J,1,193.6,X1,6)="1G"
... S ^TMP("IBXDATA",$J,1,193.6,X1,7)="VAD001"
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,194,X1)) Q:X1="" D ;seq=194 : LSUP line supervising provider data
.. F I=10,12,14 I $G(^TMP("IBXDATA",$J,1,194,X1,I))="G2" K ^(I),^(I+1)
. S X1=0 F S X1=$O(^TMP("IBXDATA",$J,1,194.3,X1)) Q:X1="" D ;seq=194.3 : LREF line referring provider data
.. ;8/1/22;EBILL-2711;IB*270*727v10;JWS;was missing a not (') condition, so remove ID and qualifier if NOT = '1G'
.. F I=10,12,14 I $G(^TMP("IBXDATA",$J,1,194.3,X1,I))'="1G" K ^(I),^(I+1)
Q
;
10 ;IB*2.0*727;JWS;7/29/22;EBILL-1653;group DCx records by Diagnosis Type (DCx-3); ABK (BK) 1st, ABF (BF) 2nd grp, ABN (BN) last
; only perform this check/re-order for Institutional Claims
I $$FT^IBCEF(IBXIEN)'=3 Q
; if no DCx records, quit
I '$D(^TMP("IBXDATA",$J,1,90)) Q
; X1 is array of record 90 field values as entered by user
; X2 is entry counter
; X3 is array of Diagnosis Types by original line number
; IBDT is the Diagnosis Type found in DCx-3 (Code List Qualifier Code, i.e. ABK, ABF, ABN)
N X1,X2,X3,IBDT,XCT
M X1=^TMP("IBXDATA",$J,1,90)
S X2=1 F S X2=$O(X1(X2)) Q:X2="" S X3(X1(X2,3),X2)=""
K ^TMP("IBXDATA",$J,1,90)
M ^TMP("IBXDATA",$J,1,90,1)=X1(1)
; JWS;9/12/22;Changed to reverse $O because FSC wants External Injury codes before Other Diag codes
S IBDT="",XCT=1 F S IBDT=$O(X3(IBDT),-1) Q:IBDT="" S X2="" F S X2=$O(X3(IBDT,X2)) Q:X2="" S XCT=XCT+1,X1(X2,1)="DC"_XCT_" " M ^TMP("IBXDATA",$J,1,90,XCT)=X1(X2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCE837P 17674 printed May 14, 2023@14:53:14 Page 2
IBCE837P ;EDE/JWSP - OUTPUT FOR 837 TRANSMISSION - CONTINUED ;
+1 ;;2.0;INTEGRATED BILLING;**718,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ;POST execute for 837, called by IBCE837A@POST
+1 ;FSC Work Arounds - moved from FSC to VistA
+2 ;
+3 ; WCJ;IB718v22;quit if flag is not set to do the post workarounds
+4 if $GET(IBXPOSTWA)'=1
QUIT
+5 ;WCJ;IB718;SQA
+6 NEW I
+7 ;TPF;EBILL-2629;IB*2.0*718v20 remove EBILL-1641 (label 3 below) because of story implementation sequence issues
+8 FOR I=1,2,6,7,9,8,10
DO @I
+9 QUIT
+10 ;;
1 ;;IB*2.0*718;JWS;11/30/21;EBILL-1629;Incorporate FSC Override - clear PRF9 and PRF10 when there is an RX1 segment
+1 ;;for the same service line with a Service Date (refill)
+2 NEW X1,X2,XLN
+3 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,180,X1))
if X1=""
QUIT
SET XLN=$GET(^TMP("IBXDATA",$JOB,1,180,X1,2))
IF XLN
Begin DoDot:1
+4 SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,190,X2))
if X2=""
QUIT
IF XLN=$GET(^TMP("IBXDATA",$JOB,1,190,X2,2))
IF $GET(^TMP("IBXDATA",$JOB,1,190,X2,7))'=""
Begin DoDot:2
+5 KILL ^TMP("IBXDATA",$JOB,1,180,X1,9)
+6 KILL ^TMP("IBXDATA",$JOB,1,180,X1,10)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
2 ;;IB*2.0*718;JWS;12/8/21;EBILL-1633;Incorporate FSC Override - remove all NPIs when payer is Medicare
+1 NEW IBPID,X1
+2 SET IBPID=$GET(^TMP("IBXDATA",$JOB,1,37,1,3))
+3 IF IBPID="SMTX1"!(IBPID="12M61")
Begin DoDot:1
+4 ;PRV-9 : Billing Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,15,1,9)
+5 ;PRV-12 : Billing Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,15,1,12)
+6 ;SUB2-5 : Lab/Facility Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,57,1,5)
+7 ;SUB2-6 : Lab/Facility Primary ID
KILL ^TMP("IBXDATA",$JOB,1,57,1,6)
+8 ;OPR1-2 : Attending Prov Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,97,1,2)
+9 ;OPR1-3 : Attending Prov Primary ID
KILL ^TMP("IBXDATA",$JOB,1,97,1,3)
+10 ;OPR1-5 : Other Operating Prov Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,97,1,5)
+11 ;OPR1-6 : Other Operating Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,97,1,6)
+12 ;OPR1-8 : Operating Phy Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,97,1,8)
+13 ;OPR1-9 : Operating Phy Primary ID
KILL ^TMP("IBXDATA",$JOB,1,97,1,9)
+14 ;OPR1-11 : Referring Prov Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,97,1,11)
+15 ;OPR1-12 : Referring Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,97,1,12)
+16 ;OPR7-6 : Supervising Prov Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,103,1,6)
+17 ;OPR7-7 : Supervising Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,103,1,7)
+18 ;OPR9-8 : Rendering Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,104.2,1,8)
+19 ;OPR9-9 : Rendering Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,104.2,1,9)
+20 ;;K ^TMP("IBXDATA",$J,1,104.6,1,8) ;Asst Surgeon Primary ID Qualifier
+21 ;;K ^TMP("IBXDATA",$J,1,104.6,1,9) ;Asst Surgeon Primary ID
+22 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,192,X1))
if X1=""
QUIT
Begin DoDot:2
+23 ;LOPE-8 : Operating Physician Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,192,X1,8)
+24 ;LOPE-9 : Operating Physician Primary ID
KILL ^TMP("IBXDATA",$JOB,1,192,X1,9)
End DoDot:2
+25 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,193,X1))
if X1=""
QUIT
Begin DoDot:2
+26 ;LOP1-8 : Other Operating Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,193,X1,8)
+27 ;LOP1-9 : Other Operating Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,193,X1,9)
End DoDot:2
+28 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,193.3,X1))
if X1=""
QUIT
Begin DoDot:2
+29 ;LREN-8 : Rendering Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,193.3,X1,8)
+30 ;LREN-9 : Rendering Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,193.3,X1,9)
End DoDot:2
+31 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,193.6,X1))
if X1=""
QUIT
Begin DoDot:2
+32 ;LPUR-4 : Purchase Service Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,193.6,X1,4)
+33 ;LPUR-5 : Purchase Service Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,193.6,X1,5)
End DoDot:2
+34 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,194,X1))
if X1=""
QUIT
Begin DoDot:2
+35 ;LSUP-8 : Supervising Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,194,X1,8)
+36 ;LSUP-9 : Supervising Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,194,X1,9)
End DoDot:2
+37 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,194.3,X1))
if X1=""
QUIT
Begin DoDot:2
+38 ;LREF-8 : Referring Provider Primary ID Qualifier
KILL ^TMP("IBXDATA",$JOB,1,194.3,X1,8)
+39 ;LREF-9 : Referring Provider Primary ID
KILL ^TMP("IBXDATA",$JOB,1,194.3,X1,9)
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 QUIT
+43 ;
3 ;IB*2.0*718;JWS;12/8/21;EBILL-1641;Incorporate FSC Override #3 - if PAYER PRIMARY ID (CI5-3) is not 'IPRNT' or 'PPRNT' and claim
+1 ;;Adjustment Group Code (LCAS-3) is 'LQ', then delete LCAS segment
+2 ;;ref to var IBPID (IB Payer ID)
+3 NEW IBPID,X1
+4 ;TPF;EBILL-2629;IB*2.0*718v20
NEW CNT,SEQTMP
+5 SET CNT=0
+6 SET IBPID=$GET(^TMP("IBXDATA",$JOB,1,37,1,3))
+7 IF IBPID'="IPRNT"
IF IBPID'="PPRNT"
IF $DATA(^TMP("IBXDATA",$JOB,1,200))
Begin DoDot:1
+8 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,200,X1))
if X1=""
QUIT
Begin DoDot:2
+9 ;I $G(^TMP("IBXDATA",$J,1,200,X1,3))="LQ" K ^TMP("IBXDATA",$J,1,200,X1)
+10 ;TPF;EBILL-2629;IB*2.0*718v20
IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,3))="LQ"
KILL ^TMP("IBXDATA",$JOB,1,200,X1)
QUIT
+11 SET CNT=CNT+1
+12 MERGE SEQTMP(CNT)=^TMP("IBXDATA",$JOB,1,200,X1)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;TPF;EBILL-2629;IB*2.0*718v20
KILL ^TMP("IBXDATA",$JOB,1,200)
+16 MERGE ^TMP("IBXDATA",$JOB,1,200)=SEQTMP
+17 QUIT
+18 ;
4 ;IB*2.0*XXX;JWS;12/14/21;EBILL-1637;remove adjustment reason code (AB3) and associated amounts when not submitted on a paper Medicare
+1 ; secondary claim. The AB3 value is used by HCCH for printing MRA files. It should only appear for IPRINT claims
+2 NEW X1
+3 IF $GET(^TMP("IBXDATA",$JOB,1,37,1,3))="IPRNT"
QUIT
+4 IF '$DATA(^TMP("IBXDATA",$JOB,1,135))
QUIT
+5 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,135,X1))
if X1=""
QUIT
Begin DoDot:1
+6 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,4))="AB3"
Begin DoDot:2
+7 KILL ^TMP("IBXDATA",$JOB,1,135,X1,4),^(5),^(6)
End DoDot:2
+8 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,7))="AB3"
Begin DoDot:2
+9 KILL ^TMP("IBXDATA",$JOB,1,135,X1,7),^(8),^(9)
End DoDot:2
+10 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,10))="AB3"
Begin DoDot:2
+11 KILL ^TMP("IBXDATA",$JOB,1,135,X1,10),^(11),^(12)
End DoDot:2
+12 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,13))="AB3"
Begin DoDot:2
+13 KILL ^TMP("IBXDATA",$JOB,1,135,X1,13),^(14),^(15)
End DoDot:2
+14 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))="AB3"
Begin DoDot:2
+15 KILL ^TMP("IBXDATA",$JOB,1,135,X1,16),^(17),^(18)
End DoDot:2
+16 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))="AB3"
Begin DoDot:2
+17 KILL ^TMP("IBXDATA",$JOB,1,135,X1,19),^(20),^(21)
End DoDot:2
+18 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,4))=""
IF $GET(^(7))=""
IF $GET(^(10))=""
IF $GET(^(13))=""
IF $GET(^(16))=""
IF $GET(^(19))=""
KILL ^TMP("IBXDATA",$JOB,1,135,X1)
QUIT
+19 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,4))=""
Begin DoDot:2
+20 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,7))'=""
DO 41(4,7)
QUIT
+21 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,10))'=""
DO 41(4,10)
QUIT
+22 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,13))'=""
DO 41(4,13)
QUIT
+23 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))'=""
DO 41(4,16)
QUIT
+24 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))'=""
DO 41(4,19)
QUIT
End DoDot:2
+25 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,7))=""
Begin DoDot:2
+26 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,10))'=""
DO 41(7,10)
QUIT
+27 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,13))'=""
DO 41(7,13)
QUIT
+28 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))'=""
DO 41(7,16)
QUIT
+29 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))'=""
DO 41(7,19)
QUIT
End DoDot:2
+30 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,10))=""
Begin DoDot:2
+31 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,13))'=""
DO 41(10,13)
QUIT
+32 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))'=""
DO 41(10,16)
QUIT
+33 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))'=""
DO 41(10,19)
QUIT
End DoDot:2
+34 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,13))=""
Begin DoDot:2
+35 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))'=""
DO 41(13,16)
QUIT
+36 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))'=""
DO 41(13,19)
QUIT
End DoDot:2
+37 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,16))=""
Begin DoDot:2
+38 IF $GET(^TMP("IBXDATA",$JOB,1,135,X1,19))'=""
DO 41(16,19)
QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 QUIT
+41 ;
41(XT,XF) ;shuffle adjustment reason codes
+1 SET ^(XT)=^TMP("IBXDATA",$JOB,1,135,X1,XF)
SET ^(XT+1)=$GET(^(XF+1))
SET ^(XT+2)=$GET(^(XF+2))
KILL ^(XF+1),^(XF+2),^(XF+3)
+2 QUIT
+3 ;
5 ;IB*2.0*XXX;JWS;12/14/21;EBILL-1645;remove adjustment reason code (AAA) and associated amounts when not submitted on a paper Medicare
+1 ; secondary claim. The AAA value is used by HCCH for printing MRA files. It should only appear for IPRINT and PPRNT IDs
+2 NEW X1
+3 IF $GET(^TMP("IBXDATA",$JOB,1,37,1,3))="IPRNT"!($GET(^(3))="PPRNT")
QUIT
+4 IF '$DATA(^TMP("IBXDATA",$JOB,1,200))
QUIT
+5 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,200,X1))
if X1=""
QUIT
Begin DoDot:1
+6 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,4))="AAA"
Begin DoDot:2
+7 KILL ^TMP("IBXDATA",$JOB,1,200,X1,4),^(5),^(6)
End DoDot:2
+8 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,7))="AAA"
Begin DoDot:2
+9 KILL ^TMP("IBXDATA",$JOB,1,200,X1,7),^(8),^(9)
End DoDot:2
+10 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,10))="AAA"
Begin DoDot:2
+11 KILL ^TMP("IBXDATA",$JOB,1,200,X1,10),^(11),^(12)
End DoDot:2
+12 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,13))="AAA"
Begin DoDot:2
+13 KILL ^TMP("IBXDATA",$JOB,1,200,X1,13),^(14),^(15)
End DoDot:2
+14 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))="AAA"
Begin DoDot:2
+15 KILL ^TMP("IBXDATA",$JOB,1,200,X1,16),^(17),^(18)
End DoDot:2
+16 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))="AAA"
Begin DoDot:2
+17 KILL ^TMP("IBXDATA",$JOB,1,200,X1,19),^(20),^(21)
End DoDot:2
+18 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,4))=""
IF $GET(^(7))=""
IF $GET(^(10))=""
IF $GET(^(13))=""
IF $GET(^(16))=""
IF $GET(^(19))=""
KILL ^TMP("IBXDATA",$JOB,1,200,X1)
QUIT
+19 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,4))=""
Begin DoDot:2
+20 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,7))'=""
DO 51(4,7)
QUIT
+21 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,10))'=""
DO 51(4,10)
QUIT
+22 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,13))'=""
DO 51(4,13)
QUIT
+23 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))'=""
DO 51(4,16)
QUIT
+24 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))'=""
DO 51(4,19)
QUIT
End DoDot:2
+25 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,7))=""
Begin DoDot:2
+26 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,10))'=""
DO 51(7,10)
QUIT
+27 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,13))'=""
DO 51(7,13)
QUIT
+28 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))'=""
DO 51(7,16)
QUIT
+29 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))'=""
DO 51(7,19)
QUIT
End DoDot:2
+30 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,10))=""
Begin DoDot:2
+31 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,13))'=""
DO 51(10,13)
QUIT
+32 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))'=""
DO 51(10,16)
QUIT
+33 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))'=""
DO 51(10,19)
QUIT
End DoDot:2
+34 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,13))=""
Begin DoDot:2
+35 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))'=""
DO 51(13,16)
QUIT
+36 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))'=""
DO 51(13,19)
QUIT
End DoDot:2
+37 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,16))=""
Begin DoDot:2
+38 IF $GET(^TMP("IBXDATA",$JOB,1,200,X1,19))'=""
DO 51(16,19)
QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 QUIT
+41 ;
51(XT,XF) ;shuffle adjustment reason codes
+1 SET ^(XT)=^TMP("IBXDATA",$JOB,1,200,X1,XF)
SET ^(XT+1)=$GET(^(XF+1))
SET ^(XT+2)=$GET(^(XF+2))
KILL ^(XF+1),^(XF+2),^(XF+3)
+2 QUIT
+3 ;
6 ;IB*2.0*727;JWS;12/14/21;EBILL-1649;remove Secondary ID and Qualifier when Second ID Qualifier = '2U' and payer is Medicare
+1 ;
+2 NEW X1
+3 SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,114,X1))
if X1=""
QUIT
Begin DoDot:1
+4 ;JWS;5/9/22;added payer ID 'SMDEV' (Medicare DME claims) to below list
+5 IF $GET(^TMP("IBXDATA",$JOB,1,114,X1,4))="12M61"!($GET(^(4))="SMTX1")!($GET(^(4))="SMDEV")
Begin DoDot:2
+6 IF $GET(^TMP("IBXDATA",$JOB,1,114,X1,5))="2U"
KILL ^TMP("IBXDATA",$JOB,1,114,X1,5),^(6)
+7 IF $GET(^TMP("IBXDATA",$JOB,1,114,X1,7))="2U"
KILL ^TMP("IBXDATA",$JOB,1,114,X1,7),^(8)
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
7 ;IB*2.0*727;JWS;5/4/22;EBILL-1657;remove provider secondary ID and qualifer if Dest Payer is Medicare Part-A
+1 ; removes valid 5010 provider IDs that are not allowed by Medicare
+2 NEW X1,X2,I
+3 SET X1=0
+4 ;Medicare Part A payer ID (changeHealth care)
IF $GET(^TMP("IBXDATA",$JOB,1,37,1,3))="12M61"
Begin DoDot:1
+5 ;seq=98 : OPR2 attending provider sec id
FOR I=2,4,6,8
DO 71(98,1,I)
Begin DoDot:2
End DoDot:2
+6 DO 72(98,1,2)
+7 ;seq=99 : OPR3 operating provider sec id
FOR I=2,4,6,8
DO 71(99,1,I)
+8 DO 72(99,1,2)
+9 ;seq=100 : OPR4 other operating provider sec id
FOR I=2,4,6,8
DO 71(100,1,I)
+10 DO 72(100,1,2)
+11 ;seq=104.4 : OPRA rendering provider sec id
FOR I=2,4,6,8
DO 71(104.4,1,I)
+12 DO 72(104.4,1,2)
+13 ;seq=101 : OPR5 referring provider sec id
FOR I=2,4,6
DO 71(101,1,I)
+14 DO 72(101,1,2)
+15 ;seq=57 : SUB2 service facility data
FOR I=7:1:12
KILL ^TMP("IBXDATA",$JOB,1,57,1,I)
+16 ;seq=192 : LOPE line operating physician data
SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,192,X2))
if X2=""
QUIT
Begin DoDot:2
+17 FOR I=10,12,14
DO 71(192,X2,I)
+18 DO 72(192,X2,10)
End DoDot:2
+19 ;seq=193 : LOP1 line other operating physician data
SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,193,X2))
if X2=""
QUIT
Begin DoDot:2
+20 FOR I=10,12,14
DO 71(193,X2,I)
+21 DO 72(193,X2,10)
End DoDot:2
+22 ;seq=193.3 : LREN line rendering provider data
SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,193.3,X2))
if X2=""
QUIT
Begin DoDot:2
+23 FOR I=10,12,14
DO 71(193.3,X2,I)
+24 DO 72(193.3,X2,10)
End DoDot:2
+25 ;seq=194.3 : LREF line referring provider data
SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,194.3,X2))
if X2=""
QUIT
Begin DoDot:2
+26 FOR I=10,12,14
DO 71(194.3,X2,I)
+27 DO 72(194.3,X2,10)
End DoDot:2
+28 QUIT
End DoDot:1
+29 QUIT
+30 ;
71(SEQ,REC,FLD) ;function to delete entries
+1 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,FLD))'="1G"
KILL ^TMP("IBXDATA",$JOB,1,SEQ,REC,FLD),^(FLD+1)
+2 QUIT
+3 ;
72(SEQ,REC,FLD) ;reshuffle entries to prevent any FSC issues; should not be necessary, but just incase it is.
+1 IF FLD=2
Begin DoDot:1
+2 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,2))=""
Begin DoDot:2
+3 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,4))'=""
SET ^(2)=^(4)
SET ^(3)=^(5)
KILL ^(4),^(5)
QUIT
+4 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,6))'=""
SET ^(2)=^(6)
SET ^(3)=^(7)
KILL ^(6),^(7)
QUIT
+5 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,8))'=""
SET ^(2)=^(8)
SET ^(3)=^(9)
KILL ^(8),^(9)
QUIT
End DoDot:2
+6 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,4))=""
Begin DoDot:2
+7 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,6))'=""
SET ^(4)=^(6)
SET ^(5)=^(7)
KILL ^(6),^(7)
QUIT
+8 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,8))'=""
SET ^(4)=^(8)
SET ^(5)=^(9)
KILL ^(8),^(9)
QUIT
End DoDot:2
+9 IF SEQ=101
QUIT
+10 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,6))=""
Begin DoDot:2
+11 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,8))'=""
SET ^(6)=^(8)
SET ^(7)=^(9)
KILL ^(8),^(9)
QUIT
End DoDot:2
End DoDot:1
+12 IF FLD=10
Begin DoDot:1
+13 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,10))=""
Begin DoDot:2
+14 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,12))'=""
SET ^(10)=^(12)
SET ^(11)=^(13)
KILL ^(12),^(13)
QUIT
+15 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,14))'=""
SET ^(10)=^(14)
SET ^(11)=^(15)
KILL ^(14),^(15)
QUIT
End DoDot:2
+16 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,12))=""
Begin DoDot:2
+17 IF $GET(^TMP("IBXDATA",$JOB,1,SEQ,REC,14))'=""
SET ^(12)=^(14)
SET ^(13)=^(15)
KILL ^(14),^(15)
QUIT
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
8 ;TPF;IB*2.0*727;EBILL-1665;6/23/2022;Remove Remaining Patient Liability Amount and Other Payer Check Date when the Other Payer is a Primary or Secondary Payer
+1 NEW X1,X2,LCOBPRIM,LCOBSEC
+2 ;NO LCOBs FOR THIS CLAIM
if '$DATA(^TMP("IBXDATA",$JOB,1,195))
QUIT
+3 ;GO THROUGH THE LCOB ENTRIES AND SEE IF ANY APPLY TO THESE SPECS. PROCESS ONLY ONE PRIMARY AND ONE SECONDARY LCOB
+4 SET (LCOBPRIM,LCOBSEC)=0
+5 ;ONCE ONE SECONDARY AND ONE PRIMARY HAS BEEN PROCESSED QUIT
SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,195,X1))
if X1=""
QUIT
Begin DoDot:1
+6 ;
+7 ;DO NOT PROCESS TERTIARY LCOBS
if $GET(^TMP("IBXDATA",$JOB,1,195,X1,18))="T"
QUIT
+8 ;ALREADY PROCESSED A PRIMARY.
if $GET(LCOBPRIM)&($GET(^TMP("IBXDATA",$JOB,1,195,X1,18))="P")
QUIT
+9 ;ALREADY PROCESSED A SECONDARY.
if $GET(LCOBSEC)&($GET(^TMP("IBXDATA",$JOB,1,195,X1,18))="S")
QUIT
+10 SET LCOBPRIM=$GET(^TMP("IBXDATA",$JOB,1,195,X1,18))="P"
+11 SET LCOBSEC=$GET(^TMP("IBXDATA",$JOB,1,195,X1,18))="S"
+12 ;
+13 IF LCOBPRIM
Begin DoDot:2
+14 SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,107,X2))
if X2=""
QUIT
Begin DoDot:3
+15 IF $GET(^TMP("IBXDATA",$JOB,1,107,X2,2))="P"
Begin DoDot:4
+16 SET ^TMP("IBXDATA",$JOB,1,107,X2,6)=""
+17 SET ^TMP("IBXDATA",$JOB,1,107,X2,7)=""
End DoDot:4
QUIT
End DoDot:3
+18 ;
+19 SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,112,X2))
if X2=""
QUIT
Begin DoDot:3
+20 IF $GET(^TMP("IBXDATA",$JOB,1,112,X2,2))="P"
Begin DoDot:4
+21 SET ^TMP("IBXDATA",$JOB,1,112,X2,8)=""
+22 SET ^TMP("IBXDATA",$JOB,1,112,X2,9)=""
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
+23 ;
+24 IF LCOBSEC
Begin DoDot:2
+25 SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,107,X2))
if X2=""
QUIT
Begin DoDot:3
+26 IF $GET(^TMP("IBXDATA",$JOB,1,107,X2,2))="S"
Begin DoDot:4
+27 SET ^TMP("IBXDATA",$JOB,1,107,X2,6)=""
+28 SET ^TMP("IBXDATA",$JOB,1,107,X2,7)=""
End DoDot:4
QUIT
End DoDot:3
+29 ;
+30 SET X2=0
FOR
SET X2=$ORDER(^TMP("IBXDATA",$JOB,1,112,X2))
if X2=""
QUIT
Begin DoDot:3
+31 IF $GET(^TMP("IBXDATA",$JOB,1,112,X2,2))="S"
Begin DoDot:4
+32 SET ^TMP("IBXDATA",$JOB,1,112,X2,8)=""
+33 SET ^TMP("IBXDATA",$JOB,1,112,X2,9)=""
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
if $GET(LCOBPRIM)&(LCOBSEC)
QUIT
+34 QUIT
+35 ;
9 ; IB*2.0*727;JWS;5/4/22;EBILL-2602;remove or change provider secondary ID and qualifier if Dest Payer is Medicare Part B
+1 NEW I,X1
+2 ;Medicare Part B payer ID (changeHealth care)
IF $GET(^TMP("IBXDATA",$JOB,1,37,1,3))="SMTX1"
Begin DoDot:1
+3 ;seq=28 : CI1A billing provider secondary id data
IF $GET(^TMP("IBXDATA",$JOB,1,28,1,6))="1C"
SET ^(6)="G2"
+4 ;seq=101 : OPR5 referring provider secondary id
FOR I=2,4,6
IF $GET(^TMP("IBXDATA",$JOB,1,101,1,I))'="1G"
IF $GET(^(I))'="0B"
KILL ^(I),^(I+1)
+5 ;seq=104.4 : OPRA rendering provider sec id
FOR I=2,4,6,8
IF $GET(^TMP("IBXDATA",$JOB,1,104.4,1,I))="1C"
SET ^(I)="G2"
+6 ;seq=57 : SUB2 service facility data
FOR I=7:1:12
KILL ^TMP("IBXDATA",$JOB,1,57,1,I)
+7 ;seq=104 : OPR8 supervising provider secondary id data
FOR I=2,4,6,8
IF $GET(^TMP("IBXDATA",$JOB,1,104,1,I))="EI"
SET ^(I)="G2"
+8 ;seq=193.6 : LPUR line purchase service provider data
SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,193.6,X1))
if X1=""
QUIT
Begin DoDot:2
+9 ;JWS;8/15/22;IB*2.0*727v12;FSC workaround documentation was incorrect - Set LPUR-6 = "1G" and LPUR-7 = 'VAD001'
+10 ;JWS;10/19/22;EBILL-2979;IB*2.0*727v14;should only set if LPUR line exists
+11 IF $GET(^TMP("IBXDATA",$JOB,1,193.6,X1,2))'=""
Begin DoDot:3
+12 SET ^TMP("IBXDATA",$JOB,1,193.6,X1,6)="1G"
+13 SET ^TMP("IBXDATA",$JOB,1,193.6,X1,7)="VAD001"
End DoDot:3
End DoDot:2
+14 ;seq=194 : LSUP line supervising provider data
SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,194,X1))
if X1=""
QUIT
Begin DoDot:2
+15 FOR I=10,12,14
IF $GET(^TMP("IBXDATA",$JOB,1,194,X1,I))="G2"
KILL ^(I),^(I+1)
End DoDot:2
+16 ;seq=194.3 : LREF line referring provider data
SET X1=0
FOR
SET X1=$ORDER(^TMP("IBXDATA",$JOB,1,194.3,X1))
if X1=""
QUIT
Begin DoDot:2
+17 ;8/1/22;EBILL-2711;IB*270*727v10;JWS;was missing a not (') condition, so remove ID and qualifier if NOT = '1G'
+18 FOR I=10,12,14
IF $GET(^TMP("IBXDATA",$JOB,1,194.3,X1,I))'="1G"
KILL ^(I),^(I+1)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
10 ;IB*2.0*727;JWS;7/29/22;EBILL-1653;group DCx records by Diagnosis Type (DCx-3); ABK (BK) 1st, ABF (BF) 2nd grp, ABN (BN) last
+1 ; only perform this check/re-order for Institutional Claims
+2 IF $$FT^IBCEF(IBXIEN)'=3
QUIT
+3 ; if no DCx records, quit
+4 IF '$DATA(^TMP("IBXDATA",$JOB,1,90))
QUIT
+5 ; X1 is array of record 90 field values as entered by user
+6 ; X2 is entry counter
+7 ; X3 is array of Diagnosis Types by original line number
+8 ; IBDT is the Diagnosis Type found in DCx-3 (Code List Qualifier Code, i.e. ABK, ABF, ABN)
+9 NEW X1,X2,X3,IBDT,XCT
+10 MERGE X1=^TMP("IBXDATA",$JOB,1,90)
+11 SET X2=1
FOR
SET X2=$ORDER(X1(X2))
if X2=""
QUIT
SET X3(X1(X2,3),X2)=""
+12 KILL ^TMP("IBXDATA",$JOB,1,90)
+13 MERGE ^TMP("IBXDATA",$JOB,1,90,1)=X1(1)
+14 ; JWS;9/12/22;Changed to reverse $O because FSC wants External Injury codes before Other Diag codes
+15 SET IBDT=""
SET XCT=1
FOR
SET IBDT=$ORDER(X3(IBDT),-1)
if IBDT=""
QUIT
SET X2=""
FOR
SET X2=$ORDER(X3(IBDT,X2))
if X2=""
QUIT
SET XCT=XCT+1
SET X1(X2,1)="DC"_XCT_" "
MERGE ^TMP("IBXDATA",$JOB,1,90,XCT)=X1(X2)
+16 QUIT
+17 ;
