ABMDE1 ; IHS/ASDST/DMJ - CLAIM IDENTIFIERS-SCRN 1 ;
;;2.6;IHS 3P BILLING SYSTEM**9,10,22**;;NOV 12, 2009;Build 418
;
; IHS/SD/SDR - v2.5 p8 - task 8 - Added code to check when VT changes to check for replacement insurer
; IHS/SD/SDR - v2.5 p11 - IM22787 - Fix for replacement insurer
; IHS/SD/SDR - 2.6*9 - HEAT28364 - changed replacement insurer to use LDFN not DUZ(2)
;IHS/SD/SDR 2.6*22 HEAT335246 - Added AUTO-SPLIT tag to claim number if AUTO-SPLIT claim
;
OPT K ABM,ABMV,ABME
S ABMP("OPT")="EVNJBQ"
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
S ABMP("VTYP")=$P(ABMP("C0"),U,7)
D DISP
W !
D SEL^ABMDEOPT
I "EV"'[$E(Y) G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I $E(Y)="V" D ^ABMDE1A G OPT
I $E(Y)="C" D ^ABMDECK G XIT:$D(ABMP("OVER")),OPT
;
EDIT ; Entry of Claim Identifiers
S ABMP("FLDS")=8
D FLDS^ABMDEOPT
W !
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S DR=""
F ABM("I")=1:1 S ABM=$P(ABMP("FLDS"),",",ABM("I")) Q:ABM="" D
.S:ABM("I")>1 DR=DR_";"
.S DR=DR_$P($T(@ABM),";;",2)
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D ^DIE
;edited visit type-check if it should mimic a different insurer/vt
I DR[".07" D TPICHECK
K DR
G OPT
;
DISP ;
S ABMZ("TITL")="CLAIM IDENTIFIERS"
S ABMZ("PG")=1
I '$D(ABMP("DDL")) D SUM^ABMDE1 I 1
E S ABMC("CONT")="" D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT
;
D ^ABMDE1X
;
W !?17,"[1] Clinic.............: ",ABM(6)
W !?17,"[2] Visit Type.........: ",ABM(7)
W !?17,"[3] Bill Type..........: ",ABM(12)
W !?17,"[4] Billing From Date..: ",ABM(71)
W !?17,"[5] Billing Thru Date..: ",ABM(72)
W !?17,"[6] Super Bill #.......: ",ABM(11)
W !?17,"[7] Mode of Export.....: ",$P($G(^ABMDEXP(+$G(ABMP("EXP")),0)),U)
W !?17,"[8] Visit Location.....: ",$P($G(^DIC(4,+ABM(3),0)),U)
D CNT^ABMDERR
I ABM("ERR")>0 S ABM("ERROR")=""
I +$O(ABME(0)) D
.S ABME("CONT")=""
.D ^ABMDERR
.K ABME("CONT")
Q
;
; Entry of Claim Identifiers
1 ;;.06T
2 ;;.07T
3 ;;.12T
4 ;;.71T
5 ;;.72T
6 ;;.11T
7 ;;.14T
8 ;;.03[8] Visit Location..
;
XIT ;
S ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
K ABM,ABMV,ABME
Q
;
PAUSE ;EP - Entry Point for Page Pause and Header
I $D(ABMC("CONT")),$D(ABMP("DDL")) D G S4
.K ABMC("CONT")
.W $$EN^ABMVDF("IOF")
I $E(IOST)="C",'$D(IO("S")) D I $D(ABMP("DDL")) Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(ABME("QUIT"))
. K DIR
. S DIR(0)="EO"
. D ^DIR
. K DIR
W $$EN^ABMVDF("IOF")
I $D(ABMP("DDL")) G S4
I $D(ABMC("ERR")) G SUM
Q
;
SUM ;EP - Entry Point for Page Header Summary
I $D(ABMP("DDL")) G S3
W $$EN^ABMVDF("IOF")
S2 ;
W !
S ABM("D")=""
S ABM("PG")=" PAGE "_ABMZ("PG")_" "
S $P(ABM("D"),"~",(80-$L(ABM("PG"))/2)+1)=""
W ABM("D"),ABM("PG"),ABM("D"),!
W "Patient: ",$P(^DPT(ABMP("PDFN"),0),U)
;
HRN ;
I ABMP("LDFN")]"" D
. W " ",$S($D(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)):" [HRN:"_$P(^(0),U,2)_"]",1:" [no HRN]")
;W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)="S" W ?53,"SPLIT Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)="A" W ?53,"AUTOSPLIT Claim#: ",ABMP("CDFN"),! ;abm*2.6*22 IHS/SD/SDR HEAT335246
;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)'="S" W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008 ;abm*2.6*22 HEAT335246
I "^A^S^"'[("^"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)_"^") W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008 ;abm*2.6*22 HEAT335246
I +ABMZ("PG")=8 D
.W "Mode of Export: ",$P($G(^ABMDEXP(ABMP(ABMZ("PG")),0)),U),!
S ABM("D")=""
S ABM("TITL")=" ("_ABMZ("TITL")_") "
S $P(ABM("D"),".",(80-$L(ABM("TITL"))/2)+1)=""
W ABM("D"),ABM("TITL"),ABM("D"),!
Q
;
S3 ;
S ABM("D")=""
S ABM("TITL")=" (PAGE "_ABMZ("PG")_" - "_ABMZ("TITL")_") "
S $P(ABM("D"),".",(80-$L(ABM("TITL"))/2)+1)=""
W !,ABM("D"),ABM("TITL"),ABM("D"),!
Q
;
S4 ;
W !
S ABM("D")=""
S ABM("PG")=" DETAILED CLAIM LISTING "
S $P(ABM("D"),"~",(80-$L(ABM("PG"))/2)+1)=""
W ABM("D"),ABM("PG"),ABM("D"),!
;W "Patient: ",$P(^DPT(ABMP("PDFN"),0),U),?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
W "Patient: ",$P(^DPT(ABMP("PDFN"),0),U) ;abm*2.6*10 ICD10 008
W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
S ABM("D")=""
S ABM("TITL")=" (PAGE "_ABMZ("PG")_" - "_ABMZ("TITL")_") "
S $P(ABM("D"),".",(80-$L(ABM("TITL"))/2)+1)=""
W ABM("D"),ABM("TITL"),ABM("D"),!
Q
TPICHECK ;EP
S ABMDVTCK=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,7) ;vt
;loop thru insurers on claim removing existing replacments
S ABMINSI=0
F S ABMINSI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI)) Q:+ABMINSI=0 D
.S ABMINS=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U)
.D RMVRPLC ;remove replacement insurer from claim
.I ABMP("INS")=ABMINS D ;this is the active insurer; check for replacement
..S ABMVTEDT="",ABMVFLG=0
..;F S ABMVTEDT=$O(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT),-1) Q:ABMVTEDT="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
..F S ABMVTEDT=$O(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT),-1) Q:ABMVTEDT="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
...S ABMVIEN=0
...;F S ABMVIEN=$O(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT,ABMVIEN)) Q:ABMVIEN="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
...F S ABMVIEN=$O(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT,ABMVIEN)) Q:ABMVIEN="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
....;I $P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)="" S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
....I $P($G(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)="" S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
....;I $P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)'="",($P(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0),U,2))>($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)) S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
....I $P($G(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)'="",($P(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0),U,2))>($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)) S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
..Q:ABMVFLG=0 ;no replacement--quit
..;change active insurer
..S DA=ABMP("CDFN")
..S DIE="^ABMDCLM(DUZ(2),"
..;S DR=".08////"_$P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
..S DR=".08////"_$P($G(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
..D ^DIE
..;
..S DA(1)=ABMP("CDFN")
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
..S DA=ABMINSI
..;S DR=".011////"_$P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
..S DR=".011////"_$P($G(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
..D ^DIE
D ^ABMDEVAR
Q
RMVRPLC ; if there's a replacement, is it the active insurer
I ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U,11) D
.S DA=ABMP("CDFN")
.S DIE="^ABMDCLM(DUZ(2),"
.S DR=".08////"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U)
.D ^DIE
.S ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,8)
;remove replacement
S DA(1)=ABMP("CDFN")
S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
S DA=ABMINSI
S DR=".011////@"
D ^DIE
Q
ABMDE1 ; IHS/ASDST/DMJ - CLAIM IDENTIFIERS-SCRN 1 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM**9,10,22**;;NOV 12, 2009;Build 418
+2 ;
+3 ; IHS/SD/SDR - v2.5 p8 - task 8 - Added code to check when VT changes to check for replacement insurer
+4 ; IHS/SD/SDR - v2.5 p11 - IM22787 - Fix for replacement insurer
+5 ; IHS/SD/SDR - 2.6*9 - HEAT28364 - changed replacement insurer to use LDFN not DUZ(2)
+6 ;IHS/SD/SDR 2.6*22 HEAT335246 - Added AUTO-SPLIT tag to claim number if AUTO-SPLIT claim
+7 ;
OPT KILL ABM,ABMV,ABME
+1 SET ABMP("OPT")="EVNJBQ"
+2 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+3 SET ABMP("VTYP")=$PIECE(ABMP("C0"),U,7)
+4 DO DISP
+5 WRITE !
+6 DO SEL^ABMDEOPT
+7 IF "EV"'[$EXTRACT(Y)
GOTO XIT
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+9 IF $EXTRACT(Y)="V"
DO ^ABMDE1A
GOTO OPT
+10 IF $EXTRACT(Y)="C"
DO ^ABMDECK
IF $DATA(ABMP("OVER"))
GOTO XIT
GOTO OPT
+11 ;
EDIT ; Entry of Claim Identifiers
+1 SET ABMP("FLDS")=8
+2 DO FLDS^ABMDEOPT
+3 WRITE !
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+5 SET DR=""
+6 FOR ABM("I")=1:1
SET ABM=$PIECE(ABMP("FLDS"),",",ABM("I"))
IF ABM=""
QUIT
Begin DoDot:1
+7 IF ABM("I")>1
SET DR=DR_";"
+8 SET DR=DR_$PIECE($TEXT(@ABM),";;",2)
End DoDot:1
+9 SET DIE="^ABMDCLM(DUZ(2),"
+10 SET DA=ABMP("CDFN")
+11 DO ^DIE
+12 ;edited visit type-check if it should mimic a different insurer/vt
+13 IF DR[".07"
DO TPICHECK
+14 KILL DR
+15 GOTO OPT
+16 ;
DISP ;
+1 SET ABMZ("TITL")="CLAIM IDENTIFIERS"
+2 SET ABMZ("PG")=1
+3 IF '$DATA(ABMP("DDL"))
DO SUM^ABMDE1
IF 1
+4 IF '$TEST
SET ABMC("CONT")=""
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+5 ;
+6 DO ^ABMDE1X
+7 ;
+8 WRITE !?17,"[1] Clinic.............: ",ABM(6)
+9 WRITE !?17,"[2] Visit Type.........: ",ABM(7)
+10 WRITE !?17,"[3] Bill Type..........: ",ABM(12)
+11 WRITE !?17,"[4] Billing From Date..: ",ABM(71)
+12 WRITE !?17,"[5] Billing Thru Date..: ",ABM(72)
+13 WRITE !?17,"[6] Super Bill #.......: ",ABM(11)
+14 WRITE !?17,"[7] Mode of Export.....: ",$PIECE($GET(^ABMDEXP(+$GET(ABMP("EXP")),0)),U)
+15 WRITE !?17,"[8] Visit Location.....: ",$PIECE($GET(^DIC(4,+ABM(3),0)),U)
+16 DO CNT^ABMDERR
+17 IF ABM("ERR")>0
SET ABM("ERROR")=""
+18 IF +$ORDER(ABME(0))
Begin DoDot:1
+19 SET ABME("CONT")=""
+20 DO ^ABMDERR
+21 KILL ABME("CONT")
End DoDot:1
+22 QUIT
+23 ;
+24 ; Entry of Claim Identifiers
1 ;;.06T
2 ;;.07T
3 ;;.12T
4 ;;.71T
5 ;;.72T
6 ;;.11T
7 ;;.14T
8 ;;.03[8] Visit Location..
+1 ;
XIT ;
+1 SET ABMP("C0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+2 KILL ABM,ABMV,ABME
+3 QUIT
+4 ;
PAUSE ;EP - Entry Point for Page Pause and Header
+1 IF $DATA(ABMC("CONT"))
IF $DATA(ABMP("DDL"))
Begin DoDot:1
+2 KILL ABMC("CONT")
+3 WRITE $$EN^ABMVDF("IOF")
End DoDot:1
GOTO S4
+4 IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
Begin DoDot:1
+5 KILL DIR
+6 SET DIR(0)="EO"
+7 DO ^DIR
+8 KILL DIR
End DoDot:1
IF $DATA(ABMP("DDL"))
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)!$DATA(ABME("QUIT"))
QUIT
+9 WRITE $$EN^ABMVDF("IOF")
+10 IF $DATA(ABMP("DDL"))
GOTO S4
+11 IF $DATA(ABMC("ERR"))
GOTO SUM
+12 QUIT
+13 ;
SUM ;EP - Entry Point for Page Header Summary
+1 IF $DATA(ABMP("DDL"))
GOTO S3
+2 WRITE $$EN^ABMVDF("IOF")
S2 ;
+1 WRITE !
+2 SET ABM("D")=""
+3 SET ABM("PG")=" PAGE "_ABMZ("PG")_" "
+4 SET $PIECE(ABM("D"),"~",(80-$LENGTH(ABM("PG"))/2)+1)=""
+5 WRITE ABM("D"),ABM("PG"),ABM("D"),!
+6 WRITE "Patient: ",$PIECE(^DPT(ABMP("PDFN"),0),U)
+7 ;
HRN ;
+1 IF ABMP("LDFN")]""
Begin DoDot:1
+2 WRITE " ",$SELECT($DATA(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)):" [HRN:"_$PIECE(^(0),U,2)_"]",1:" [no HRN]")
End DoDot:1
+3 ;W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
+4 ;abm*2.6*10 ICD10 008
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)="S"
WRITE ?53,"SPLIT Claim Number: ",ABMP("CDFN"),!
+5 ;abm*2.6*22 IHS/SD/SDR HEAT335246
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)="A"
WRITE ?53,"AUTOSPLIT Claim#: ",ABMP("CDFN"),!
+6 ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)'="S" W ?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008 ;abm*2.6*22 HEAT335246
+7 ;abm*2.6*10 ICD10 008 ;abm*2.6*22 HEAT335246
IF "^A^S^"'[("^"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,22)_"^")
WRITE ?59,"Claim Number: ",ABMP("CDFN"),!
+8 IF +ABMZ("PG")=8
Begin DoDot:1
+9 WRITE "Mode of Export: ",$PIECE($GET(^ABMDEXP(ABMP(ABMZ("PG")),0)),U),!
End DoDot:1
+10 SET ABM("D")=""
+11 SET ABM("TITL")=" ("_ABMZ("TITL")_") "
+12 SET $PIECE(ABM("D"),".",(80-$LENGTH(ABM("TITL"))/2)+1)=""
+13 WRITE ABM("D"),ABM("TITL"),ABM("D"),!
+14 QUIT
+15 ;
S3 ;
+1 SET ABM("D")=""
+2 SET ABM("TITL")=" (PAGE "_ABMZ("PG")_" - "_ABMZ("TITL")_") "
+3 SET $PIECE(ABM("D"),".",(80-$LENGTH(ABM("TITL"))/2)+1)=""
+4 WRITE !,ABM("D"),ABM("TITL"),ABM("D"),!
+5 QUIT
+6 ;
S4 ;
+1 WRITE !
+2 SET ABM("D")=""
+3 SET ABM("PG")=" DETAILED CLAIM LISTING "
+4 SET $PIECE(ABM("D"),"~",(80-$LENGTH(ABM("PG"))/2)+1)=""
+5 WRITE ABM("D"),ABM("PG"),ABM("D"),!
+6 ;W "Patient: ",$P(^DPT(ABMP("PDFN"),0),U),?59,"Claim Number: ",ABMP("CDFN"),! ;abm*2.6*10 ICD10 008
+7 ;abm*2.6*10 ICD10 008
WRITE "Patient: ",$PIECE(^DPT(ABMP("PDFN"),0),U)
+8 ;abm*2.6*10 ICD10 008
WRITE ?59,"Claim Number: ",ABMP("CDFN"),!
+9 SET ABM("D")=""
+10 SET ABM("TITL")=" (PAGE "_ABMZ("PG")_" - "_ABMZ("TITL")_") "
+11 SET $PIECE(ABM("D"),".",(80-$LENGTH(ABM("TITL"))/2)+1)=""
+12 WRITE ABM("D"),ABM("TITL"),ABM("D"),!
+13 QUIT
TPICHECK ;EP
+1 ;vt
SET ABMDVTCK=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,7)
+2 ;loop thru insurers on claim removing existing replacments
+3 SET ABMINSI=0
+4 FOR
SET ABMINSI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI))
IF +ABMINSI=0
QUIT
Begin DoDot:1
+5 SET ABMINS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U)
+6 ;remove replacement insurer from claim
DO RMVRPLC
+7 ;this is the active insurer; check for replacement
IF ABMP("INS")=ABMINS
Begin DoDot:2
+8 SET ABMVTEDT=""
SET ABMVFLG=0
+9 ;F S ABMVTEDT=$O(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT),-1) Q:ABMVTEDT="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
+10 ;abm*2.6*9 HEAT28364
FOR
SET ABMVTEDT=$ORDER(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT),-1)
IF ABMVTEDT=""
QUIT
Begin DoDot:3
+11 SET ABMVIEN=0
+12 ;F S ABMVIEN=$O(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT,ABMVIEN)) Q:ABMVIEN="" D Q:ABMVFLG=1 ;abm*2.6*9 HEAT28364
+13 ;abm*2.6*9 HEAT28364
FOR
SET ABMVIEN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,"B",ABMVTEDT,ABMVIEN))
IF ABMVIEN=""
QUIT
Begin DoDot:4
+14 ;I $P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)="" S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
+15 ;abm*2.6*9 HEAT28364
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)=""
SET ABMVFLG=1
QUIT
+16 ;I $P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)'="",($P(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0),U,2))>($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)) S ABMVFLG=1 Q ;abm*2.6*9 HEAT28364
+17 ;abm*2.6*9 HEAT28364
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,2)'=""
IF ($PIECE(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0),U,2))>($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2))
SET ABMVFLG=1
QUIT
End DoDot:4
IF ABMVFLG=1
QUIT
End DoDot:3
IF ABMVFLG=1
QUIT
+18 ;no replacement--quit
IF ABMVFLG=0
QUIT
+19 ;change active insurer
+20 SET DA=ABMP("CDFN")
+21 SET DIE="^ABMDCLM(DUZ(2),"
+22 ;S DR=".08////"_$P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
+23 ;abm*2.6*9 HEAT28364
SET DR=".08////"_$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3)
+24 DO ^DIE
+25 ;
+26 SET DA(1)=ABMP("CDFN")
+27 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+28 SET DA=ABMINSI
+29 ;S DR=".011////"_$P($G(^ABMNINS(DUZ(2),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3) ;abm*2.6*9 HEAT28364
+30 ;abm*2.6*9 HEAT28364
SET DR=".011////"_$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMINS,1,ABMDVTCK,12,ABMVIEN,0)),U,3)
+31 DO ^DIE
End DoDot:2
End DoDot:1
+32 DO ^ABMDEVAR
+33 QUIT
RMVRPLC ; if there's a replacement, is it the active insurer
+1 IF ABMP("INS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U,11)
Begin DoDot:1
+2 SET DA=ABMP("CDFN")
+3 SET DIE="^ABMDCLM(DUZ(2),"
+4 SET DR=".08////"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABMINSI,0)),U)
+5 DO ^DIE
+6 SET ABMP("INS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,8)
End DoDot:1
+7 ;remove replacement
+8 SET DA(1)=ABMP("CDFN")
+9 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+10 SET DA=ABMINSI
+11 SET DR=".011////@"
+12 DO ^DIE
+13 QUIT
