ABMDESMH ; IHS/SD/SDR - Profession Services for Seperate Bill ;
;;2.6;IHS 3P BILLING SYSTEM;**10,14**;NOV 12, 2009;Build 238
;
; IHS/SD/SDR - V2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
; IHS/SD/SDR - v2.5 p13 - IM25574
; Correction to CPT Modifier in Medical multiple
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative
;
K ABMS I $D(ABMP("FLAT")),$P(ABMP("FLAT"),U,3)]"" G FLAT
;
S ABMS("TOT")=0
MS S:'$D(ABMS("I")) ABMS("I")=1 S ABMX="""""",ABMX("ER")=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"21,""C"","_ABMX_")")) Q:'ABMX S ABMX("X")=$O(^(ABMX,"")) D MS1
G PRO
;
MS1 S ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)"),ABMX(1)=$G(^(1))
S ABMX("R")=$P(ABMX(0),U,3)
I +$P(ABMX(0),U,7)=0!(ABMX("R")=""&($P(^ABMDEXP(ABMP("EXP"),0),U)["UB")) S ABMS("I")=ABMS("I")-1 Q
I (ABMX("R")<960!(ABMX("R")>963))&(ABMX("R")'=969) S ABMS("I")=ABMS("I")-1 Q
S ABMS("TOT")=ABMS("TOT")+$P(ABMX(0),U,7)
; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
MSH S ABMS(ABMS("I"))=$P(ABMX(0),U,7)
S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL($P(ABMX(0),U,5)),$P(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL($P(ABMX(0),U,5))
S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"")_$S($P(ABMX(1),U)]"":"-"_$P(ABMX(1),U),1:"")_$S($P(ABMX(1),U,2)]"":"-"_$P(ABMX(1),U,2),1:"")
S ABMX("D")=$P(ABMX(0),U,4) D ICD S $P(ABMS(ABMS("I")),U,5)=ABMX("D")
S $P(ABMS(ABMS("I")),U,6)=1
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)=$S($P(^DIC(81.1,$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,4),0),U,3)=2:2,1:1) ;CSV-c
S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),"^",15) ;POS
;S $P(ABMS(ABMS("I")),U,8)=$P(^AUTNPOV($P(ABMX(0),U,6),0),U) ;abm*2.6*14 HEAT161263
S $P(ABMS(ABMS("I")),U,8)=$$GET1^DIQ(9999999.27,$P(ABMX(0),U,6),"01","E") ;abm*2.6*14 HEAT161263
Q
;
PRO S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"27,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D PRO1
G ANS
;
PRO1 S ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
S ABMX("SUB")=($P(ABMX(0),U,3)*$P(ABMX(0),U,4))
S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
;
PROH S ABMS(ABMS("I"))=ABMX("SUB")
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
;
S ABMX("D")=$P(ABMX(0),U,6) D ICD S $P(ABMS(ABMS("I")),U,5)=ABMX("D")
S $P(ABMS(ABMS("I")),U,6)=$P(ABMX(0),U,3)
S $P(ABMS(ABMS("I")),U,7)=1
S $P(ABMS(ABMS("I")),U,8)=$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3) ;CSV-c
Q
;
ANS S ABMX=0 F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"39,"_ABMX_")")) Q:'ABMX S ABMX("X")=ABMX D ANS1
G XIT
;
ANS1 S ABMX(0)=@(ABMP("GL")_"39,"_ABMX("X")_",0)")
S ABMX("R")=$P(ABMX(0),U,2) I ABMX("R")'=963 S ABMS("I")=ABMS("I")-1 Q
S ABMX("C")=$P(ABMX(0),U,3) ; D ANESTH^ABMDESMA
S ABMX("SUB")=ABMX("C")+$P(ABMX(0),U,4)
S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
ANSH S ABMS(ABMS("I"))=ABMX("SUB") D HDT^ABMDESM1
S ABMX("C")=$P(ABMX(0),U) D CPT S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_"-47"
S $P(ABMS(ABMS("I")),U,6)=1,$P(ABMS(ABMS("I")),U,7)=7
S $P(ABMS(ABMS("I")),U,8)="ANESTHESIA IN ASSOC W/ CPT:"_$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2) ;CSV-c
Q
;
CPT ;
S:ABMX("C")]"" ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2) ;CSV-c
Q
ICD ;
S:ABMX("D")]"" ABMX("D")=$P($$DX^ABMCVAPI(ABMX("D"),ABMP("VDT")),U,2) ;CSV-c
Q
;
XIT S ABMP("EXP",ABMP("VTYP",999))=ABMS("TOT")
K ABMX
Q
;
FLAT S $P(ABMS(1),U,2)=$$HDT^ABMDUTL($P($G(@(ABMP("GL")_"7)")),U))
S $P(ABMS(1),U,3)=$$HDT^ABMDUTL($P($G(@(ABMP("GL")_"7)")),U,2))
;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S $P(ABMS(1),U,4)=90250 ;abm*2.6*10 HEAT73780
I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" S $P(ABMS(1),U,4)=90250 ;abm*2.6*10 HEAT73780
S ABMX("FDAYS")=$S($P(ABMS(1),U,2)=$P(ABMS(1),U,3):1,1:$P(ABMP("FLAT"),U,8))
S ABMX("NARR")=$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
S ABMX("NARR2")=" "_$S(ABMX("NARR")>1:"DAYS",1:"DAY")_" @ $"_$J($P(ABMP("FLAT"),U,4),4,2)
S $P(ABMS(1),U,8)=ABMX("NARR")_ABMX("NARR2")
S ABMS("TOT")=$P(ABMP("FLAT"),U,4)*$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
S $P(ABMS(1),U,1)=ABMS("TOT")
S $P(ABMS(1),U,6)=$S(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
S $P(ABMS(1),U,7)=1
G XIT
ABMDESMH ; IHS/SD/SDR - Profession Services for Seperate Bill ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,14**;NOV 12, 2009;Build 238
+2 ;
+3 ; IHS/SD/SDR - V2.5 p5 - 5/18/04 - Modified to put POS and TOS by line item
+4 ; IHS/SD/SDR - v2.5 p13 - IM25574
+5 ; Correction to CPT Modifier in Medical multiple
+6 ;
+7 ; IHS/SD/SDR - v2.6 CSV
+8 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Changed to use $$GET1^DIQ so output transform will execute for SNOMED/Provider Narrative
+9 ;
+10 KILL ABMS
IF $DATA(ABMP("FLAT"))
IF $PIECE(ABMP("FLAT"),U,3)]""
GOTO FLAT
+11 ;
+12 SET ABMS("TOT")=0
MS IF '$DATA(ABMS("I"))
SET ABMS("I")=1
SET ABMX=""""""
SET ABMX("ER")=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"21,""C"","_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=$ORDER(^(ABMX,""))
DO MS1
+1 GOTO PRO
+2 ;
MS1 SET ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)")
SET ABMX(1)=$GET(^(1))
+1 SET ABMX("R")=$PIECE(ABMX(0),U,3)
+2 IF +$PIECE(ABMX(0),U,7)=0!(ABMX("R")=""&($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"))
SET ABMS("I")=ABMS("I")-1
QUIT
+3 IF (ABMX("R")<960!(ABMX("R")>963))&(ABMX("R")'=969)
SET ABMS("I")=ABMS("I")-1
QUIT
+4 SET ABMS("TOT")=ABMS("TOT")+$PIECE(ABMX(0),U,7)
+5 ; ABMS(#)=Charge^date from^date to^CPT Code^Corr. ICD^units^typ serv^Description
MSH SET ABMS(ABMS("I"))=$PIECE(ABMX(0),U,7)
+1 SET $PIECE(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL($PIECE(ABMX(0),U,5))
SET $PIECE(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL($PIECE(ABMX(0),U,5))
+2 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,9)]"":"-"_$PIECE(ABMX(0),U,9),1:"")_$SELECT($PIECE(ABMX(1),U)]"":"-"_$PIECE(ABMX(1),U),1:"")_$SELECT($PIECE(ABMX(1),U,2)]"":"-"_$PIECE(ABMX(1),U,2),1:"")
+3 SET ABMX("D")=$PIECE(ABMX(0),U,4)
DO ICD
SET $PIECE(ABMS(ABMS("I")),U,5)=ABMX("D")
+4 SET $PIECE(ABMS(ABMS("I")),U,6)=1
+5 IF $PIECE(ABMX(0),"^",16)
Begin DoDot:1
+6 SET $PIECE(ABMS(ABMS("I")),U,7)=$PIECE($GET(^ABMDCODE($PIECE(ABMX(0),"^",16),0)),"^")
End DoDot:1
+7 ;CSV-c
IF '$TEST
SET $PIECE(ABMS(ABMS("I")),U,7)=$SELECT($PIECE(^DIC(81.1,$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,4),0),U,3)=2:2,1:1)
+8 ;POS
SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),"^",15)
+9 ;S $P(ABMS(ABMS("I")),U,8)=$P(^AUTNPOV($P(ABMX(0),U,6),0),U) ;abm*2.6*14 HEAT161263
+10 ;abm*2.6*14 HEAT161263
SET $PIECE(ABMS(ABMS("I")),U,8)=$$GET1^DIQ(9999999.27,$PIECE(ABMX(0),U,6),"01","E")
+11 QUIT
+12 ;
PRO 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
+1 GOTO ANS
+2 ;
PRO1 SET ABMX(0)=@(ABMP("GL")_"27,"_ABMX("X")_",0)")
+1 SET ABMX("SUB")=($PIECE(ABMX(0),U,3)*$PIECE(ABMX(0),U,4))
+2 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
+3 ;
PROH SET ABMS(ABMS("I"))=ABMX("SUB")
+1 DO HDT^ABMDESM1
+2 ;
+3 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
+4 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,5)]"":"-"_$PIECE($$MOD^ABMCVAPI($PIECE(ABMX(0),U,5),"",ABMP("VDT")),U,2),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 ;
+6 SET ABMX("D")=$PIECE(ABMX(0),U,6)
DO ICD
SET $PIECE(ABMS(ABMS("I")),U,5)=ABMX("D")
+7 SET $PIECE(ABMS(ABMS("I")),U,6)=$PIECE(ABMX(0),U,3)
+8 SET $PIECE(ABMS(ABMS("I")),U,7)=1
+9 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,8)=$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,3)
+10 QUIT
+11 ;
ANS SET ABMX=0
FOR ABMS("I")=ABMS("I"):1
SET ABMX=$ORDER(@(ABMP("GL")_"39,"_ABMX_")"))
IF 'ABMX
QUIT
SET ABMX("X")=ABMX
DO ANS1
+1 GOTO XIT
+2 ;
ANS1 SET ABMX(0)=@(ABMP("GL")_"39,"_ABMX("X")_",0)")
+1 SET ABMX("R")=$PIECE(ABMX(0),U,2)
IF ABMX("R")'=963
SET ABMS("I")=ABMS("I")-1
QUIT
+2 ; D ANESTH^ABMDESMA
SET ABMX("C")=$PIECE(ABMX(0),U,3)
+3 SET ABMX("SUB")=ABMX("C")+$PIECE(ABMX(0),U,4)
+4 SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")
ANSH SET ABMS(ABMS("I"))=ABMX("SUB")
DO HDT^ABMDESM1
+1 SET ABMX("C")=$PIECE(ABMX(0),U)
DO CPT
SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_"-47"
+2 SET $PIECE(ABMS(ABMS("I")),U,6)=1
SET $PIECE(ABMS(ABMS("I")),U,7)=7
+3 ;CSV-c
SET $PIECE(ABMS(ABMS("I")),U,8)="ANESTHESIA IN ASSOC W/ CPT:"_$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,2)
+4 QUIT
+5 ;
CPT ;
+1 ;CSV-c
IF ABMX("C")]""
SET ABMX("C")=$PIECE($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)
+2 QUIT
ICD ;
+1 ;CSV-c
IF ABMX("D")]""
SET ABMX("D")=$PIECE($$DX^ABMCVAPI(ABMX("D"),ABMP("VDT")),U,2)
+2 QUIT
+3 ;
XIT SET ABMP("EXP",ABMP("VTYP",999))=ABMS("TOT")
+1 KILL ABMX
+2 QUIT
+3 ;
FLAT SET $PIECE(ABMS(1),U,2)=$$HDT^ABMDUTL($PIECE($GET(@(ABMP("GL")_"7)")),U))
+1 SET $PIECE(ABMS(1),U,3)=$$HDT^ABMDUTL($PIECE($GET(@(ABMP("GL")_"7)")),U,2))
+2 ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="R" S $P(ABMS(1),U,4)=90250 ;abm*2.6*10 HEAT73780
+3 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R"
SET $PIECE(ABMS(1),U,4)=90250
+4 SET ABMX("FDAYS")=$SELECT($PIECE(ABMS(1),U,2)=$PIECE(ABMS(1),U,3):1,1:$PIECE(ABMP("FLAT"),U,8))
+5 SET ABMX("NARR")=$SELECT(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
+6 SET ABMX("NARR2")=" "_$SELECT(ABMX("NARR")>1:"DAYS",1:"DAY")_" @ $"_$JUSTIFY($PIECE(ABMP("FLAT"),U,4),4,2)
+7 SET $PIECE(ABMS(1),U,8)=ABMX("NARR")_ABMX("NARR2")
+8 SET ABMS("TOT")=$PIECE(ABMP("FLAT"),U,4)*$SELECT(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
+9 SET $PIECE(ABMS(1),U,1)=ABMS("TOT")
+10 SET $PIECE(ABMS(1),U,6)=$SELECT(ABMX("FDAYS")>0:ABMX("FDAYS"),1:1)
+11 SET $PIECE(ABMS(1),U,7)=1
+12 GOTO XIT
