ABMDE2X1 ; IHS/SD/SDR - PAGE 2 - Primary Insurer Check ;
;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379
;
; IHS/ASDS/LSL - 01/09/02 - V2.4 Patch 10
; Modified to allow pick option to function properly. Thanks to Jim Gray for the research.
;
;IHS/SD/SDR - 2.6*21 - HEAT139641 - Changed 3P Insurer reference to use ABMP("LDFN"), not DUZ(2)
;
; *********************************************************************
;
S ABMP("C0")=@(ABMP("GL")_"0)")
;
PRIM ;
S ABMP("INS")=""
I $P(ABMP("C0"),U,8)="",'$G(ABMP("DERP OPT")) D
.S ABMYES=0
.S ABM("DR")=""
.F S ABM("DR")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR"))) Q:'ABM("DR") D Q:'ABM("DR")
..S ABM("DA")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR"),""))
..Q:ABM("DA")=""
..Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
..K ABM("DRI")
..S ABM("I0")=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
..I "UCB"[$P(ABM("I0"),U,3) Q
..S ABM("INSCO")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0),U)
..I +ABMYES,$P(ABM("I0"),U,3)="I" S ABM("DRI")=".03////P"
..I '+ABMYES D
...I $P(ABM("I0"),U,3)'="I" D
....S ABM("DRI")=".03////I"
...S ABMYES=1
...I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)'=ABM("INSCO") D
....S DIE="^ABMDCLM(DUZ(2),"
....S DA=ABMP("CDFN")
....S DR=".08////^S X=ABM(""INSCO"")"
....D ^DIE
....K DR
..I $D(ABM("DRI")) D
...S DA(1)=ABMP("CDFN")
...S DA=ABM("DA")
...S DR=ABM("DRI")
... S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
...D ^DIE
...K DR
S ABMP("C0")=@(ABMP("GL")_"0)")
I $P(ABMP("C0"),U,8)="" S ABME(111)="" G XIT
S ABMP("INS")=$P(ABMP("C0"),U,8)
K ABMP("FLAT"),ABMP("EXP"),ABMP("PX"),ABMP("FEE")
D ^ABMDE2X4
D FRATE
D EXP^ABMDE2X5
S:ABMP("BTYP")=121 ABMP("VTYP")=111
G XIT
;
; X6=EXPORT MODE^PROCDURE CODING METHOD^BILL TYPE^REVN CD^FLAT RATE
;
FRATE ;EP - Entry Point for setting up Flat Rate array if applicable
S ABMV("X6")=""
I '$D(ABMP("GL")) S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
;I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,11),$P(^(0),U,11)=111!($P(^(0),U,11)=131) D ;ABM*2.6*21 IHS/SD/AML HEAT139641
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,11),$P(^(0),U,11)=111!($P(^(0),U,11)=131) D ;ABM*2.6*21 IHS/SD/AML HEAT139641
.S DA(1)=ABMP("INS")
.S DA=ABMP("VTYP")
.S DIE="^ABMNINS("_DA(1)_",1,"
.S DR=".11////"_$S($P(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,11)=111:40,1:42)
.D ^DIE
D BTYP^ABMDEVAR
S $P(ABMV("X6"),"^",3)=ABMP("BTYP")
S:ABMP("BTYP")=121 ABMP("VTYP")=121
S ABMX("VDT")=$P($G(@(ABMP("GL")_"7)")),U)
;start old abm*2.6*21 IHS/SD/AML HEAT139641
;I '$D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) G RT
;S $P(ABMV("X6"),U,2)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
;S $P(ABMV("X6"),U,4)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
I '$D(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0)) G RT
S $P(ABMV("X6"),U,2)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
S $P(ABMV("X6"),U,4)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
;end new abm*2.6*21 IHS/SD/AML HEAT139641
I $P(ABMV("X6"),"^",4)="" D
.I ABMP("VTYP")=111 S $P(ABMV("X6"),"^",4)=100 Q
.I ABMP("VTYP")=121 S $P(ABMV("X6"),"^",4)=240 Q
.S $P(ABMV("X6"),"^",4)=510
I '$D(ABMP("EXP")) D EXP^ABMDEVAR
;start old abm*2.6*21 IHS/SD/AML HEAT139641
;I $D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) D
;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4) D
;..S $P(ABMV("X6"),U)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5) D
;..S ABMP("FEE")=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
I $D(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0)) D
.I $P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4) D
..S $P(ABMV("X6"),U)=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
.I $P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5) D
..S ABMP("FEE")=$P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
;end new abm*2.6*21 IHS/SD/AML HEAT139641
;I $D(ABMP("VTYP",999)),$P($G(^AUTNINS(ABMX("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
I $D(ABMP("VTYP",999)),($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMX("INS"),".211","I"),1,"I")="R") D ;abm*2.6*10 HEAT73780
.S ABMX=0 F S ABMX=$O(@(ABMP("GL")_"13,"_ABMX("INS")_",11,"_ABMX_")")) Q:'ABMX I $P($G(^AUTTPIC(ABMX,0)),U,3)="B" S ABMX="OK" Q
.I ABMX'="OK" K ABMP("VTYP",999)
S ABMX=0
K ABMX("HIT")
S $P(ABMV("X6"),"^",5)=$$FLAT^ABMDUTL(ABMX("INS"),ABMP("VTYP"),ABMX("VDT"))
;
RT ; ABMP("FLAT")=Flat Rate^Revn^Units^Pro Fee^Pro Coding Method^Revn Desc^Desc Code^Prof Comp Days
I +$P(ABMV("X6"),U,5) D
.S ABMP("FLAT")=$P(ABMV("X6"),U,5)_U_$P(ABMV("X6"),U,4)
.S ABMP("FLAT")=ABMP("FLAT")_U_$S((ABMP("BTYP")=111!(ABMP("BTYP")=121))&($P($G(@(ABMP("GL")_"7)")),U,3)>0):$P($G(^(7)),U,3),ABMP("BTYP")=111:1,$P($G(^(6)),U,9)]"":$P(^(6),U,9),1:1)
;I S $P(ABMP("FLAT"),U,6)=$P($P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|"),$P(ABMP("FLAT"),U,7)=$P($P(^(0),U,9),"|",2) ;abm*2.6*21 IHS/SD/AML HEAT139641
I S $P(ABMP("FLAT"),U,6)=$P($P(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|"),$P(ABMP("FLAT"),U,7)=$P($P(^(0),U,9),"|",2) ;abm*2.6*21 IHS/SD/AML HEAT139641
Q:'$D(ABMP("FLAT"))
I $P($G(@(ABMP("GL")_"5)")),U,10)>0 S ABMP("FLAT",170)=$P(^(5),U,10)
I $D(ABMP("VTYP",999)) D
.S $P(ABMP("FLAT"),U,8)=$P($G(@(ABMP("GL")_"5)")),U,7)
.S:'$P(ABMP("FLAT"),U,8) $P(ABMP("FLAT"),U,8)=$P(ABMP("FLAT"),U,3)+3
.;S $P(ABMP("FLAT"),U,5)=$P($G(^ABMNINS(DUZ(2),ABMX("INS"),1,999,0)),U,2) ;abm*2.6*21 IHS/SD/AML HEAT139641
.S $P(ABMP("FLAT"),U,5)=$P($G(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,999,0)),U,2) ;abm*2.6*21 IHS/SD/AML HEAT139641
.S $P(ABMP("FLAT"),U,4)=$$FLAT^ABMDUTL(ABMX("INS"),999,ABMX("VDT"))
Q
;
; *********************************************************************
XIT ;
K ABMX
Q
ABMDE2X1 ; IHS/SD/SDR - PAGE 2 - Primary Insurer Check ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/ASDS/LSL - 01/09/02 - V2.4 Patch 10
+4 ; Modified to allow pick option to function properly. Thanks to Jim Gray for the research.
+5 ;
+6 ;IHS/SD/SDR - 2.6*21 - HEAT139641 - Changed 3P Insurer reference to use ABMP("LDFN"), not DUZ(2)
+7 ;
+8 ; *********************************************************************
+9 ;
+10 SET ABMP("C0")=@(ABMP("GL")_"0)")
+11 ;
PRIM ;
+1 SET ABMP("INS")=""
+2 IF $PIECE(ABMP("C0"),U,8)=""
IF '$GET(ABMP("DERP OPT"))
Begin DoDot:1
+3 SET ABMYES=0
+4 SET ABM("DR")=""
+5 FOR
SET ABM("DR")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR")))
IF 'ABM("DR")
QUIT
Begin DoDot:2
+6 SET ABM("DA")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM("DR"),""))
+7 IF ABM("DA")=""
QUIT
+8 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
QUIT
+9 KILL ABM("DRI")
+10 SET ABM("I0")=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0))
+11 IF "UCB"[$PIECE(ABM("I0"),U,3)
QUIT
+12 SET ABM("INSCO")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("DA"),0),U)
+13 IF +ABMYES
IF $PIECE(ABM("I0"),U,3)="I"
SET ABM("DRI")=".03////P"
+14 IF '+ABMYES
Begin DoDot:3
+15 IF $PIECE(ABM("I0"),U,3)'="I"
Begin DoDot:4
+16 SET ABM("DRI")=".03////I"
End DoDot:4
+17 SET ABMYES=1
+18 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)'=ABM("INSCO")
Begin DoDot:4
+19 SET DIE="^ABMDCLM(DUZ(2),"
+20 SET DA=ABMP("CDFN")
+21 SET DR=".08////^S X=ABM(""INSCO"")"
+22 DO ^DIE
+23 KILL DR
End DoDot:4
End DoDot:3
+24 IF $DATA(ABM("DRI"))
Begin DoDot:3
+25 SET DA(1)=ABMP("CDFN")
+26 SET DA=ABM("DA")
+27 SET DR=ABM("DRI")
+28 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+29 DO ^DIE
+30 KILL DR
End DoDot:3
End DoDot:2
IF 'ABM("DR")
QUIT
End DoDot:1
+31 SET ABMP("C0")=@(ABMP("GL")_"0)")
+32 IF $PIECE(ABMP("C0"),U,8)=""
SET ABME(111)=""
GOTO XIT
+33 SET ABMP("INS")=$PIECE(ABMP("C0"),U,8)
+34 KILL ABMP("FLAT"),ABMP("EXP"),ABMP("PX"),ABMP("FEE")
+35 DO ^ABMDE2X4
+36 DO FRATE
+37 DO EXP^ABMDE2X5
+38 IF ABMP("BTYP")=121
SET ABMP("VTYP")=111
+39 GOTO XIT
+40 ;
+41 ; X6=EXPORT MODE^PROCDURE CODING METHOD^BILL TYPE^REVN CD^FLAT RATE
+42 ;
FRATE ;EP - Entry Point for setting up Flat Rate array if applicable
+1 SET ABMV("X6")=""
+2 IF '$DATA(ABMP("GL"))
SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+3 ;I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,11),$P(^(0),U,11)=111!($P(^(0),U,11)=131) D ;ABM*2.6*21 IHS/SD/AML HEAT139641
+4 ;ABM*2.6*21 IHS/SD/AML HEAT139641
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),U,11)
IF $PIECE(^(0),U,11)=111!($PIECE(^(0),U,11)=131)
Begin DoDot:1
+5 SET DA(1)=ABMP("INS")
+6 SET DA=ABMP("VTYP")
+7 SET DIE="^ABMNINS("_DA(1)_",1,"
+8 SET DR=".11////"_$SELECT($PIECE(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0),U,11)=111:40,1:42)
+9 DO ^DIE
End DoDot:1
+10 DO BTYP^ABMDEVAR
+11 SET $PIECE(ABMV("X6"),"^",3)=ABMP("BTYP")
+12 IF ABMP("BTYP")=121
SET ABMP("VTYP")=121
+13 SET ABMX("VDT")=$PIECE($GET(@(ABMP("GL")_"7)")),U)
+14 ;start old abm*2.6*21 IHS/SD/AML HEAT139641
+15 ;I '$D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) G RT
+16 ;S $P(ABMV("X6"),U,2)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
+17 ;S $P(ABMV("X6"),U,4)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
+18 ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
+19 IF '$DATA(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0))
GOTO RT
+20 SET $PIECE(ABMV("X6"),U,2)=$PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,2)
+21 SET $PIECE(ABMV("X6"),U,4)=$PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,3)
+22 ;end new abm*2.6*21 IHS/SD/AML HEAT139641
+23 IF $PIECE(ABMV("X6"),"^",4)=""
Begin DoDot:1
+24 IF ABMP("VTYP")=111
SET $PIECE(ABMV("X6"),"^",4)=100
QUIT
+25 IF ABMP("VTYP")=121
SET $PIECE(ABMV("X6"),"^",4)=240
QUIT
+26 SET $PIECE(ABMV("X6"),"^",4)=510
End DoDot:1
+27 IF '$DATA(ABMP("EXP"))
DO EXP^ABMDEVAR
+28 ;start old abm*2.6*21 IHS/SD/AML HEAT139641
+29 ;I $D(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0)) D
+30 ;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4) D
+31 ;..S $P(ABMV("X6"),U)=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
+32 ;.I $P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5) D
+33 ;..S ABMP("FEE")=$P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
+34 ;end old start new abm*2.6*21 IHS/SD/AML HEAT139641
+35 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0))
Begin DoDot:1
+36 IF $PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
Begin DoDot:2
+37 SET $PIECE(ABMV("X6"),U)=$PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,4)
End DoDot:2
+38 IF $PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
Begin DoDot:2
+39 SET ABMP("FEE")=$PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,5)
End DoDot:2
End DoDot:1
+40 ;end new abm*2.6*21 IHS/SD/AML HEAT139641
+41 ;I $D(ABMP("VTYP",999)),$P($G(^AUTNINS(ABMX("INS"),2)),U)="R" D ;abm*2.6*10 HEAT73780
+42 ;abm*2.6*10 HEAT73780
IF $DATA(ABMP("VTYP",999))
IF ($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMX("INS"),".211","I"),1,"I")="R")
Begin DoDot:1
+43 SET ABMX=0
FOR
SET ABMX=$ORDER(@(ABMP("GL")_"13,"_ABMX("INS")_",11,"_ABMX_")"))
IF 'ABMX
QUIT
IF $PIECE($GET(^AUTTPIC(ABMX,0)),U,3)="B"
SET ABMX="OK"
QUIT
+44 IF ABMX'="OK"
KILL ABMP("VTYP",999)
End DoDot:1
+45 SET ABMX=0
+46 KILL ABMX("HIT")
+47 SET $PIECE(ABMV("X6"),"^",5)=$$FLAT^ABMDUTL(ABMX("INS"),ABMP("VTYP"),ABMX("VDT"))
+48 ;
RT ; ABMP("FLAT")=Flat Rate^Revn^Units^Pro Fee^Pro Coding Method^Revn Desc^Desc Code^Prof Comp Days
+1 IF +$PIECE(ABMV("X6"),U,5)
Begin DoDot:1
+2 SET ABMP("FLAT")=$PIECE(ABMV("X6"),U,5)_U_$PIECE(ABMV("X6"),U,4)
+3 SET ABMP("FLAT")=ABMP("FLAT")_U_$SELECT((ABMP("BTYP")=111!(ABMP("BTYP")=121))&($PIECE($GET(@(ABMP("GL")_"7)")),U,3)>0):$PIECE($GET(^(7)),U,3),ABMP("BTYP")=111:1,$PIECE($GET(^(6)),U,9)]"":$PIECE(^(6),U,9),1:1)
End DoDot:1
+4 ;I S $P(ABMP("FLAT"),U,6)=$P($P(^ABMNINS(DUZ(2),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|"),$P(ABMP("FLAT"),U,7)=$P($P(^(0),U,9),"|",2) ;abm*2.6*21 IHS/SD/AML HEAT139641
+5 ;abm*2.6*21 IHS/SD/AML HEAT139641
IF $TEST
SET $PIECE(ABMP("FLAT"),U,6)=$PIECE($PIECE(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,ABMP("VTYP"),0),U,9),"|")
SET $PIECE(ABMP("FLAT"),U,7)=$PIECE($PIECE(^(0),U,9),"|",2)
+6 IF '$DATA(ABMP("FLAT"))
QUIT
+7 IF $PIECE($GET(@(ABMP("GL")_"5)")),U,10)>0
SET ABMP("FLAT",170)=$PIECE(^(5),U,10)
+8 IF $DATA(ABMP("VTYP",999))
Begin DoDot:1
+9 SET $PIECE(ABMP("FLAT"),U,8)=$PIECE($GET(@(ABMP("GL")_"5)")),U,7)
+10 IF '$PIECE(ABMP("FLAT"),U,8)
SET $PIECE(ABMP("FLAT"),U,8)=$PIECE(ABMP("FLAT"),U,3)+3
+11 ;S $P(ABMP("FLAT"),U,5)=$P($G(^ABMNINS(DUZ(2),ABMX("INS"),1,999,0)),U,2) ;abm*2.6*21 IHS/SD/AML HEAT139641
+12 ;abm*2.6*21 IHS/SD/AML HEAT139641
SET $PIECE(ABMP("FLAT"),U,5)=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMX("INS"),1,999,0)),U,2)
+13 SET $PIECE(ABMP("FLAT"),U,4)=$$FLAT^ABMDUTL(ABMX("INS"),999,ABMX("VDT"))
End DoDot:1
+14 QUIT
+15 ;
+16 ; *********************************************************************
XIT ;
+1 KILL ABMX
+2 QUIT
