ABMDESMM ; IHS/ASDST/DMJ - Summarized Claim Medical Charges ;
;;2.6;IHS Third Party Billing System;**3,13**;NOV 12, 2009;Build 213
;
;IHS/DSD/LSL -03/26/98 - Semicolon out the line in
;subrtn PRO that quits if Optometry visit.
;Optometry 994 total was 0's
; 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 - IM25574 - Correction for CPT modifier in Medical multiple
; 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
;
PRO ;EP for Medical Charges
;
S ABMCAT=27 D PCK^ABMDESM1 Q:$G(ABMQUIT)
S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"27,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D PRO1
Q
;
PRO1 ;PRO1
S ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
S ABMZ("UNIT")=$P(ABMX(0),U,3)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
I $G(ABMP("VTYP",999)),'$G(ABMPRINT),ABMP("VTYP",999)'=ABMP("EXP"),$P(ABMX(0),"^",2)>959 Q
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 PROH
PROU S ABMX("R")=$P(ABMX(0),U,2) Q:ABMX("R")="" D REVN
Q
;
PROH S ABMS(ABMS("I"))=ABMX("SUB")
S ABMCAT=27 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,5)]"":"-"_$P($$MOD^ABMCVAPI($P(ABMX(0),U,5),"",ABMP("VDT")),U,2),1:"")_$S($P(ABMX(0),U,8)]"":"-"_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"") ;CSV-c ;IHS/SD/SDR 3/1/2010 HEAT11136
S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":"-"_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,8)]"":"-"_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"") ;CSV-c ;IHS/SD/SDR 3/1/2010 HEAT11136
;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,8)]"":" "_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":" "_$P(ABMX(0),U,9),1:"") ;abm*2.6*13 new export mode 35
I ABMP("EXP")=27!(ABMP("EXP")=35) S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,8)]"":" "_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":" "_$P(ABMX(0),U,9),1:"") ;abm*2.6*13 exp mode 35
S $P(ABMS(ABMS("I")),U,5)=$P(ABMX(0),U,6)
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)=1
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")_"27,"_ABMX("X")_",0)")
S ABMDPRV=$O(@(ABMP("GL")_"27,"_ABMX_",""P"",""C"",""R"",0)"))
S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"27,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
I +$G(ABMDPRV)=0 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 S $P(ABMS(ABMX("R")),U)=+$P($G(ABMS(ABMX("R"))),U)+ABMX("SUB")
S $P(ABMS(ABMX("R")),"^",2)=$P(ABMS(ABMX("R")),"^",2)+ABMZ("UNIT")
Q
ABMDESMM ; IHS/ASDST/DMJ - Summarized Claim Medical Charges ;
+1 ;;2.6;IHS Third Party Billing System;**3,13**;NOV 12, 2009;Build 213
+2 ;
+3 ;IHS/DSD/LSL -03/26/98 - Semicolon out the line in
+4 ;subrtn PRO that quits if Optometry visit.
+5 ;Optometry 994 total was 0's
+6 ; IHS/DSD/LSL - 09/02/98 - Patch 2 - NOIS NDA-0898-180038
+7 ; 0.00 charges on HCFA because version 2.0 does not assume
+8 ; 1 for units. Modify code to set units to 1 if not
+9 ; already defined.
+10 ;
+11 ; IHS/SD/SDR - v2.5 - p5 - 5/18/04 - Modified to put POS and TOS by line item
+12 ; IHS/SD/SDR - V2.5 P8 - IM10618/IM11164 - Prompt/display provider
+13 ; IHS/SD/SDR - v2.5 p9 - task 1 - Use new service line provider multiple
+14 ; IHS/SD/SDR - v2.5 p11 - NPI
+15 ; IHS/SD/SDR - v2.5 p12 - IM25331 - Add provider taxonomy to CMS-1500 block 24K
+16 ; IHS/SD/SDR - v2.5 p13 - IM25574 - Correction for CPT modifier in Medical multiple
+17 ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes
+18 ;
+19 ; IHS/SD/SDR - v2.6 CSV
+20 ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
+21 ;
PRO ;EP for Medical Charges
+1 ;
+2 SET ABMCAT=27
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+3 SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"27,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO PRO1
+4 QUIT
+5 ;
PRO1 ;PRO1
+1 SET ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
+2 SET ABMZ("UNIT")=$PIECE(ABMX(0),U,3)
+3 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+4 IF $GET(ABMP("VTYP",999))
IF '$GET(ABMPRINT)
IF ABMP("VTYP",999)'=ABMP("EXP")
IF $PIECE(ABMX(0),"^",2)>959
QUIT
+5 SET ABMX("SUB")=(ABMZ("UNIT")*$PIECE(ABMX(0),U,4))
+6 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
+7 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"
GOTO PROH
PROU SET ABMX("R")=$PIECE(ABMX(0),U,2)
IF ABMX("R")=""
QUIT
DO REVN
+1 QUIT
+2 ;
PROH SET ABMS(ABMS("I"))=ABMX("SUB")
+1 SET ABMCAT=27
DO HDT^ABMDESM1
+2 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
+3 ;S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":"-"_$P($$MOD^ABMCVAPI($P(ABMX(0),U,5),"",ABMP("VDT")),U,2),1:"")_$S($P(ABMX(0),U,8)]"":"-"_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"") ;CSV-c ;IHS/SD/SDR 3/1/
2010 HEAT11136
+4 ;CSV-c ;IHS/SD/SDR 3/1/2010 HEAT11136
SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,5)]"":"-"_$PIECE(ABMX(0),U,5),1:"")_$SELECT($PIECE(ABMX(0),U,8)]"":"-"_$PIECE(ABMX(0),U,8),1:"")_$SELECT($PIECE(ABMX(0),U,9)]"":"-"_$PIECE(ABMX(0),U,9),1:"")
+5 ;I ABMP("EXP")=27 S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,5)]"":" "_$P(ABMX(0),U,5),1:"")_$S($P(ABMX(0),U,8)]"":" "_$P(ABMX(0),U,8),1:"")_$S($P(ABMX(0),U,9)]"":" "_$P(ABMX(0),U,9),1:"") ;abm*2.6*13 new export mode 35
+6 ;abm*2.6*13 exp mode 35
IF ABMP("EXP")=27!(ABMP("EXP")=35)
SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,5)]"":" "_$PIECE(ABMX(0),U,5),1:"")_$SELECT($PIECE(ABMX(0),U,8)]"":" "_$PIECE(ABMX(0),U,8),1:"")_$SELECT($PIECE(ABMX(0),U,9)]"":" "_$PIECE(ABMX(0),U,9),1:"")
+7 SET $PIECE(ABMS(ABMS("I")),U,5)=$PIECE(ABMX(0),U,6)
+8 SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
+9 IF $PIECE(ABMX(0),"^",16)
Begin DoDot:1
+10 SET $PIECE(ABMS(ABMS("I")),U,7)=$PIECE($GET(^ABMDCODE($PIECE(ABMX(0),"^",16),0)),"^")
End DoDot:1
+11 IF '$TEST
SET $PIECE(ABMS(ABMS("I")),U,7)=1
+12 ;POS
SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),"^",15)
+13 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)
+14 SET ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
+15 SET ABMDPRV=$ORDER(@(ABMP("GL")_"27,"_ABMX_",""P"",""C"",""R"",0)"))
+16 IF +ABMDPRV'=0
SET ABMDPRV=$PIECE($GET(@(ABMP("GL")_"27,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
+17 IF +$GET(ABMDPRV)=0
SET ABMDPRV=$$GETPRV^ABMDFUTL
+18 IF +$GET(ABMDPRV)'=0
Begin DoDot:1
+19 IF '$$K24^ABMDFUTL
QUIT
+20 SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
+21 SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
+22 IF $GET(ABMP("NPIS"))="N"
SET $PIECE(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
End DoDot:1
+23 QUIT
+24 ;
CPT ;CSV-c
IF ABMX("C")]""
SET ABMX("C")=$PIECE($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)
+1 QUIT
+2 ;
REVN SET $PIECE(ABMS(ABMX("R")),U)=+$PIECE($GET(ABMS(ABMX("R"))),U)+ABMX("SUB")
+1 SET $PIECE(ABMS(ABMX("R")),"^",2)=$PIECE(ABMS(ABMX("R")),"^",2)+ABMZ("UNIT")
+2 QUIT
