ABMDESML.m

ABMDESML ; IHS/ASDST/DMJ - Summarized Claim LAB Charges ;

 ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213

 ;

 ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider

 ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple

 ; IHS/SD/SDR - v2.5 p11 - NPI

 ; IHS/SD/SDR - v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K

 ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35

 ;

LAB ;EP for Lab Charges

 I $G(ABMP("VTYP",996)),'$G(ABMPRINT) Q:ABMP("VTYP",996)'=ABMP("EXP")

 S ABMCAT=37 D PCK^ABMDESM1 Q:$G(ABMQUIT)

 S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"37,"_ABMX_")")) Q:'ABMX  S ABMX("X")=ABMX D LAB1

 Q

OUT ;OUTSIDE LAB

 Q:'$D(ABMP(638))

 Q:'$P($G(@(ABMP("GL")_"8)")),U)  S ABMX("SUB")=$P(^(8),U),ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" S ABMX("R")=300 D REVN Q

 S ABMS(ABMS("I"))=ABMX("SUB"),$P(ABMS(ABMS("I")),U,8)="OUTSIDE LAB TESTS"

 S ABMCAT=37 D HDT^ABMDESM1

 S ABMS("I")=ABMS("I")+1

 Q

 ;

LAB1 S ABMX(0)=@(ABMP("GL")_"37,"_ABMX("X")_",0)")

 S ABMZ("UNIT")=$P(ABMX(0),U,3)

 S:'+ABMZ("UNIT") ABMZ("UNIT")=1

 S ABMX("SUB")=(ABMZ("UNIT")*$P(ABMX(0),U,4))

 S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G LABH

 ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code

LABU S ABMX("R")=$P(ABMX(0),U,2) Q:ABMX("R")=""  D REVN

 Q

 ;

 ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description

LABH S ABMS(ABMS("I"))=ABMX("SUB")

 S ABMCAT=37 D HDT^ABMDESM1

 S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,6)]"":"-"_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":"-"_$P(ABMX(0),U,7),1:"")_$S($P(ABMX(0),U,8)]"":"-"_$P(ABMX(0),U,8),1:"")

 ;I ABMP("EXP")=27 D   ;abm*2.6*13 export mode 35

 I ABMP("EXP")=27!(ABMP("EXP")=35) D   ;abm*2.6*13 export mode 35

 .S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,6)]"":"   "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"")_$S($P(ABMX(0),U,8)]"":" "_$P(ABMX(0),U,8),1:"")

 S $P(ABMS(ABMS("I")),"^",5)=$P(ABMX(0),"^",9)

 S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")

 S $P(ABMS(ABMS("I")),U,7)=5

 S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),U,15)  ;POS  ;IHS/SD/AML 5/10/11 HEAT35787

 S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)  ;CSV-c

 S ABMX(0)=@(ABMP("GL")_"37,"_ABMX("X")_",0)")

 S ABMDPRV=$O(@(ABMP("GL")_"37,"_ABMX_",""P"",""C"",""R"",0)"))

 S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"37,"_ABMX_",""P"","_ABMDPRV_",0)")),U)

 I $G(ABMDPRV)="" S ABMDPRV=$$GETPRV^ABMDFUTL

 I +$G(ABMDPRV)'=0 D

 .Q:'$$K24^ABMDFUTL

 .S $P(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)

 .S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)

 .I $G(ABMP("NPIS"))="N" S $P(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)

 Q

 ;

CPT I ABMX("C")]"" S ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)  ;CSV-c

 Q

 ;

REVN I $D(ABMS(ABMX("R"))) S $P(ABMS(ABMX("R")),U)=$P(ABMS(ABMX("R")),U)+ABMX("SUB")

 E  S ABMS(ABMX("R"))=ABMX("SUB")

 Q

ABMDESML  ; IHS/ASDST/DMJ - Summarized Claim LAB Charges ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213

 +2       ;

 +3       ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider

 +4       ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple

 +5       ; IHS/SD/SDR - v2.5 p11 - NPI

 +6       ; IHS/SD/SDR - v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K

 +7       ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes

 +8       ;

 +9       ; IHS/SD/SDR - v2.6 CSV

 +10      ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35

 +11      ;

LAB       ;EP for Lab Charges

 +1        IF $GET(ABMP("VTYP",996))

               IF '$GET(ABMPRINT)

                   IF ABMP("VTYP",996)'=ABMP("EXP")

                       QUIT 

 +2        SET ABMCAT=37

           DO PCK^ABMDESM1

           IF $GET(ABMQUIT)

               QUIT 

 +3        SET ABMX=0

           FOR ABMS("I")=ABMS("I"):1

               SET ABMX=$ORDER(@(ABMP("GL")_"37,"_ABMX_")"))

               IF 'ABMX

                   QUIT 

               SET ABMX("X")=ABMX

               DO LAB1

 +4        QUIT 

OUT       ;OUTSIDE LAB

 +1        IF '$DATA(ABMP(638))

               QUIT 

 +2        IF '$PIECE($GET(@(ABMP("GL")_"8)")),U)

               QUIT 

           SET ABMX("SUB")=$PIECE(^(8),U)

           SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 +3        IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"

               SET ABMX("R")=300

               DO REVN

               QUIT 

 +4        SET ABMS(ABMS("I"))=ABMX("SUB")

           SET $PIECE(ABMS(ABMS("I")),U,8)="OUTSIDE LAB TESTS"

 +5        SET ABMCAT=37

           DO HDT^ABMDESM1

 +6        SET ABMS("I")=ABMS("I")+1

 +7        QUIT 

 +8       ;

LAB1       SET ABMX(0)=@(ABMP("GL")_"37,"_ABMX("X")_",0)")

 +1        SET ABMZ("UNIT")=$PIECE(ABMX(0),U,3)

 +2        IF '+ABMZ("UNIT")

               SET ABMZ("UNIT")=1

 +3        SET ABMX("SUB")=(ABMZ("UNIT")*$PIECE(ABMX(0),U,4))

 +4        SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 +5        IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"

               GOTO LABH

 +6       ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code

LABU       SET ABMX("R")=$PIECE(ABMX(0),U,2)

           IF ABMX("R")=""

               QUIT 

           DO REVN

 +1        QUIT 

 +2       ;

 +3       ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description

LABH       SET ABMS(ABMS("I"))=ABMX("SUB")

 +1        SET ABMCAT=37

           DO HDT^ABMDESM1

 +2        SET ABMX("C")=$PIECE(ABMX(0),U)

           DO CPT

           SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,6)]"":"-"_$PIECE(ABMX(0),U,6),1:"")_$SELECT($PIECE(ABMX(0),U,7)]"":"-"_$PIECE(ABMX(0),U,7),1:"")_$SELECT($PIECE(ABMX(0),U,8)]"":"-"_$PIECE(ABMX(0),U,8),1:"")

 +3       ;I ABMP("EXP")=27 D   ;abm*2.6*13 export mode 35

 +4       ;abm*2.6*13 export mode 35

           IF ABMP("EXP")=27!(ABMP("EXP")=35)

               Begin DoDot:1

 +5                SET ABMX("C")=$PIECE(ABMX(0),U)

                   DO CPT

                   SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,6)]"":"   "_$PIECE(ABMX(0),U,6),1:"")_$SELECT($PIECE(ABMX(0),U,7)]"":" "_$PIECE(ABMX(0),U,7),1:"")_$SELECT($PIECE(ABMX(0),U,8)]"":" "_$PIECE(ABMX(0),U,8),1:"")

               End DoDot:1

 +6        SET $PIECE(ABMS(ABMS("I")),"^",5)=$PIECE(ABMX(0),"^",9)

 +7        SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")

 +8        SET $PIECE(ABMS(ABMS("I")),U,7)=5

 +9       ;POS  ;IHS/SD/AML 5/10/11 HEAT35787

           SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),U,15)

 +10      ;CSV-c

           SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)

 +11       SET ABMX(0)=@(ABMP("GL")_"37,"_ABMX("X")_",0)")

 +12       SET ABMDPRV=$ORDER(@(ABMP("GL")_"37,"_ABMX_",""P"",""C"",""R"",0)"))

 +13       IF +ABMDPRV'=0

               SET ABMDPRV=$PIECE($GET(@(ABMP("GL")_"37,"_ABMX_",""P"","_ABMDPRV_",0)")),U)

 +14       IF $GET(ABMDPRV)=""

               SET ABMDPRV=$$GETPRV^ABMDFUTL

 +15       IF +$GET(ABMDPRV)'=0

               Begin DoDot:1

 +16               IF '$$K24^ABMDFUTL

                       QUIT 

 +17               SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)

 +18               SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)

 +19               IF $GET(ABMP("NPIS"))="N"

                       SET $PIECE(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)

               End DoDot:1

 +20       QUIT 

 +21      ;

CPT       ;CSV-c

           IF ABMX("C")]""

               SET ABMX("C")=$PIECE($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)

 +1        QUIT 

 +2       ;

REVN       IF $DATA(ABMS(ABMX("R")))

               SET $PIECE(ABMS(ABMX("R")),U)=$PIECE(ABMS(ABMX("R")),U)+ABMX("SUB")

 +1       IF '$TEST

               SET ABMS(ABMX("R"))=ABMX("SUB")

 +2        QUIT