ABME5K3.m

ABME5K3 ; IHS/ASDST/DMJ - 837 K3 Segment 

 ;;2.6;IHS Third Party Billing System;**6**;NOV 12, 2009

 ;Transaction Set Header

 ;

EP ;EP - START HERE

 K ABMREC("K3"),ABMR("K3")

 S ABME("RTYPE")="K3"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:40 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;K301 - Fixed Format Information

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

 S ABMSTR=""

 S ABMPRI=0

 F  S ABMPRI=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMPRI)) Q:+ABMPRI=0  D

 .S ABMMIEN=0

 .F  S ABMMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMPRI,ABMMIEN))  Q:+ABMMIEN=0  D

 ..S ABMSTR=$G(ABMSTR)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABMMIEN,0)),U,5)

 I $G(ABMSTR)'="" S ABMR("K3",20)="POA"_ABMSTR_"Z"

 Q

30 ;K302 - Record Format Code - not used

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

 Q

40 ;K303 - Composite Unit of Measure - not used

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

 Q

ABME5K3   ; IHS/ASDST/DMJ - 837 K3 Segment 

 +1       ;;2.6;IHS Third Party Billing System;**6**;NOV 12, 2009

 +2       ;Transaction Set Header

 +3       ;

EP        ;EP - START HERE

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

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

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:40

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;K301 - Fixed Format Information

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

 +2        SET ABMSTR=""

 +3        SET ABMPRI=0

 +4        FOR 

               SET ABMPRI=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMPRI))

               IF +ABMPRI=0

                   QUIT 

               Begin DoDot:1

 +5                SET ABMMIEN=0

 +6                FOR 

                       SET ABMMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,"C",ABMPRI,ABMMIEN))

                       IF +ABMMIEN=0

                           QUIT 

                       Begin DoDot:2

 +7                        SET ABMSTR=$GET(ABMSTR)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),17,ABMMIEN,0)),U,5)

                       End DoDot:2

               End DoDot:1

 +8        IF $GET(ABMSTR)'=""

               SET ABMR("K3",20)="POA"_ABMSTR_"Z"

 +9        QUIT 

30        ;K302 - Record Format Code - not used

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

 +2        QUIT 

40        ;K303 - Composite Unit of Measure - not used

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

 +2        QUIT