Routine: ABMDE1

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")

 ; 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

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

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"),!

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"),!

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"),!

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

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

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

ABMDE1.m