ABME5CLM.m

ABME5CLM ; IHS/ASDST/DMJ - 837 CLM Segment 

 ;;2.6;IHS Third Party Billing System;**6,8,9,10,11,21**;NOV 12, 2009;Build 379

 ;Health Claim

 ;IHS/SD/SDR - 2.6*21 - HEAT183995 - Made Delayed Reason Code stop printing leading zero.

 ;IHS/SD/SDR 2.6*21 HEAT302468 Added line back in to send ORIGINAL BILL AMOUNT if billing the non-primary insurer

 ;

START ;EP - START HERE

 K ABMREC("CLM"),ABMR("CLM")

 S ABME("RTYPE")="CLM"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:210 D

 .D @I

 .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D @(^(I))

 .I $G(ABMREC("CLM"))'="" S ABMREC("CLM")=ABMREC("CLM")_"*"

 .S ABMREC("CLM")=$G(ABMREC("CLM"))_ABMR("CLM",I)

 Q

10 ;segment

 S ABMR("CLM",10)="CLM"

 Q

20 ;CLM01 - Claim Submitter's Identifier

 S ABMR("CLM",20)=ABMP("PCN")

 Q

30 ;CLM02 - Monetary Amount

 S ABMR("CLM",30)=$P(ABMB2,U)  ;bill amount  ;abm*2.6*11 COB billing

 ;abm*2.6*21 IHS/SD/SDR HEAT302468 Added below line back in; original bill amount should be send for secondary billing

 I ABMPSQ'=1,(+$P(ABMB2,U,7)'=0) S ABMR("CLM",30)=$P(ABMB2,U,7)  ;abm*2.6*10 HEAT62019

 ;I ABMPSQ'=1,(+$P(ABMB2,U,3)'=0) S ABMR("CLM",30)=$P(ABMB2,U,3)  ;abm*2.6*10 HEAT62019  ;abm*2.6*11 COB billing

 ;I ABMPSQ'=1,(+$P(ABMB2,U,7)>+$P(ABMB2,U,3)) S ABMR("CLM",30)=+$P(ABMB2,U,7)  ;abm*2.6*10 HEAT61340  ;abm*2.6*11 COB billing

 ;removed below line; was sending wrong amount

 ;I ABMPSQ=2,(+$P(ABMB2,U,7)'=0),($P(^ABMNINS(ABMP("LDFN"),$P(ABMP("INS",1),U),0),U,11)="Y") S ABMR("CLM",30)=$P(ABMB2,U)  ;abm*2.6*9 NOHEAT if secondary and primary is tribal self-insured  ;abm*2.6*10 HEAT70085

 ;start new code abm*2.6*11 COB billing

 ;I $P(ABMB2,U,8)'="" S ABMR("CLM",30)=$P(ABMB2,U,8)

 ;S:+$G(ABMR("CLM",30))=0 ABMR("CLM",30)=$P(ABMB2,U,7)

 ;S:+$G(ABMR("CLM",30))=0 ABMR("CLM",30)=$P(ABMB2,U)

 ;end new code COB billing

 S ABMR("CLM",30)=$J(ABMR("CLM",30),0,2)

 Q

40 ;CLM03 - Claim Filing Indicator Code-not used

 S ABMR("CLM",40)=""

 Q

50 ;CLM04 - Non-Institutional Claim Type Code-not used

 S ABMR("CLM",50)=""

 Q

60 ;CLM05 - Health Care Service Location Information

 I ABMP("EXP")=31 D  ;837I

 .S ABMR("CLM",60)=$E(ABMP("BTYP"),1,2)

 .S $P(ABMR("CLM",60),":",2)="A"

 .S $P(ABMR("CLM",60),":",3)=$E(ABMP("BTYP"),3)

 I ABMP("EXP")'=31 D

 .S ABMR("CLM",60)=$$POS^ABMERUTL()

 .S $P(ABMR("CLM",60),":",2)="B"

 .S $P(ABMR("CLM",60),":",3)=1

 Q

70 ;CLM06 - Provider Signature on File

 ;S ABMR("CLM",70)="Y"  ;abm*2.6*8 5010

 S ABMR("CLM",70)=""  ;abm*2.6*8 5010

 S:ABMP("EXP")'=31 ABMR("CLM",70)="Y"  ;abm*2.6*8 5010

 Q

80 ;CLM07 - Provider Accept Assignment Code

 S ABMR("CLM",80)="A"

 Q

90 ;CLM08 - Assignment of Benefits Indicator

 S ABMR("CLM",90)=$P(ABMB7,"^",5)

 Q

100 ;CLM09 - Release of Information Code

 S ABMR("CLM",100)=$P(ABMB7,"^",4)

 I ABMR("CLM",100)'="Y" S ABMR("CLM",100)="I"

 Q

110 ;CLM10 - Patient Signature Source-not used

 S ABMR("CLM",110)=""

 Q

120 ;CLM11 - Related Causes Information

 I ABMP("EXP")=31 S ABMR("CLM",120)="" Q

 N X

 S X=$P(ABMB8,"^",3)

 I X="" S ABMR("CLM",120)="" Q

 S ABMR("CLM",120)=$S(X=1:"AA",X=4:"EM",1:"OA")

 I ABMR("CLM",120)="AA" D

 .S X=$P(^AUTTLOC(ABMP("LDFN"),0),"^",14)

 .S X=$P(^DIC(5,+X,0),"^",2)

 .S ABMR("CLM",120)="AA:::"_X

 Q

130 ;CLM12 - Special Programs Code

 S ABMR("CLM",130)=""  ;abm*2.6*9 NOHEAT

 I ABMP("EXP")=31 S ABMR("CLM",130)="" Q

 ;Q:$P($G(^AUTNINS(ABMP("INS"),2)),U)'="D"  ;abm*2.6*9 NOHEAT  ;abm*2.6*10 HEAT73780

 Q:($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")'="D")  ;abm*2.6*9 NOHEAT  ;abm*2.6*10 HEAT73780

 S ABMR("CLM",130)=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))

 Q:ABMR("CLM",130)=""

 S ABMR("CLM",130)=$P($G(^ABMDCODE(ABMR("CLM",130),0)),U)

 Q

140 ;CLM13 - Yes/No-not used

 S ABMR("CLM",140)=""

 Q

150 ;CLM14 - Level of Service Code-not used

 S ABMR("CLM",150)=""

 Q

160 ;CLM15 - Yes/No-not used

 S ABMR("CLM",160)=""

 Q

170 ;CLM16 - Provider Agreement Code-not used

 S ABMR("CLM",170)=""

 Q

180 ;CLM17 - Claim Status Code-not used

 S ABMR("CLM",180)=""

 Q

190 ;CLM18 - Explanation of Benefits Indicator

 S ABMR("CLM",190)=""  ;abm*2.6*8 5010

 ;start old code abm*2.6*8 5010

 ;I ABMP("EXP")=21 D

 ;.S ABMR("CLM",190)="Y"

 ;I ABMP("EXP")'=21 D

 ;.S ABMR("CLM",190)=""

 ;end old code abm*2.6*8 5010

 Q

200 ;CLM19 - Claim Submission Reason Code-not used

 S ABMR("CLM",200)=""

 Q

210 ;CLM20 - Delay Reason Code

 S ABMR("CLM",210)=""

 S ABMDRC=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",16)

 ;I ABMDRC'="" S ABMR("CLM",210)=$P($G(^ABMDCODE(ABMDRC,0)),"^")  ;abm*2.6*21 IHS/SD/SDR HEAT183995

 I ABMDRC'="" S ABMR("CLM",210)=+$P($G(^ABMDCODE(ABMDRC,0)),"^")  ;abm*2.6*21 IHS/SD/SDR HEAT183995

 Q

ABME5CLM  ; IHS/ASDST/DMJ - 837 CLM Segment 

 +1       ;;2.6;IHS Third Party Billing System;**6,8,9,10,11,21**;NOV 12, 2009;Build 379

 +2       ;Health Claim

 +3       ;IHS/SD/SDR - 2.6*21 - HEAT183995 - Made Delayed Reason Code stop printing leading zero.

 +4       ;IHS/SD/SDR 2.6*21 HEAT302468 Added line back in to send ORIGINAL BILL AMOUNT if billing the non-primary insurer

 +5       ;

START     ;EP - START HERE

 +1        KILL ABMREC("CLM"),ABMR("CLM")

 +2        SET ABME("RTYPE")="CLM"

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:210

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))

                       DO @(^(I))

 +4                IF $GET(ABMREC("CLM"))'=""

                       SET ABMREC("CLM")=ABMREC("CLM")_"*"

 +5                SET ABMREC("CLM")=$GET(ABMREC("CLM"))_ABMR("CLM",I)

               End DoDot:1

 +6        QUIT 

10        ;segment

 +1        SET ABMR("CLM",10)="CLM"

 +2        QUIT 

20        ;CLM01 - Claim Submitter's Identifier

 +1        SET ABMR("CLM",20)=ABMP("PCN")

 +2        QUIT 

30        ;CLM02 - Monetary Amount

 +1       ;bill amount  ;abm*2.6*11 COB billing

           SET ABMR("CLM",30)=$PIECE(ABMB2,U)

 +2       ;abm*2.6*21 IHS/SD/SDR HEAT302468 Added below line back in; original bill amount should be send for secondary billing

 +3       ;abm*2.6*10 HEAT62019

           IF ABMPSQ'=1

               IF (+$PIECE(ABMB2,U,7)'=0)

                   SET ABMR("CLM",30)=$PIECE(ABMB2,U,7)

 +4       ;I ABMPSQ'=1,(+$P(ABMB2,U,3)'=0) S ABMR("CLM",30)=$P(ABMB2,U,3)  ;abm*2.6*10 HEAT62019  ;abm*2.6*11 COB billing

 +5       ;I ABMPSQ'=1,(+$P(ABMB2,U,7)>+$P(ABMB2,U,3)) S ABMR("CLM",30)=+$P(ABMB2,U,7)  ;abm*2.6*10 HEAT61340  ;abm*2.6*11 COB billing

 +6       ;removed below line; was sending wrong amount

 +7       ;I ABMPSQ=2,(+$P(ABMB2,U,7)'=0),($P(^ABMNINS(ABMP("LDFN"),$P(ABMP("INS",1),U),0),U,11)="Y") S ABMR("CLM",30)=$P(ABMB2,U)  ;abm*2.6*9 NOHEAT if secondary and primary is tribal self-insured  ;abm*2.6*10 HEAT70085

 +8       ;start new code abm*2.6*11 COB billing

 +9       ;I $P(ABMB2,U,8)'="" S ABMR("CLM",30)=$P(ABMB2,U,8)

 +10      ;S:+$G(ABMR("CLM",30))=0 ABMR("CLM",30)=$P(ABMB2,U,7)

 +11      ;S:+$G(ABMR("CLM",30))=0 ABMR("CLM",30)=$P(ABMB2,U)

 +12      ;end new code COB billing

 +13       SET ABMR("CLM",30)=$JUSTIFY(ABMR("CLM",30),0,2)

 +14       QUIT 

40        ;CLM03 - Claim Filing Indicator Code-not used

 +1        SET ABMR("CLM",40)=""

 +2        QUIT 

50        ;CLM04 - Non-Institutional Claim Type Code-not used

 +1        SET ABMR("CLM",50)=""

 +2        QUIT 

60        ;CLM05 - Health Care Service Location Information

 +1       ;837I

           IF ABMP("EXP")=31

               Begin DoDot:1

 +2                SET ABMR("CLM",60)=$EXTRACT(ABMP("BTYP"),1,2)

 +3                SET $PIECE(ABMR("CLM",60),":",2)="A"

 +4                SET $PIECE(ABMR("CLM",60),":",3)=$EXTRACT(ABMP("BTYP"),3)

               End DoDot:1

 +5        IF ABMP("EXP")'=31

               Begin DoDot:1

 +6                SET ABMR("CLM",60)=$$POS^ABMERUTL()

 +7                SET $PIECE(ABMR("CLM",60),":",2)="B"

 +8                SET $PIECE(ABMR("CLM",60),":",3)=1

               End DoDot:1

 +9        QUIT 

70        ;CLM06 - Provider Signature on File

 +1       ;S ABMR("CLM",70)="Y"  ;abm*2.6*8 5010

 +2       ;abm*2.6*8 5010

           SET ABMR("CLM",70)=""

 +3       ;abm*2.6*8 5010

           IF ABMP("EXP")'=31

               SET ABMR("CLM",70)="Y"

 +4        QUIT 

80        ;CLM07 - Provider Accept Assignment Code

 +1        SET ABMR("CLM",80)="A"

 +2        QUIT 

90        ;CLM08 - Assignment of Benefits Indicator

 +1        SET ABMR("CLM",90)=$PIECE(ABMB7,"^",5)

 +2        QUIT 

100       ;CLM09 - Release of Information Code

 +1        SET ABMR("CLM",100)=$PIECE(ABMB7,"^",4)

 +2        IF ABMR("CLM",100)'="Y"

               SET ABMR("CLM",100)="I"

 +3        QUIT 

110       ;CLM10 - Patient Signature Source-not used

 +1        SET ABMR("CLM",110)=""

 +2        QUIT 

120       ;CLM11 - Related Causes Information

 +1        IF ABMP("EXP")=31

               SET ABMR("CLM",120)=""

               QUIT 

 +2        NEW X

 +3        SET X=$PIECE(ABMB8,"^",3)

 +4        IF X=""

               SET ABMR("CLM",120)=""

               QUIT 

 +5        SET ABMR("CLM",120)=$SELECT(X=1:"AA",X=4:"EM",1:"OA")

 +6        IF ABMR("CLM",120)="AA"

               Begin DoDot:1

 +7                SET X=$PIECE(^AUTTLOC(ABMP("LDFN"),0),"^",14)

 +8                SET X=$PIECE(^DIC(5,+X,0),"^",2)

 +9                SET ABMR("CLM",120)="AA:::"_X

               End DoDot:1

 +10       QUIT 

130       ;CLM12 - Special Programs Code

 +1       ;abm*2.6*9 NOHEAT

           SET ABMR("CLM",130)=""

 +2        IF ABMP("EXP")=31

               SET ABMR("CLM",130)=""

               QUIT 

 +3       ;Q:$P($G(^AUTNINS(ABMP("INS"),2)),U)'="D"  ;abm*2.6*9 NOHEAT  ;abm*2.6*10 HEAT73780

 +4       ;abm*2.6*9 NOHEAT  ;abm*2.6*10 HEAT73780

           IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")'="D")

               QUIT 

 +5        SET ABMR("CLM",130)=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),59,0))

 +6        IF ABMR("CLM",130)=""

               QUIT 

 +7        SET ABMR("CLM",130)=$PIECE($GET(^ABMDCODE(ABMR("CLM",130),0)),U)

 +8        QUIT 

140       ;CLM13 - Yes/No-not used

 +1        SET ABMR("CLM",140)=""

 +2        QUIT 

150       ;CLM14 - Level of Service Code-not used

 +1        SET ABMR("CLM",150)=""

 +2        QUIT 

160       ;CLM15 - Yes/No-not used

 +1        SET ABMR("CLM",160)=""

 +2        QUIT 

170       ;CLM16 - Provider Agreement Code-not used

 +1        SET ABMR("CLM",170)=""

 +2        QUIT 

180       ;CLM17 - Claim Status Code-not used

 +1        SET ABMR("CLM",180)=""

 +2        QUIT 

190       ;CLM18 - Explanation of Benefits Indicator

 +1       ;abm*2.6*8 5010

           SET ABMR("CLM",190)=""

 +2       ;start old code abm*2.6*8 5010

 +3       ;I ABMP("EXP")=21 D

 +4       ;.S ABMR("CLM",190)="Y"

 +5       ;I ABMP("EXP")'=21 D

 +6       ;.S ABMR("CLM",190)=""

 +7       ;end old code abm*2.6*8 5010

 +8        QUIT 

200       ;CLM19 - Claim Submission Reason Code-not used

 +1        SET ABMR("CLM",200)=""

 +2        QUIT 

210       ;CLM20 - Delay Reason Code

 +1        SET ABMR("CLM",210)=""

 +2        SET ABMDRC=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",16)

 +3       ;I ABMDRC'="" S ABMR("CLM",210)=$P($G(^ABMDCODE(ABMDRC,0)),"^")  ;abm*2.6*21 IHS/SD/SDR HEAT183995

 +4       ;abm*2.6*21 IHS/SD/SDR HEAT183995

           IF ABMDRC'=""

               SET ABMR("CLM",210)=+$PIECE($GET(^ABMDCODE(ABMDRC,0)),"^")

 +5        QUIT