ABMDESMB ; IHS/ASDST/DMJ - Summarized Claim AMBULANCE. Info ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p8 - task 6
; New routine
;
; IHS/SD/SDR - v2.6 CSV
;
AMB ;EP for AMB charges
I $G(ABMP("VTYP",993)),'$G(ABMPRINT) Q:ABMP("VTYP",993)'=ABMP("EXP")
S ABMCAT=47 D PCK^ABMDESM1 Q:$G(ABMQUIT)
S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"47,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D AMB1
Q
;
AMB1 S ABMX(0)=@(ABMP("GL")_"47,"_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 AMBH
; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code
AMBU 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
;
AMBH ;ABMS ARRAY FOR HCFA 1500
; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
S ABMS(ABMS("I"))=ABMX("SUB")
S ABMCAT=47 D HDT^ABMDESM1
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),U,16) D
.S $P(ABMS(ABMS("I")),U,7)=$P($G(^ABMDCODE($P(ABMX(0),U,16),0)),U)
E S $P(ABMS(ABMS("I")),U,7)=1
S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),U,15) ;POS
S ABMX("C")=$P(ABMX(0),U) D CPT
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(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:"")
S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3) ;CSV-c
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)
Q
;
REVN ;EP for REVENUE charges
S ABMX("ER")=+$P($G(@(ABMP("GL")_"9)")),U,8) I 'ABMX("ER") Q
S ABMX("REV")=+$P($G(@(ABMP("GL")_"9)")),U,7) I 'ABMX("REV") Q
I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" S $P(ABMS(ABMX("REV")),U)=$S($D(ABMS(ABMX("REV"))):$P(ABMS(ABMX("REV")),U)+ABMX("ER"),1:ABMX("ER")) G TREVN
S ABMS(ABMS("I"))=ABMX("ER")
S X=$S($P($G(@(ABMP("GL")_"6)")),U)]"":$P(@(ABMP("GL")_"6)"),U),1:$P($G(@(ABMP("GL")_"7)")),U))
S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(X)
S $P(ABMS(ABMS("I")),U,8)=$P(^AUTTREVN(ABMX("REV"),0),U,2)
S ABMS("I")=ABMS("I")+1
TREVN S ABMS("TOT")=ABMS("TOT")+ABMX("ER")
Q
;
ROO ;EP for R&B Charges
I $G(ABMP("VTYP",991)),'$G(ABMPRINT) Q:ABMP("VTYP",991)'=ABMP("EXP")
S ABMCAT=25 D PCK^ABMDESM1 Q:$G(ABMQUIT)
S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"25,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D ROO1
Q
;
ROO1 S ABMX(0)=@(ABMP("GL")_"25,"_ABMX("X")_",0)")
S ABMZ("UNIT")=$P(ABMX(0),U,2)
S:'+ABMZ("UNIT") ABMZ("UNIT")=1
S ABMX("SUB")=(ABMZ("UNIT")*$P(ABMX(0),U,3))
S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G ROOH
ROOU S ABMX("R")=$P(ABMX(0),U,1)
I $D(ABMS(ABMX("R"))) S $P(ABMS(ABMX("R")),U)=$P(ABMS(ABMX("R")),U)+ABMX("SUB"),$P(ABMS(ABMX("R")),U,2)=$P(ABMS(ABMX("R")),U,2)+ABMZ("UNIT")
E S ABMS(ABMX("R"))=ABMX("SUB")_U_ABMZ("UNIT")_U_$P(ABMX(0),U,3)
Q
;
ROOH S ABMS(ABMS("I"))=ABMX("SUB")
S ABMCAT=25 D HDT^ABMDESM1
S $P(ABMS(ABMS("I")),U,4)="R&B"
S $P(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
S $P(ABMS(ABMS("I")),U,8)=$P(^AUTTREVN(+ABMX(0),0),U,2)
Q
;
CPT I ABMX("C")]"" S ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2) ;CSV-c
Q
SUP ;EP - for SUPPLY charges
S ABMCAT=45 D PCK^ABMDESM1 Q:$G(ABMQUIT)
N K S K=+$O(ABMS(99999),-1)
I $G(ABMP("CDFN")) D Q
.N I S I=0 F S I=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I)) Q:'I D
..N J F J=1:1:7 S ABMX(J)=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I,0),"^",J)
..D SSET
I $G(ABMP("BDFN")) D
.N I S I=0 F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I)) Q:'I D
..N J F J=1:1:7 S ABMX(J)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I,0),"^",J)
..D SSET
Q
SSET ;SET ABMS ARRAY
Q:'$D(^ABMCM(ABMX(1))) ; Item deleted from supply file
S:'+ABMX(3) ABMX(3)=1
S K=K+1
S:'ABMX(5) ABMX(5)=270
S ABMX("SUB")=ABMX(3)*ABMX(4)
S ABMS("TOT")=+$G(ABMS("TOT"))+ABMX("SUB")
I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" D SUB Q
S ABMS(K)=ABMX("SUB")
S $P(ABMS(K),U,2)=$$HDT^ABMDUTL(ABMX(2))
S $P(ABMS(K),U,3)=$P(ABMS(K),U,2)
S $P(ABMS(K),U,4)=$P($$CPT^ABMCVAPI(+ABMX(7),ABMP("VDT")),U,2) ;CSV-c
S $P(ABMS(K),U,5)=ABMX(6)
S $P(ABMS(K),U,6)=ABMX(3)
S $P(ABMS(K),U,7)=9
S $P(ABMS(K),U,8)=$P(^ABMCM(ABMX(1),0),U)
Q
SUB ;SET ABMS ARRAY FOR UB-92 TYPE FORM
S $P(ABMS(ABMX(5)),"^",1)=+$P($G(ABMS(ABMX(5))),U)+ABMX("SUB")
Q
ABMDESMB ; IHS/ASDST/DMJ - Summarized Claim AMBULANCE. Info ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p8 - task 6
+4 ; New routine
+5 ;
+6 ; IHS/SD/SDR - v2.6 CSV
+7 ;
AMB ;EP for AMB charges
+1 IF $GET(ABMP("VTYP",993))
IF '$GET(ABMPRINT)
IF ABMP("VTYP",993)'=ABMP("EXP")
QUIT
+2 SET ABMCAT=47
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+3 SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"47,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO AMB1
+4 QUIT
+5 ;
AMB1 SET ABMX(0)=@(ABMP("GL")_"47,"_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 AMBH
+6 ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code
AMBU 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 ;
AMBH ;ABMS ARRAY FOR HCFA 1500
+1 ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
+2 SET ABMS(ABMS("I"))=ABMX("SUB")
+3 SET ABMCAT=47
DO HDT^ABMDESM1
+4 SET $PIECE(ABMS(ABMS("I")),U,5)=$PIECE(ABMX(0),U,6)
+5 SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
+6 IF $PIECE(ABMX(0),U,16)
Begin DoDot:1
+7 SET $PIECE(ABMS(ABMS("I")),U,7)=$PIECE($GET(^ABMDCODE($PIECE(ABMX(0),U,16),0)),U)
End DoDot:1
+8 IF '$TEST
SET $PIECE(ABMS(ABMS("I")),U,7)=1
+9 ;POS
SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),U,15)
+10 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
+11 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
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:"")
+12 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)
+13 SET ABMDPRV=$$GETPRV^ABMDFUTL
+14 IF +$GET(ABMDPRV)'=0
Begin DoDot:1
+15 IF '$$K24^ABMDFUTL
QUIT
+16 SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
+17 SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
End DoDot:1
+18 QUIT
+19 ;
REVN ;EP for REVENUE charges
+1 SET ABMX("ER")=+$PIECE($GET(@(ABMP("GL")_"9)")),U,8)
IF 'ABMX("ER")
QUIT
+2 SET ABMX("REV")=+$PIECE($GET(@(ABMP("GL")_"9)")),U,7)
IF 'ABMX("REV")
QUIT
+3 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"
SET $PIECE(ABMS(ABMX("REV")),U)=$SELECT($DATA(ABMS(ABMX("REV"))):$PIECE(ABMS(ABMX("REV")),U)+ABMX("ER"),1:ABMX("ER"))
GOTO TREVN
+4 SET ABMS(ABMS("I"))=ABMX("ER")
+5 SET X=$SELECT($PIECE($GET(@(ABMP("GL")_"6)")),U)]"":$PIECE(@(ABMP("GL")_"6)"),U),1:$PIECE($GET(@(ABMP("GL")_"7)")),U))
+6 SET $PIECE(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(X)
+7 SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE(^AUTTREVN(ABMX("REV"),0),U,2)
+8 SET ABMS("I")=ABMS("I")+1
TREVN SET ABMS("TOT")=ABMS("TOT")+ABMX("ER")
+1 QUIT
+2 ;
ROO ;EP for R&B Charges
+1 IF $GET(ABMP("VTYP",991))
IF '$GET(ABMPRINT)
IF ABMP("VTYP",991)'=ABMP("EXP")
QUIT
+2 SET ABMCAT=25
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+3 SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"25,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO ROO1
+4 QUIT
+5 ;
ROO1 SET ABMX(0)=@(ABMP("GL")_"25,"_ABMX("X")_",0)")
+1 SET ABMZ("UNIT")=$PIECE(ABMX(0),U,2)
+2 IF '+ABMZ("UNIT")
SET ABMZ("UNIT")=1
+3 SET ABMX("SUB")=(ABMZ("UNIT")*$PIECE(ABMX(0),U,3))
+4 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
+5 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"
GOTO ROOH
ROOU SET ABMX("R")=$PIECE(ABMX(0),U,1)
+1 IF $DATA(ABMS(ABMX("R")))
SET $PIECE(ABMS(ABMX("R")),U)=$PIECE(ABMS(ABMX("R")),U)+ABMX("SUB")
SET $PIECE(ABMS(ABMX("R")),U,2)=$PIECE(ABMS(ABMX("R")),U,2)+ABMZ("UNIT")
+2 IF '$TEST
SET ABMS(ABMX("R"))=ABMX("SUB")_U_ABMZ("UNIT")_U_$PIECE(ABMX(0),U,3)
+3 QUIT
+4 ;
ROOH SET ABMS(ABMS("I"))=ABMX("SUB")
+1 SET ABMCAT=25
DO HDT^ABMDESM1
+2 SET $PIECE(ABMS(ABMS("I")),U,4)="R&B"
+3 SET $PIECE(ABMS(ABMS("I")),U,6)=ABMZ("UNIT")
+4 SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE(^AUTTREVN(+ABMX(0),0),U,2)
+5 QUIT
+6 ;
CPT ;CSV-c
IF ABMX("C")]""
SET ABMX("C")=$PIECE($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)
+1 QUIT
SUP ;EP - for SUPPLY charges
+1 SET ABMCAT=45
DO PCK^ABMDESM1
IF $GET(ABMQUIT)
QUIT
+2 NEW K
SET K=+$ORDER(ABMS(99999),-1)
+3 IF $GET(ABMP("CDFN"))
Begin DoDot:1
+4 NEW I
SET I=0
FOR
SET I=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I))
IF 'I
QUIT
Begin DoDot:2
+5 NEW J
FOR J=1:1:7
SET ABMX(J)=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,I,0),"^",J)
+6 DO SSET
End DoDot:2
End DoDot:1
QUIT
+7 IF $GET(ABMP("BDFN"))
Begin DoDot:1
+8 NEW I
SET I=0
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I))
IF 'I
QUIT
Begin DoDot:2
+9 NEW J
FOR J=1:1:7
SET ABMX(J)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),45,I,0),"^",J)
+10 DO SSET
End DoDot:2
End DoDot:1
+11 QUIT
SSET ;SET ABMS ARRAY
+1 ; Item deleted from supply file
IF '$DATA(^ABMCM(ABMX(1)))
QUIT
+2 IF '+ABMX(3)
SET ABMX(3)=1
+3 SET K=K+1
+4 IF 'ABMX(5)
SET ABMX(5)=270
+5 SET ABMX("SUB")=ABMX(3)*ABMX(4)
+6 SET ABMS("TOT")=+$GET(ABMS("TOT"))+ABMX("SUB")
+7 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"
DO SUB
QUIT
+8 SET ABMS(K)=ABMX("SUB")
+9 SET $PIECE(ABMS(K),U,2)=$$HDT^ABMDUTL(ABMX(2))
+10 SET $PIECE(ABMS(K),U,3)=$PIECE(ABMS(K),U,2)
+11 ;CSV-c
SET $PIECE(ABMS(K),U,4)=$PIECE($$CPT^ABMCVAPI(+ABMX(7),ABMP("VDT")),U,2)
+12 SET $PIECE(ABMS(K),U,5)=ABMX(6)
+13 SET $PIECE(ABMS(K),U,6)=ABMX(3)
+14 SET $PIECE(ABMS(K),U,7)=9
+15 SET $PIECE(ABMS(K),U,8)=$PIECE(^ABMCM(ABMX(1),0),U)
+16 QUIT
SUB ;SET ABMS ARRAY FOR UB-92 TYPE FORM
+1 SET $PIECE(ABMS(ABMX(5)),"^",1)=+$PIECE($GET(ABMS(ABMX(5))),U)+ABMX("SUB")
+2 QUIT
