ABMEHGR4.m

ABMEHGR4 ; 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

 ..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

 Q

ABMEHGR4  ; 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                        SET L=0

 +8                        FOR 

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

                               IF 'L

                                   QUIT 

                               Begin DoDot:3

 +9                                SET M=+M+1

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

                                   IF M=1

                                       Begin DoDot:4

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

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

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

                                       End DoDot:4

 +14      ;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

 +15       QUIT