Routine: ABMERGR4

ABMERGR4 ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;

 ;;2.6;IHS Third Party Billing;**22**;NOV 12, 2009;Build 418

 ;IHS/SD/SDR 2.6*22 HEAT335246 New routine.  This will get line items like an itemized claim, but use the flat rate for the charge on the first line and zero the other lines out.

START ;EP

 K I,J,L

 S M=0

 S I=0

 F  S I=$O(ABMRV(I)) Q:'I  D

 .S J=""

 .F  S J=$O(ABMRV(I,J)) Q:($G(J)="")  D

 ..I J=0 K ABMRV(I,J)  ;remove flat rate line and only print detail lines

 ..S L=0

 ..F  S L=$O(ABMRV(I,J,L)) Q:'L  D

 ...S M=+M+1

 ...I M=1 D  ;first line gets flat rate amount, flat rate rev code and 1 unit

 ....S $P(ABMRV(I,J,L),U,6)=+ABMP("FLAT")

 ....S $P(ABMRV(I,J,L),U)=$P(ABMP("FLAT"),U,2)

 ....S $P(ABMRV(I,J,L),U,5)=1

 ...I M'=1 S $P(ABMRV(I,J,L),U,6)=0,$P(ABMRV(I,J,L),U,5)=0  ;zeros for all other lines

ABMERGR4  ; IHS/SD/SDR - GET ANCILLARY SVCS REVENUE CODE INFO ;

 +1       ;;2.6;IHS Third Party Billing;**22**;NOV 12, 2009;Build 418

 +2       ;IHS/SD/SDR 2.6*22 HEAT335246 New routine.  This will get line items like an itemized claim, but use the flat rate for the charge on the first line and zero the other lines out.

 +3       ;

START     ;EP

 +1        KILL I,J,L

 +2        SET M=0

 +3        SET I=0

 +4        FOR

               SET I=$ORDER(ABMRV(I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +5                SET J=""

 +6                FOR

                       SET J=$ORDER(ABMRV(I,J))

                       IF ($GET(J)="")

                           QUIT

                       Begin DoDot:2

 +7       ;remove flat rate line and only print detail lines

                           IF J=0

                               KILL ABMRV(I,J)

 +8                        SET L=0

 +9                        FOR

                               SET L=$ORDER(ABMRV(I,J,L))

                               IF 'L

                                   QUIT

                               Begin DoDot:3

 +10                               SET M=+M+1

 +11      ;first line gets flat rate amount, flat rate rev code and 1 unit

                                   IF M=1

                                       Begin DoDot:4

 +12                                       SET $PIECE(ABMRV(I,J,L),U,6)=+ABMP("FLAT")

 +13                                       SET $PIECE(ABMRV(I,J,L),U)=$PIECE(ABMP("FLAT"),U,2)

 +14                                       SET $PIECE(ABMRV(I,J,L),U,5)=1

                                       End DoDot:4

 +15      ;zeros for all other lines

                                   IF M'=1

                                       SET $PIECE(ABMRV(I,J,L),U,6)=0

                                       SET $PIECE(ABMRV(I,J,L),U,5)=0

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16       QUIT

ABMERGR4.m