ABMDESMX ; IHS/ASDST/DMJ - Summarized Claim RADIOLOGY charges ;
;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213
;
; IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
; 0.00 charges on HCFA because version 2.0 does not assume
; 1 for units. Modify code to set units to 1 if not
; already defined.
;
; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
; 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
;
RAD ;EP for adding Radiology
I $G(ABMP("VTYP",995)),'$G(ABMPRINT) Q:ABMP("VTYP",995)'=ABMP("EXP")
S ABMCAT=35 D PCK^ABMDESM1 Q:$G(ABMQUIT)
S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"35,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D RAD1
Q
;
RAD1 S ABMX(0)=@(ABMP("GL")_"35,"_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))
I ABMX("SUB")=0 S ABMS("I")=ABMS("I")-1 Q
S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G RADH
RADU S ABMX("R")=$P(ABMX(0),U,2) Q:ABMX("R")=""
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
;
RADH S ABMS(ABMS("I"))=ABMX("SUB")
S ABMCAT=35 D HDT^ABMDESM1
S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":"-"_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":"-"_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":"-"_$P(ABMX(0),U,7),1:"") ;CSV-c
;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":" "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"") ;CSV-c ;abm*2.6*13 export mode 35
I "^27^35^"[("^"_ABMP("EXP")_"^") D ;CSV-c ;abm*2.6*13 export mode 35
.S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":" "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"") ;abm*2.6*13 exp mode 35
S $P(ABMS(ABMS("I")),"^",5)=$P(ABMX(0),"^",8)
S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
I $P(ABMX(0),"^",16) D
. S $P(ABMS(ABMS("I")),U,7)=$P($G(^ABMDCODE($P(ABMX(0),"^",16),0)),"^")
E S $P(ABMS(ABMS("I")),U,7)=4
S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),"^",15) ;POS
S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3) ;CSV-c
S ABMX(0)=@(ABMP("GL")_"35,"_ABMX("X")_",0)")
S ABMDPRV=$O(@(ABMP("GL")_"35,"_ABMX_",""P"",""C"",""R"",0)"))
S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"35,"_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
ABMDESMX ; IHS/ASDST/DMJ - Summarized Claim RADIOLOGY charges ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**13**;NOV 12, 2009;Build 213
+2 ;
+3 ; IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
+4 ; 0.00 charges on HCFA because version 2.0 does not assume
+5 ; 1 for units. Modify code to set units to 1 if not
+6 ; already defined.
+7 ;
+8 ; IHS/SD/SDR - v2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
+9 ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider
+10 ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
+11 ; IHS/SD/SDR - v2.5 p11 - NPI
+12 ; IHS/SD/SDR - v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K
+13 ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes
+14 ;
+15 ; IHS/SD/SDR - v2.6 CSV
+16 ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
+17 ;
RAD ;EP for adding Radiology
+1 IF $GET(ABMP("VTYP",995))
IF '$GET(ABMPRINT)
IF ABMP("VTYP",995)'=ABMP("EXP")
QUIT
+2 SET ABMCAT=35
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+3 SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"35,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO RAD1
+4 QUIT
+5 ;
RAD1 SET ABMX(0)=@(ABMP("GL")_"35,"_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 IF ABMX("SUB")=0
SET ABMS("I")=ABMS("I")-1
QUIT
+5 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
+6 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"
GOTO RADH
RADU SET ABMX("R")=$PIECE(ABMX(0),U,2)
IF ABMX("R")=""
QUIT
+1 IF $DATA(ABMS(ABMX("R")))
SET $PIECE(ABMS(ABMX("R")),U)=$PIECE(ABMS(ABMX("R")),U)+ABMX("SUB")
+2 IF '$TEST
SET ABMS(ABMX("R"))=ABMX("SUB")
+3 QUIT
+4 ;
RADH SET ABMS(ABMS("I"))=ABMX("SUB")
+1 SET ABMCAT=35
DO HDT^ABMDESM1
+2 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$SELECT($PIECE(ABMX(0),U,5)]"":"-"_$PIECE(ABMX(0),U,5),1:"")_$SELECT($PIECE(ABMX(0),U,6)]"":"-"_$PIECE(ABMX(0),U,6),1:"")_...
... $SELECT($PIECE(ABMX(0),U,7)]"":"-"_$PIECE(ABMX(0),U,7),1:"")
+3 ;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,4)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,6)]"":" "_$P(ABMX(0),U,6),1:"")_$S($P(ABMX(0),U,7)]"":" "_$P(ABMX(0),U,7),1:"") ;CSV-c ;ab
m*2.6*13 export mode 35
+4 ;CSV-c ;abm*2.6*13 export mode 35
IF "^27^35^"[("^"_ABMP("EXP")_"^")
Begin DoDot:1
+5 ;abm*2.6*13 exp mode 35
SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)_$SELECT($PIECE(ABMX(0),U,5)]"":" "_$PIECE(ABMX(0),U,5),1:"")_$SELECT($PIECE(ABMX(0),U,6)]"":" "_$PIECE(ABMX(0),U,6),1:"")_...
... $SELECT($PIECE(ABMX(0),U,7)]"":" "_$PIECE(ABMX(0),U,7),1:"")
End DoDot:1
+6 SET $PIECE(ABMS(ABMS("I")),"^",5)=$PIECE(ABMX(0),"^",8)
+7 SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
+8 IF $PIECE(ABMX(0),"^",16)
Begin DoDot:1
+9 SET $PIECE(ABMS(ABMS("I")),U,7)=$PIECE($GET(^ABMDCODE($PIECE(ABMX(0),"^",16),0)),"^")
End DoDot:1
+10 IF '$TEST
SET $PIECE(ABMS(ABMS("I")),U,7)=4
+11 ;POS
SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),"^",15)
+12 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)
+13 SET ABMX(0)=@(ABMP("GL")_"35,"_ABMX("X")_",0)")
+14 SET ABMDPRV=$ORDER(@(ABMP("GL")_"35,"_ABMX_",""P"",""C"",""R"",0)"))
+15 IF +ABMDPRV'=0
SET ABMDPRV=$PIECE($GET(@(ABMP("GL")_"35,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
+16 IF $GET(ABMDPRV)=""
SET ABMDPRV=$$GETPRV^ABMDFUTL
+17 IF +$GET(ABMDPRV)'=0
Begin DoDot:1
+18 IF '$$K24^ABMDFUTL
QUIT
+19 SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
+20 SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
+21 IF $GET(ABMP("NPIS"))="N"
SET $PIECE(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
End DoDot:1
+22 QUIT
