ABME5SBR.m

ABME5SBR ; IHS/ASDST/DMJ - 837 SBR Segment 

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

 ;Transaction Set Header

 ;IHS/SD/SDR - 2.6*21 - HEAT107645 - Added code to look at segment override

 ;

EP(X) ;EP

 ;x=1 (primary), 2 (secondary) or 3 (tertiary)

 K ABMREC("SBR"),ABMR("SBR")

 S ABME("RTYPE")="SBR"

 S ABMPST=X

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:100 D

 .D @I

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

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

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

 I '$D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D 837^ABMUTL8  ;abm*2.6*21 HEAT107645

 Q

10 ;segment

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

 Q

20 ;SBR01 - Payer Responsibility Sequence Number Code

 S ABMR("SBR",20)=$S(ABMPST=1:"P",ABMPST=2:"S",ABMPST=3:"T",ABMPST=4:"A",ABMPST=5:"B",ABMPST=6:"C",ABMPST=7:"D",ABMPST=8:"E",ABMPST=9:"F",ABMPST=10:"G",ABMPST=11:"H",1:"")

 Q

30 ;SBR02 - Individual Relationship Code

 S ABMR("SBR",30)=$G(ABMP("REL",ABMPST))

 ;I $G(ABMHL)=32 D  ;abm*2.6*9 NOHEAT

 I $G(ABMHL)=22 D  ;abm*2.6*9 NOHEAT

 .I $G(ABMCHILD)=0 S ABMR("SBR",30)=18

 .I $G(ABMCHILD)=1 S ABMR("SBR",30)=""

 Q

40 ;SBR03 - Reference Identification (Group Number)

 S ABMR("SBR",40)=$G(ABMP("GRP#",ABMPST))

 Q

50 ;SBR04 - Group Name

 I ABMR("SBR",40)'="" D  Q

 .S ABMR("SBR",50)=""

 S ABMR("SBR",50)=$G(ABMP("GRPNM",ABMPST))

 Q

60 ;SBR05 - Insurance Type Code

 S ABMR("SBR",60)=""

 D PREV^ABMDFUTL

 I (ABMPST=1)&(+$G(ABMP("PD"))=0)&(+$G(ABMP("DED"))=0)&(+$G(ABMP("COI"))=0)&(+$G(ABMP("NONC"))=0) Q

 ;Q:ABMP("EXP")'=32  ;abm*2.6*8 5010

 Q:ABMP("EXP")=31  ;abm*2.6*8 5010

 I $P(ABMP("INS",ABMPST),U,2)="R",(ABMPST'=1) S ABMR("SBR",60)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U)

 I $P(ABMP("INS",ABMPST),U,2)="R",(ABMPST=1),($G(ABMLOOP)=2320) S ABMR("SBR",60)=$G(ABMP("SOP",ABMPST))

 ;I ($G(ABMR("SBR",60))=""),($G(ABMLOOP)=2320) S ABMR("SBR",60)=$G(ABMP("SOP",ABMPST))

 I ($G(ABMR("SBR",60))=""),($G(ABMLOOP)=2320) Q

 S:ABMR("SBR",60)="CI" ABMR("SBR",60)="C1"

 S:ABMR("SBR",60)="BL" ABMR("SBR",60)="C1"

 Q

70 ;SBR06 - Coordination of Benefits Code

 S ABMR("SBR",70)=""

 ;start old code abm*2.6*9 NOHEAT

 ;removed the below loop because it failed Edifecs validator

 ;I ABMI=1,ABMP("EXP")=33 D

 ;.I $G(ABMP("INS",2)) S ABMR("SBR",70)=1

 ;.I '$G(ABMP("INS",2)) S ABMR("SBR",70)=6

 ;.;I ABMPST=1 S ABMR("SBR",70)=""  ;abm*2.6*8 HEAT28632 - Removes "1" from SBR06 for primary payer when 2ndry payer billed  ;abm*2.6*9 NOHEAT

 ;.I $G(ABMLOOP)=2320,ABMPST=1 S ABMR("SBR",70)=""  ;Removes "1" from SBR06 for primary payer when 2ndry payer billed  ;abm*2.6*9 NO HEAT

 ;end old code

 Q

80 ;SBR07 - Yes/No Condition or Response Code

 S ABMR("SBR",80)=""

 Q

90 ;SBR08 - Employment Status Code

 S ABMR("SBR",90)=""

 Q

100 ;SBR09 - Claim Filing Indicator Code

 S ABMR("SBR",100)=$G(ABMP("SOP",ABMPST))

 S:ABMR("SBR",100)="SP" ABMR("SBR",100)="CI"

 Q

ABME5SBR  ; IHS/ASDST/DMJ - 837 SBR Segment 

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

 +2       ;Transaction Set Header

 +3       ;IHS/SD/SDR - 2.6*21 - HEAT107645 - Added code to look at segment override

 +4       ;

EP(X)     ;EP

 +1       ;x=1 (primary), 2 (secondary) or 3 (tertiary)

 +2        KILL ABMREC("SBR"),ABMR("SBR")

 +3        SET ABME("RTYPE")="SBR"

 +4        SET ABMPST=X

 +5        DO LOOP

 +6        KILL ABME,ABM

 +7        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:100

               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("SBR"))'=""

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

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

               End DoDot:1

 +6       ;abm*2.6*21 HEAT107645

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

               DO 837^ABMUTL8

 +7        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;SBR01 - Payer Responsibility Sequence Number Code

 +1        SET ABMR("SBR",20)=$SELECT(ABMPST=1:"P",ABMPST=2:"S",ABMPST=3:"T",ABMPST=4:"A",ABMPST=5:"B",ABMPST=6:"C",ABMPST=7:"D",ABMPST=8:"E",ABMPST=9:"F",ABMPST=10:"G",ABMPST=11:"H",1:"")

 +2        QUIT 

30        ;SBR02 - Individual Relationship Code

 +1        SET ABMR("SBR",30)=$GET(ABMP("REL",ABMPST))

 +2       ;I $G(ABMHL)=32 D  ;abm*2.6*9 NOHEAT

 +3       ;abm*2.6*9 NOHEAT

           IF $GET(ABMHL)=22

               Begin DoDot:1

 +4                IF $GET(ABMCHILD)=0

                       SET ABMR("SBR",30)=18

 +5                IF $GET(ABMCHILD)=1

                       SET ABMR("SBR",30)=""

               End DoDot:1

 +6        QUIT 

40        ;SBR03 - Reference Identification (Group Number)

 +1        SET ABMR("SBR",40)=$GET(ABMP("GRP#",ABMPST))

 +2        QUIT 

50        ;SBR04 - Group Name

 +1        IF ABMR("SBR",40)'=""

               Begin DoDot:1

 +2                SET ABMR("SBR",50)=""

               End DoDot:1

               QUIT 

 +3        SET ABMR("SBR",50)=$GET(ABMP("GRPNM",ABMPST))

 +4        QUIT 

60        ;SBR05 - Insurance Type Code

 +1        SET ABMR("SBR",60)=""

 +2        DO PREV^ABMDFUTL

 +3        IF (ABMPST=1)&(+$GET(ABMP("PD"))=0)&(+$GET(ABMP("DED"))=0)&(+$GET(ABMP("COI"))=0)&(+$GET(ABMP("NONC"))=0)

               QUIT 

 +4       ;Q:ABMP("EXP")'=32  ;abm*2.6*8 5010

 +5       ;abm*2.6*8 5010

           IF ABMP("EXP")=31

               QUIT 

 +6        IF $PIECE(ABMP("INS",ABMPST),U,2)="R"

               IF (ABMPST'=1)

                   SET ABMR("SBR",60)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U)

 +7        IF $PIECE(ABMP("INS",ABMPST),U,2)="R"

               IF (ABMPST=1)

                   IF ($GET(ABMLOOP)=2320)

                       SET ABMR("SBR",60)=$GET(ABMP("SOP",ABMPST))

 +8       ;I ($G(ABMR("SBR",60))=""),($G(ABMLOOP)=2320) S ABMR("SBR",60)=$G(ABMP("SOP",ABMPST))

 +9        IF ($GET(ABMR("SBR",60))="")

               IF ($GET(ABMLOOP)=2320)

                   QUIT 

 +10       IF ABMR("SBR",60)="CI"

               SET ABMR("SBR",60)="C1"

 +11       IF ABMR("SBR",60)="BL"

               SET ABMR("SBR",60)="C1"

 +12       QUIT 

70        ;SBR06 - Coordination of Benefits Code

 +1        SET ABMR("SBR",70)=""

 +2       ;start old code abm*2.6*9 NOHEAT

 +3       ;removed the below loop because it failed Edifecs validator

 +4       ;I ABMI=1,ABMP("EXP")=33 D

 +5       ;.I $G(ABMP("INS",2)) S ABMR("SBR",70)=1

 +6       ;.I '$G(ABMP("INS",2)) S ABMR("SBR",70)=6

 +7       ;.;I ABMPST=1 S ABMR("SBR",70)=""  ;abm*2.6*8 HEAT28632 - Removes "1" from SBR06 for primary payer when 2ndry payer billed  ;abm*2.6*9 NOHEAT

 +8       ;.I $G(ABMLOOP)=2320,ABMPST=1 S ABMR("SBR",70)=""  ;Removes "1" from SBR06 for primary payer when 2ndry payer billed  ;abm*2.6*9 NO HEAT

 +9       ;end old code

 +10       QUIT 

80        ;SBR07 - Yes/No Condition or Response Code

 +1        SET ABMR("SBR",80)=""

 +2        QUIT 

90        ;SBR08 - Employment Status Code

 +1        SET ABMR("SBR",90)=""

 +2        QUIT 

100       ;SBR09 - Claim Filing Indicator Code

 +1        SET ABMR("SBR",100)=$GET(ABMP("SOP",ABMPST))

 +2        IF ABMR("SBR",100)="SP"

               SET ABMR("SBR",100)="CI"

 +3        QUIT