ABME5SV3.m

ABME5SV3 ; IHS/ASDST/DMJ - 837 SV3 Segment 

 ;;2.6;IHS Third Party Billing System;**6,9,16,19**;NOV 12, 2009;Build 300

 ;Transaction Set Header

 ;IHS/SD/SDR 2.6*16 - HEAT236242 - Updated to include coor. dx on line item

 ;IHS/SD/SDR - 2.6*19 - HEAT180453 - Made AREA OF ORAL CAVITY print in SV304

 ;

EP ;EP

 K ABMREC("SV3"),ABMR("SV3")

 S ABME("RTYPE")="SV3"

 D LOOP

 K ABME

 Q

LOOP ;LOOP HERE

 F I=10:10:120 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;SV301 - Composite Medical Procedure Identifier

 ;SV301-1 Product Service ID Qualifier

 ;SV301-2 Product Service ID (Procedure Code)

 S ABMR("SV3",20)="AD"

 S $P(ABMR("SV3",20),":",2)=$P(ABMRV(ABMI,ABMJ,ABMK),U,2)

 N I

 F I=3,4,12,22 D

 .Q:$P(ABMRV(ABMI,ABMJ,ABMK),U,I)=""

 .S ABMR("SV3",20)=ABMR("SV3",20)_":"_$P(ABMRV(ABMI,ABMJ,ABMK),U,I)

 I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,39)'="" S $P(ABMR("SV3",20),":",7)=$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,39)  ;abm*2.6*9 NARR

 Q

30 ;SV302 - Monetary Amount (Charges)

 S ABMR("SV3",30)=$P(ABMRV(ABMI,ABMJ,ABMK),U,6)

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

 Q

40 ;SV303 - Place of service

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

 Q

50 ;SV304 - Oral Cavity Designation

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

 S ABMR("SV3",50)=$P($G(ABMRV(ABMI,ABMJ,ABMK)),U,40)  ;area of oral cavity  ;abm*2.6*19 IHS/SD/SDR HEAT180453

 Q

60 ;SV305 - Prothesis, Crown, or Inlay Code

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

 Q

70 ;SV306 - Quantity

 ;S ABMR("SV3",70)=$P(ABMRV(ABMI,ABMJ,ABMK),U,5)  ;abm*2.6*9 NOHEAT

 S ABMR("SV3",70)=""  ;abm*2.6*9 NOHEAT

 S:$P(ABMRV(ABMI,ABMJ,ABMK),U,5)>1 ABMR("SV3",70)=$P(ABMRV(ABMI,ABMJ,ABMK),U,5)  ;abm*2.6*9 NOHEAT

 I $P($G(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID" S ABMR("SV3",70)=$P(ABMRV(ABMI,ABMJ,ABMK),U,5)  ;IHS/SD/AML 12/27/12 HEAT95806

 Q

80 ;SV307 - Description

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

 Q

90 ;SV308 - Copay Status Code

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

 Q

100 ;SV309 - Provider Agreement Code

 S ABMR("SV3",100)=""

 Q

110 ;SV310 - not used

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

 Q

120 ;SV311 - Composite DX Code Pointer

 S ABMR("SV3",120)=""

 ;start new abm*2.6*16 IHS/SD/SDR HEAT236242

 S ABMR("SV3",120)=$P(ABMRV(ABMI,ABMJ,ABMK),U,11)

 S ABMR("SV3",120)=$TR(ABMR("SV3",120),",",":")

 S ABMR("SV3",120)=$P(ABMR("SV3",120),":",1,4)

 ;end new abm*2.6*16 IHS/SD/SDR HEAT236242

 Q

ABME5SV3  ; IHS/ASDST/DMJ - 837 SV3 Segment 

 +1       ;;2.6;IHS Third Party Billing System;**6,9,16,19**;NOV 12, 2009;Build 300

 +2       ;Transaction Set Header

 +3       ;IHS/SD/SDR 2.6*16 - HEAT236242 - Updated to include coor. dx on line item

 +4       ;IHS/SD/SDR - 2.6*19 - HEAT180453 - Made AREA OF ORAL CAVITY print in SV304

 +5       ;

EP        ;EP

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

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

 +3        DO LOOP

 +4        KILL ABME

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:120

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;SV301 - Composite Medical Procedure Identifier

 +1       ;SV301-1 Product Service ID Qualifier

 +2       ;SV301-2 Product Service ID (Procedure Code)

 +3        SET ABMR("SV3",20)="AD"

 +4        SET $PIECE(ABMR("SV3",20),":",2)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,2)

 +5        NEW I

 +6        FOR I=3,4,12,22

               Begin DoDot:1

 +7                IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,I)=""

                       QUIT 

 +8                SET ABMR("SV3",20)=ABMR("SV3",20)_":"_$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,I)

               End DoDot:1

 +9       ;abm*2.6*9 NARR

           IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,39)'=""

               SET $PIECE(ABMR("SV3",20),":",7)=$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,39)

 +10       QUIT 

30        ;SV302 - Monetary Amount (Charges)

 +1        SET ABMR("SV3",30)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,6)

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

 +3        QUIT 

40        ;SV303 - Place of service

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

 +2        QUIT 

50        ;SV304 - Oral Cavity Designation

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

 +2       ;area of oral cavity  ;abm*2.6*19 IHS/SD/SDR HEAT180453

           SET ABMR("SV3",50)=$PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,40)

 +3        QUIT 

60        ;SV305 - Prothesis, Crown, or Inlay Code

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

 +2        QUIT 

70        ;SV306 - Quantity

 +1       ;S ABMR("SV3",70)=$P(ABMRV(ABMI,ABMJ,ABMK),U,5)  ;abm*2.6*9 NOHEAT

 +2       ;abm*2.6*9 NOHEAT

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

 +3       ;abm*2.6*9 NOHEAT

           IF $PIECE(ABMRV(ABMI,ABMJ,ABMK),U,5)>1

               SET ABMR("SV3",70)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,5)

 +4       ;IHS/SD/AML 12/27/12 HEAT95806

           IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["WASHINGTON MEDICAID"

               SET ABMR("SV3",70)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,5)

 +5        QUIT 

80        ;SV307 - Description

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

 +2        QUIT 

90        ;SV308 - Copay Status Code

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

 +2        QUIT 

100       ;SV309 - Provider Agreement Code

 +1        SET ABMR("SV3",100)=""

 +2        QUIT 

110       ;SV310 - not used

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

 +2        QUIT 

120       ;SV311 - Composite DX Code Pointer

 +1        SET ABMR("SV3",120)=""

 +2       ;start new abm*2.6*16 IHS/SD/SDR HEAT236242

 +3        SET ABMR("SV3",120)=$PIECE(ABMRV(ABMI,ABMJ,ABMK),U,11)

 +4        SET ABMR("SV3",120)=$TRANSLATE(ABMR("SV3",120),",",":")

 +5        SET ABMR("SV3",120)=$PIECE(ABMR("SV3",120),":",1,4)

 +6       ;end new abm*2.6*16 IHS/SD/SDR HEAT236242

 +7        QUIT