ABME8OI.m

ABME8OI ; IHS/ASDST/DMJ - 837 OI Segment 

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Transaction Set Header

 ;

START ;START HERE

 K ABMREC("OI"),ABMR("OI")

 S ABME("RTYPE")="OI"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:70 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;OI01 - Claim Filing Indicator Code

 S ABMR("OI",20)=""

 Q

30 ;OI02 - Claim Submission Reason Code

 S ABMR("OI",30)=""

 Q

40 ;OI03 - Assignment of Benefits

 S ABMR("OI",40)=$P(ABMB7,"^",5)

 Q

50 ;OI04 - Patient Signature Source Code

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

 Q:ABMP("EXP")'=22

 I $P(ABMB7,"^",4,5)="Y^Y" S ABMR("OI",50)="B" Q

 I $P(ABMB7,"^",4)="Y" S ABMR("OI",50)="S" Q

 I $P(ABMB7,"^",5)="Y" S ABMR("OI",50)="M" Q

 Q

60 ;OI05 - Provider Agreement Code

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

 Q

70 ;OI06 - Release of Information Code

 S ABMR("OI",70)=$P(ABMB7,"^",4)

 S:ABMR("OI",70)="R" ABMR("OI",70)="M"

 Q

ABME8OI   ; IHS/ASDST/DMJ - 837 OI Segment 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Transaction Set Header

 +3       ;

START     ;START HERE

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

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

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:70

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;OI01 - Claim Filing Indicator Code

 +1        SET ABMR("OI",20)=""

 +2        QUIT 

30        ;OI02 - Claim Submission Reason Code

 +1        SET ABMR("OI",30)=""

 +2        QUIT 

40        ;OI03 - Assignment of Benefits

 +1        SET ABMR("OI",40)=$PIECE(ABMB7,"^",5)

 +2        QUIT 

50        ;OI04 - Patient Signature Source Code

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

 +2        IF ABMP("EXP")'=22

               QUIT 

 +3        IF $PIECE(ABMB7,"^",4,5)="Y^Y"

               SET ABMR("OI",50)="B"

               QUIT 

 +4        IF $PIECE(ABMB7,"^",4)="Y"

               SET ABMR("OI",50)="S"

               QUIT 

 +5        IF $PIECE(ABMB7,"^",5)="Y"

               SET ABMR("OI",50)="M"

               QUIT 

 +6        QUIT 

60        ;OI05 - Provider Agreement Code

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

 +2        QUIT 

70        ;OI06 - Release of Information Code

 +1        SET ABMR("OI",70)=$PIECE(ABMB7,"^",4)

 +2        IF ABMR("OI",70)="R"

               SET ABMR("OI",70)="M"

 +3        QUIT