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
