ABMER60.m

ABMER60 ; IHS/ASDST/DMJ - UB92 EMC RECORD 60 (Inpatient Ancillary Services) ; 

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

 ;Original;DMJ;07/08/96 4:56 PM

 ;

 ; IHS/FCS/DRS 09/17/01 ABM*2.4*9 

 ;   Part 17 - Proper init of ancillary charges slots.

 ;   They demand that even unused slots have 0 in numeric bytes,

 ;   not spaces.

 ;

 ; IHS/SD/SDR - v2.5 p10 - IM20395

 ;  Split out lines bundled by rev code

 ;

START ;START HERE

 K ABMR(60),ABMREC(60)

 S ABME("RTYPE")=60,ABME("S#")=0

 S $P(ABME("SPACE1")," ",113)=""

 S $P(ABME("SPACE2")," ",57)=""

 I $$ENVOY^ABMEF16 D

 .N X S X="0000         000000000000000000000000000    000000      "

 .S ABME("SPACE1")=X_X,ABME("SPACE2")=X

 D SET^ABMERUTL

 K ABMP("FLAT") D FRATE^ABMDF11

 D ^ABMERGRV

 D LOOP

 S L=0 F  S L=$O(ABMREC(60,L)) Q:'L  D S90^ABMERUTL

 K ABM,ABME,ABMRV

 Q

 ;

LOOP ;LOOP HERE

 I $$RCID^ABMERUTL(ABMP("INS"))["MAD" D

 .K ABMRV(9999)

 S L=0

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

 .S K=-1 F  S K=$O(ABMRV(J,K)) Q:K=""  D

 ..S M=0

 ..F  S M=$O(ABMRV(J,K,M)) Q:M=""  D

 ...S L=L+1 I L#3=1 D

 ....S ABME("S#")=ABME("S#")+1

 ....F I=10:10:30 D @(I_"^ABMER60"),ADD

 ...F I=40:10:120 D @(I_"^ABMER60"),ADD

 ...Q:J=9999

 ...S ABM("ACTOT")=+$P(ABMRV(J,K,M),U,6)

 ...S ABM("NCTOT")=+$P(ABMRV(J,K,M),U,7)

 ...D ADTT

 I '$G(ABMP("NOFMT")) S ABMREC(60,ABME("S#"))=ABMREC(60,ABME("S#"))_$S(L#3=1:ABME("SPACE1"),L#3=2:ABME("SPACE2"),1:"")

 Q

 ;

ADD ;ADD TO RECORD

 I '$G(ABMP("NOFMT")) S ABMREC(60,ABME("S#"))=$G(ABMREC(60,ABME("S#")))_ABMR(60,I)

 Q

 ;

10 ;Record type

 S ABMR(60,10)=60

 Q

 ;

20 ;Sequence 

 S ABMR(60,20)=ABME("S#")

 S ABMR(60,20)=$$FMT^ABMERUTL(ABMR(60,20),"2NR")

 Q

 ;

30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)

 S ABMR(60,30)=$$EX^ABMER20(30,ABMP("BDFN"))

 S ABMR(60,30)=$$FMT^ABMERUTL(ABMR(60,30),20)

 Q

 ;

40 ;Outpatient Revenue Code 1 (SOURCE: FILE=, FIELD=)

 S ABMR(60,40)=$P(ABMRV(J,K,M),U)

 S ABMR(60,40)=$$FMT^ABMERUTL(ABMR(60,40),"4NR")

 Q

 ;

50 ;HCPCS Procedure Code 1

 S ABMR(60,50)=$P(ABMRV(J,K,M),U,2)

 S ABMR(60,50)=$$FMT^ABMERUTL(ABMR(60,50),5)

 Q

 ;

60 ;Modifier 1 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)

 S ABMR(60,60)=$P(ABMRV(J,K,M),U,3)

 S ABMR(60,60)=$$FMT^ABMERUTL(ABMR(60,60),2)

 Q

 ;

70 ;Modifier 2 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)

 S ABMR(60,70)=$P(ABMRV(J,K,M),U,4)

 S ABMR(60,70)=$$FMT^ABMERUTL(ABMR(60,70),2)

 Q

 ;

80 ;Units of Service 1 (SOURCE: FILE= FIELD=)

 S ABMR(60,80)=$P(ABMRV(J,K,M),U,5)

 S ABMR(60,80)=$$FMT^ABMERUTL(ABMR(60,80),"7NR")

 Q

 ;

90 ;Charges Total 1 (SOURCE: FILE= FIELD=)

 S ABMR(60,90)=$P(ABMRV(J,K,M),U,6)

 S ABMR(60,90)=$$FMT^ABMERUTL(ABMR(60,90),"10NRJ2")

 Q

 ;

100 ;Charges Non-Covered 1

 S ABMR(60,100)=""

 S ABMR(60,100)=$$FMT^ABMERUTL(ABMR(60,100),"10NRJ2")

 Q

 ;

110 ;Form Locator 49 1 (SOURCE: FILE= FIELD=)

 S ABMR(60,110)=""

 S ABMR(60,110)=$$FMT^ABMERUTL(ABMR(60,110),4)

 Q

 ;

120 ;Filler (National Use)

 S ABMR(60,120)=""

 S ABMR(60,120)=$$FMT^ABMERUTL(ABMR(60,120),12)

 Q

 ;

EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE

 ;X=data element, Y=bill internal entry number

 S ABMP("BDFN")=ABMY D SET^ABMERUTL

 I '$G(ABMP("NOFMT")) S ABMP("FMT")=0

 D @ABMX

 S Y=ABMR(60,ABMX)

 I $D(ABMP("FMT")) S ABMP("FMT")=1

 K ABMR(60,ABMX),ABME,ABMX,ABMY,ABMZ,ABM

 Q Y

 ;

ADTT ; EP

 ; Add to totals

 S ABMRT(90,150)=+$G(ABMRT(90,150))+ABM("ACTOT")

 S ABMRT(90,160)=+$G(ABMRT(90,160))+ABM("NCTOT")

 S ABMRT(95,100)=+$G(ABMRT(95,100))+ABM("ACTOT")

 S ABMRT(95,110)=+$G(ABMRT(95,110))+ABM("NCTOT")

 S ABMRT(99,80)=+$G(ABMRT(99,80))+ABM("ACTOT")

 S ABMRT(99,90)=+$G(ABMRT(99,90))+ABM("NCTOT")

 Q

ABMER60   ; IHS/ASDST/DMJ - UB92 EMC RECORD 60 (Inpatient Ancillary Services) ; 

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

 +2       ;Original;DMJ;07/08/96 4:56 PM

 +3       ;

 +4       ; IHS/FCS/DRS 09/17/01 ABM*2.4*9 

 +5       ;   Part 17 - Proper init of ancillary charges slots.

 +6       ;   They demand that even unused slots have 0 in numeric bytes,

 +7       ;   not spaces.

 +8       ;

 +9       ; IHS/SD/SDR - v2.5 p10 - IM20395

 +10      ;  Split out lines bundled by rev code

 +11      ;

START     ;START HERE

 +1        KILL ABMR(60),ABMREC(60)

 +2        SET ABME("RTYPE")=60

           SET ABME("S#")=0

 +3        SET $PIECE(ABME("SPACE1")," ",113)=""

 +4        SET $PIECE(ABME("SPACE2")," ",57)=""

 +5        IF $$ENVOY^ABMEF16

               Begin DoDot:1

 +6                NEW X

                   SET X="0000         000000000000000000000000000    000000      "

 +7                SET ABME("SPACE1")=X_X

                   SET ABME("SPACE2")=X

               End DoDot:1

 +8        DO SET^ABMERUTL

 +9        KILL ABMP("FLAT")

           DO FRATE^ABMDF11

 +10       DO ^ABMERGRV

 +11       DO LOOP

 +12       SET L=0

           FOR 

               SET L=$ORDER(ABMREC(60,L))

               IF 'L

                   QUIT 

               DO S90^ABMERUTL

 +13       KILL ABM,ABME,ABMRV

 +14       QUIT 

 +15      ;

LOOP      ;LOOP HERE

 +1        IF $$RCID^ABMERUTL(ABMP("INS"))["MAD"

               Begin DoDot:1

 +2                KILL ABMRV(9999)

               End DoDot:1

 +3        SET L=0

 +4        SET J=219

           FOR 

               SET J=$ORDER(ABMRV(J))

               IF 'J

                   QUIT 

               Begin DoDot:1

 +5                SET K=-1

                   FOR 

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

                       IF K=""

                           QUIT 

                       Begin DoDot:2

 +6                        SET M=0

 +7                        FOR 

                               SET M=$ORDER(ABMRV(J,K,M))

                               IF M=""

                                   QUIT 

                               Begin DoDot:3

 +8                                SET L=L+1

                                   IF L#3=1

                                       Begin DoDot:4

 +9                                        SET ABME("S#")=ABME("S#")+1

 +10                                       FOR I=10:10:30

                                               DO @(I_"^ABMER60")

                                               DO ADD

                                       End DoDot:4

 +11                               FOR I=40:10:120

                                       DO @(I_"^ABMER60")

                                       DO ADD

 +12                               IF J=9999

                                       QUIT 

 +13                               SET ABM("ACTOT")=+$PIECE(ABMRV(J,K,M),U,6)

 +14                               SET ABM("NCTOT")=+$PIECE(ABMRV(J,K,M),U,7)

 +15                               DO ADTT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16       IF '$GET(ABMP("NOFMT"))

               SET ABMREC(60,ABME("S#"))=ABMREC(60,ABME("S#"))_$SELECT(L#3=1:ABME("SPACE1"),L#3=2:ABME("SPACE2"),1:"")

 +17       QUIT 

 +18      ;

ADD       ;ADD TO RECORD

 +1        IF '$GET(ABMP("NOFMT"))

               SET ABMREC(60,ABME("S#"))=$GET(ABMREC(60,ABME("S#")))_ABMR(60,I)

 +2        QUIT 

 +3       ;

10        ;Record type

 +1        SET ABMR(60,10)=60

 +2        QUIT 

 +3       ;

20        ;Sequence 

 +1        SET ABMR(60,20)=ABME("S#")

 +2        SET ABMR(60,20)=$$FMT^ABMERUTL(ABMR(60,20),"2NR")

 +3        QUIT 

 +4       ;

30        ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)

 +1        SET ABMR(60,30)=$$EX^ABMER20(30,ABMP("BDFN"))

 +2        SET ABMR(60,30)=$$FMT^ABMERUTL(ABMR(60,30),20)

 +3        QUIT 

 +4       ;

40        ;Outpatient Revenue Code 1 (SOURCE: FILE=, FIELD=)

 +1        SET ABMR(60,40)=$PIECE(ABMRV(J,K,M),U)

 +2        SET ABMR(60,40)=$$FMT^ABMERUTL(ABMR(60,40),"4NR")

 +3        QUIT 

 +4       ;

50        ;HCPCS Procedure Code 1

 +1        SET ABMR(60,50)=$PIECE(ABMRV(J,K,M),U,2)

 +2        SET ABMR(60,50)=$$FMT^ABMERUTL(ABMR(60,50),5)

 +3        QUIT 

 +4       ;

60        ;Modifier 1 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)

 +1        SET ABMR(60,60)=$PIECE(ABMRV(J,K,M),U,3)

 +2        SET ABMR(60,60)=$$FMT^ABMERUTL(ABMR(60,60),2)

 +3        QUIT 

 +4       ;

70        ;Modifier 2 (CPT-4 and HCPCS) 1 (SOURCE: FILE=, FIELD=)

 +1        SET ABMR(60,70)=$PIECE(ABMRV(J,K,M),U,4)

 +2        SET ABMR(60,70)=$$FMT^ABMERUTL(ABMR(60,70),2)

 +3        QUIT 

 +4       ;

80        ;Units of Service 1 (SOURCE: FILE= FIELD=)

 +1        SET ABMR(60,80)=$PIECE(ABMRV(J,K,M),U,5)

 +2        SET ABMR(60,80)=$$FMT^ABMERUTL(ABMR(60,80),"7NR")

 +3        QUIT 

 +4       ;

90        ;Charges Total 1 (SOURCE: FILE= FIELD=)

 +1        SET ABMR(60,90)=$PIECE(ABMRV(J,K,M),U,6)

 +2        SET ABMR(60,90)=$$FMT^ABMERUTL(ABMR(60,90),"10NRJ2")

 +3        QUIT 

 +4       ;

100       ;Charges Non-Covered 1

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

 +2        SET ABMR(60,100)=$$FMT^ABMERUTL(ABMR(60,100),"10NRJ2")

 +3        QUIT 

 +4       ;

110       ;Form Locator 49 1 (SOURCE: FILE= FIELD=)

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

 +2        SET ABMR(60,110)=$$FMT^ABMERUTL(ABMR(60,110),4)

 +3        QUIT 

 +4       ;

120       ;Filler (National Use)

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

 +2        SET ABMR(60,120)=$$FMT^ABMERUTL(ABMR(60,120),12)

 +3        QUIT 

 +4       ;

EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE

 +1       ;X=data element, Y=bill internal entry number

 +2        SET ABMP("BDFN")=ABMY

           DO SET^ABMERUTL

 +3        IF '$GET(ABMP("NOFMT"))

               SET ABMP("FMT")=0

 +4        DO @ABMX

 +5        SET Y=ABMR(60,ABMX)

 +6        IF $DATA(ABMP("FMT"))

               SET ABMP("FMT")=1

 +7        KILL ABMR(60,ABMX),ABME,ABMX,ABMY,ABMZ,ABM

 +8        QUIT Y

 +9       ;

ADTT      ; EP

 +1       ; Add to totals

 +2        SET ABMRT(90,150)=+$GET(ABMRT(90,150))+ABM("ACTOT")

 +3        SET ABMRT(90,160)=+$GET(ABMRT(90,160))+ABM("NCTOT")

 +4        SET ABMRT(95,100)=+$GET(ABMRT(95,100))+ABM("ACTOT")

 +5        SET ABMRT(95,110)=+$GET(ABMRT(95,110))+ABM("NCTOT")

 +6        SET ABMRT(99,80)=+$GET(ABMRT(99,80))+ABM("ACTOT")

 +7        SET ABMRT(99,90)=+$GET(ABMRT(99,90))+ABM("NCTOT")

 +8        QUIT