ABMDTINS.m

ABMDTINS ; IHS/ASDST/DMJ - Table Maintenance of INSURER FILE ; 

 ;;2.6;IHS 3P BILLING SYSTEM;**10,11,22**;NOV 12, 2009;Build 418

 ;

 ; IHS/SD/SDR - v2.5 p12 - UFMS - Added prompt for Federal Tax ID

 ;

 ;IHS/SD/SDR 2.6*22 HEAT335246 Added code for new prompt to print/not print NDC if all-inclusive mode is selected for insurer.

 ;

 K ABM

 W !!,"WARNING: Before ADDING a new INSURER you should ensure that it"

 W !?9,"does not already exist!"

 K DIR S DIR(0)="SO^1:EDIT EXISTING INSURER;2:ADD NEW INSURER",DIR("A")="Select DESIRED ACTION",DIR("B")=1 D ^DIR K DIR G XIT:'Y!$D(DIRUT)

 G ADD:Y=2

 W ! K DIR S DIR(0)="YO",DIR("A")="Screen-out Insurers with status of Unselectable",DIR("B")="Y"

 S DIR("?")="Answer 'YES' if the Insurers that have been designated as being Unselectable should be screened-out."

 D ^DIR K DIR G XIT:$D(DIROUT)!$D(DIRUT)

 K DIC I Y S DIC("S")="I $P($G(^(1)),U,7)'=0"

SEL W !! S DIC="^AUTNINS(",DIC("A")="Select INSURER: ",DIC(0)="QEAM" D ^DIC K DIC G XIT:X=""!$D(DUOUT)!$D(DTOUT),SEL:+Y<1

 S ABM("DFN")=+Y,ABM("MODE")=0 G EDIT

 ;

ADD S (ABM("DFN"),ABM,ABM("LOCK"))=0,ABM("MODE")=1

 W ! K DIR S DIR(0)="FO^3:30",DIR("A")="Enter the NAME of the INSURER" D ^DIR K DIR G XIT:$D(DIRUT) S ABM("X")=X

 I $D(^AUTNINS("B",$E(X,1,30))) W *7,!!,"The Insurer '",X,"' already exists!" G PAZ

 W !,*7 K DIR S DIR(0)="Y",DIR("A")="Do you want to Add '"_ABM("X")_"' as a New INSURER" D ^DIR K DIR G SEL:$D(DUOUT)!$D(DTOUT),SEL:Y<1

 W !,"OK, adding..."

 S X=ABM("X"),DIC="^AUTNINS(",DIC(0)="L" K DD,DO D FILE^DICN

 I +Y<1 W *7,!!,"ERROR: INSURER NOT CREATED",!! G PAZ

 S ABM("DFN")=+Y

 ;

EDIT L +^AUTNINS(ABM("DFN")):1 I '$T W *7,!!,"Record in USE by another USER, try Later!" G PAZ

 S DA=ABM("DFN"),DIE="^AUTNINS("

 G ADDR

 W ! S DR=".01R~Insurer Name.......: " D ^DIE G KILL:$D(Y)

 D KEYWD

 S DR=".41R~Long Lookup Name...: " D ^DIE G KILL:$D(Y)

ADDR W !!,"<--------------- MAILING ADDRESS --------------->"

 S DR=".02R~Street...: ;.03R~City.....: ;.04R~State....: ;.05R~Zip Code.: " D ^DIE G KILL:$D(Y)

 S ABM("MODE")=0 W !!,"<--------------- BILLING ADDRESS --------------->",!?6,"(if Different than Mailing Address)"

 S DR="1Billing Office.: ;I X="""" S Y=""@9"";2        Street.: ;3        City...: ;4        State..: ;5        Zip....: ;@9" D ^DIE G KILL:$D(Y)

 W ! S DR=".06Phone Number.......: ;.09Contact Person.....: ;.11Federal Tax ID#....: ;.08AO Control Number..: " D ^DIE G XIT:$D(Y)

 I $P($G(^AUTNINS(DA,1)),U,7)'=2 D  G XIT:$D(Y)

 .S DR=".17Insurer Status.....: " D ^DIE Q:$D(Y)

 .;I "HMPWCF"[$P($G(^AUTNINS(DA,2)),U) S DR=".21Type of Insurer....: " D ^DIE  ;abm*2.6*10 HEAT73780

 .;I "HMPWCF"[$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,DA,".211","I"),1,"I") S DR=".211Type of Insurer....: " D ^DIE  ;abm*2.6*10 HEAT73780

 .I "HMPWCF"[$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,DA,".211","I"),1,"I") S DR=".211R~Type of Insurer....: " D ^DIE  ;abm*2.6*11  Make insurer type required

 S ABM("DFLT")=0 F  S ABM("DFLT")=$O(^ABMNINS(DUZ(2),DA,1,ABM("DFLT"))) Q:'ABM("DFLT")  I $O(^(ABM("DFLT"),11,0)) Q

 ;S DR=".22All Inclusive Mode.: //"_$S(ABM("DFLT"):"Y",1:"")_";.24Backbill Limit (months): " D ^DIE G XIT:$D(Y)  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 ;start new abm*2.6*22 IHS/SD/SDR HEAT335246

 S DR=".22All Inclusive Mode.: //"_$S(ABM("DFLT"):"Y",1:"") D ^DIE G XIT:$D(Y)

 S DIE="^ABMNINS(DUZ(2),"

 S DR=".14"_$S($P($G(^AUTNINS(DA,2)),U,2)="Y":"For All Inclusive print the NDC",1:"////@")

 D ^DIE G XIT:$D(Y)

 K DR S DIE="^AUTNINS("

 S DR=".24Backbill Limit (months): " D ^DIE G XIT:$D(Y)

 ;end new abm*2.6*22 IHS/SD/SDR HEAT335246

 I ABM("DFLT"),$P(^AUTNINS(DA,2),U,2)="N" S ABM=0 F  S ABM=$O(^ABMNINS(DUZ(2),DA,1,ABM)) Q:'ABM  D

 .K ^ABMNINS(DUZ(2),DA,1,ABM,11)

 .S DA(1)=DA,DA=ABM,DR=".02////C",DIE="^ABMNINS("_DA(1)_",1,"

 .D ^DIE K DR S DA=DA(1),DIE="^AUTNINS("

 S DR=".25Dental Bill Status.: ;.23Rx Billing Status..: " D ^DIE G XIT:$D(Y)

CLINIC ;

 W !

 F  D  G XIT:$D(DTOUT)!$D(DUOUT)  Q:+$G(Y)<0

 .S DA(1)=ABM("DFN")

 .S DIC="^AUTNINS(DA(1),17,"

 .S DIC(0)="QLEAM"

 .S DIC("A")="Select CLINIC UNBILLABLE:  "

 .S:'$D(^AUTNINS(DA(1),17,0)) ^(0)="^9999999.181701P^^"

 .D ^DIC

 .K DIC

 .Q:$D(DTOUT)!$D(DUOUT)!(+Y<1)

 .S DA=+Y

 .S DIE="^AUTNINS(DA(1),17,"

 .S DR=".01     Clinic...."

 .D ^DIE

 D ^ABMDTIN1 G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)

 ;I $P(^AUTNINS(ABM("DFN"),2),U,2)="Y" W ! K DIC S DIE="^AUTNINS(",DA=ABM("DFN"),DR="4301" D ^DIE  ;abm*2.6*10 ICD10 023

 G XIT

 ;

PAZ K DIR S DIR(0)="E" D ^DIR

XIT I $D(ABM("DFN")) L -^AUTNINS(ABM("DFN"))

 K ABM,DIC,DIE

 K DA,DR,Y,X

 Q

 ;

KILL I ABM("MODE") W !!,*7,"<Data Incomplete: Entry Deleted>" S DIK=DIE D ^DIK G PAZ

 G XIT

 ;

KEYWD ; EP for building Keyword Long Name Field

 S ABM("X")=$P(^AUTNINS(DA,0),U),ABM("L")=$O(^AICDKWLC("B","INSURERS",0)),ABM("R")="",ABM("O")=0 I ABM("L") F ABM("I")=1:1 D  Q:ABM("O")

 .I $P($G(^AUTNINS(DA,4)),U)]"",$P(^(4),U)'=$P(^(0),U) S ABM("O")=1 Q

 .S ABM=$P(ABM("X")," ",ABM("I")) I ABM="" S ABM("O")=1 Q

 .I ABM["." S ABM=$P(ABM,".")_$P(ABM,".",2) D SKEY Q

 .S ABM("OL")=ABM

 .F ABM("CH")="/","-",":",";" I ABM[ABM("CH") D  Q:ABM("OL")=""

 ..S ABM=$P(ABM,ABM("CH")) D SKEY

 ..S ABM=$P(ABM("OL"),ABM("CH"),2),ABM("OL")="" D SKEY

 .I ABM("OL")'="" D SKEY Q

 Q:ABM("R")=""  S:$P($G(^AUTNINS(DA,4)),U)="" ABM("X")=""

 I ABM("R")'=ABM("X") S DR=".41////"_ABM("R") D ^DIE

 Q

SKEY I ABM'="CO",ABM]"",$D(^AICDKWLC(ABM("L"),2,"B",ABM)),$D(^AICDKWLC(ABM("L"),2,$O(^(ABM,0)),0)) S ABM=$P(^(0),U,2)

 S ABM("R")=ABM("R")_$S(ABM("R")]"":" ",1:"")_ABM

 Q

ABMDTINS  ; IHS/ASDST/DMJ - Table Maintenance of INSURER FILE ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**10,11,22**;NOV 12, 2009;Build 418

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p12 - UFMS - Added prompt for Federal Tax ID

 +4       ;

 +5       ;IHS/SD/SDR 2.6*22 HEAT335246 Added code for new prompt to print/not print NDC if all-inclusive mode is selected for insurer.

 +6       ;

 +7        KILL ABM

 +8        WRITE !!,"WARNING: Before ADDING a new INSURER you should ensure that it"

 +9        WRITE !?9,"does not already exist!"

 +10       KILL DIR

           SET DIR(0)="SO^1:EDIT EXISTING INSURER;2:ADD NEW INSURER"

           SET DIR("A")="Select DESIRED ACTION"

           SET DIR("B")=1

           DO ^DIR

           KILL DIR

           IF 'Y!$DATA(DIRUT)

               GOTO XIT

 +11       IF Y=2

               GOTO ADD

 +12       WRITE !

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("A")="Screen-out Insurers with status of Unselectable"

           SET DIR("B")="Y"

 +13       SET DIR("?")="Answer 'YES' if the Insurers that have been designated as being Unselectable should be screened-out."

 +14       DO ^DIR

           KILL DIR

           IF $DATA(DIROUT)!$DATA(DIRUT)

               GOTO XIT

 +15       KILL DIC

           IF Y

               SET DIC("S")="I $P($G(^(1)),U,7)'=0"

SEL        WRITE !!

           SET DIC="^AUTNINS("

           SET DIC("A")="Select INSURER: "

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

           IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

           IF +Y<1

               GOTO SEL

 +1        SET ABM("DFN")=+Y

           SET ABM("MODE")=0

           GOTO EDIT

 +2       ;

ADD        SET (ABM("DFN"),ABM,ABM("LOCK"))=0

           SET ABM("MODE")=1

 +1        WRITE !

           KILL DIR

           SET DIR(0)="FO^3:30"

           SET DIR("A")="Enter the NAME of the INSURER"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO XIT

           SET ABM("X")=X

 +2        IF $DATA(^AUTNINS("B",$EXTRACT(X,1,30)))

               WRITE *7,!!,"The Insurer '",X,"' already exists!"

               GOTO PAZ

 +3        WRITE !,*7

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to Add '"_ABM("X")_"' as a New INSURER"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               GOTO SEL

           IF Y<1

               GOTO SEL

 +4        WRITE !,"OK, adding..."

 +5        SET X=ABM("X")

           SET DIC="^AUTNINS("

           SET DIC(0)="L"

           KILL DD,DO

           DO FILE^DICN

 +6        IF +Y<1

               WRITE *7,!!,"ERROR: INSURER NOT CREATED",!!

               GOTO PAZ

 +7        SET ABM("DFN")=+Y

 +8       ;

EDIT       LOCK +^AUTNINS(ABM("DFN")):1

           IF '$TEST

               WRITE *7,!!,"Record in USE by another USER, try Later!"

               GOTO PAZ

 +1        SET DA=ABM("DFN")

           SET DIE="^AUTNINS("

 +2        GOTO ADDR

 +3        WRITE !

           SET DR=".01R~Insurer Name.......: "

           DO ^DIE

           IF $DATA(Y)

               GOTO KILL

 +4        DO KEYWD

 +5        SET DR=".41R~Long Lookup Name...: "

           DO ^DIE

           IF $DATA(Y)

               GOTO KILL

ADDR       WRITE !!,"<--------------- MAILING ADDRESS --------------->"

 +1        SET DR=".02R~Street...: ;.03R~City.....: ;.04R~State....: ;.05R~Zip Code.: "

           DO ^DIE

           IF $DATA(Y)

               GOTO KILL

 +2        SET ABM("MODE")=0

           WRITE !!,"<--------------- BILLING ADDRESS --------------->",!?6,"(if Different than Mailing Address)"

 +3        SET DR="1Billing Office.: ;I X="""" S Y=""@9"";2        Street.: ;3        City...: ;4        State..: ;5        Zip....: ;@9"

           DO ^DIE

           IF $DATA(Y)

               GOTO KILL

 +4        WRITE !

           SET DR=".06Phone Number.......: ;.09Contact Person.....: ;.11Federal Tax ID#....: ;.08AO Control Number..: "

           DO ^DIE

           IF $DATA(Y)

               GOTO XIT

 +5        IF $PIECE($GET(^AUTNINS(DA,1)),U,7)'=2

               Begin DoDot:1

 +6                SET DR=".17Insurer Status.....: "

                   DO ^DIE

                   IF $DATA(Y)

                       QUIT 

 +7       ;I "HMPWCF"[$P($G(^AUTNINS(DA,2)),U) S DR=".21Type of Insurer....: " D ^DIE  ;abm*2.6*10 HEAT73780

 +8       ;I "HMPWCF"[$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,DA,".211","I"),1,"I") S DR=".211Type of Insurer....: " D ^DIE  ;abm*2.6*10 HEAT73780

 +9       ;abm*2.6*11  Make insurer type required

                   IF "HMPWCF"[$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,DA,".211","I"),1,"I")

                       SET DR=".211R~Type of Insurer....: "

                       DO ^DIE

               End DoDot:1

               IF $DATA(Y)

                   GOTO XIT

 +10       SET ABM("DFLT")=0

           FOR 

               SET ABM("DFLT")=$ORDER(^ABMNINS(DUZ(2),DA,1,ABM("DFLT")))

               IF 'ABM("DFLT")

                   QUIT 

               IF $ORDER(^(ABM("DFLT"),11,0))

                   QUIT 

 +11      ;S DR=".22All Inclusive Mode.: //"_$S(ABM("DFLT"):"Y",1:"")_";.24Backbill Limit (months): " D ^DIE G XIT:$D(Y)  ;abm*2.6*22 IHS/SD/SDR HEAT335246

 +12      ;start new abm*2.6*22 IHS/SD/SDR HEAT335246

 +13       SET DR=".22All Inclusive Mode.: //"_$SELECT(ABM("DFLT"):"Y",1:"")

           DO ^DIE

           IF $DATA(Y)

               GOTO XIT

 +14       SET DIE="^ABMNINS(DUZ(2),"

 +15       SET DR=".14"_$SELECT($PIECE($GET(^AUTNINS(DA,2)),U,2)="Y":"For All Inclusive print the NDC",1:"////@")

 +16       DO ^DIE

           IF $DATA(Y)

               GOTO XIT

 +17       KILL DR

           SET DIE="^AUTNINS("

 +18       SET DR=".24Backbill Limit (months): "

           DO ^DIE

           IF $DATA(Y)

               GOTO XIT

 +19      ;end new abm*2.6*22 IHS/SD/SDR HEAT335246

 +20       IF ABM("DFLT")

               IF $PIECE(^AUTNINS(DA,2),U,2)="N"

                   SET ABM=0

                   FOR 

                       SET ABM=$ORDER(^ABMNINS(DUZ(2),DA,1,ABM))

                       IF 'ABM

                           QUIT 

                       Begin DoDot:1

 +21                       KILL ^ABMNINS(DUZ(2),DA,1,ABM,11)

 +22                       SET DA(1)=DA

                           SET DA=ABM

                           SET DR=".02////C"

                           SET DIE="^ABMNINS("_DA(1)_",1,"

 +23                       DO ^DIE

                           KILL DR

                           SET DA=DA(1)

                           SET DIE="^AUTNINS("

                       End DoDot:1

 +24       SET DR=".25Dental Bill Status.: ;.23Rx Billing Status..: "

           DO ^DIE

           IF $DATA(Y)

               GOTO XIT

CLINIC    ;

 +1        WRITE !

 +2        FOR 

               Begin DoDot:1

 +3                SET DA(1)=ABM("DFN")

 +4                SET DIC="^AUTNINS(DA(1),17,"

 +5                SET DIC(0)="QLEAM"

 +6                SET DIC("A")="Select CLINIC UNBILLABLE:  "

 +7                IF '$DATA(^AUTNINS(DA(1),17,0))

                       SET ^(0)="^9999999.181701P^^"

 +8                DO ^DIC

 +9                KILL DIC

 +10               IF $DATA(DTOUT)!$DATA(DUOUT)!(+Y<1)

                       QUIT 

 +11               SET DA=+Y

 +12               SET DIE="^AUTNINS(DA(1),17,"

 +13               SET DR=".01     Clinic...."

 +14               DO ^DIE

               End DoDot:1

               IF $DATA(DTOUT)!$DATA(DUOUT)

                   GOTO XIT

               IF +$GET(Y)<0

                   QUIT 

 +15       DO ^ABMDTIN1

           IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)

               GOTO XIT

 +16      ;I $P(^AUTNINS(ABM("DFN"),2),U,2)="Y" W ! K DIC S DIE="^AUTNINS(",DA=ABM("DFN"),DR="4301" D ^DIE  ;abm*2.6*10 ICD10 023

 +17       GOTO XIT

 +18      ;

PAZ        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

XIT        IF $DATA(ABM("DFN"))

               LOCK -^AUTNINS(ABM("DFN"))

 +1        KILL ABM,DIC,DIE

 +2        KILL DA,DR,Y,X

 +3        QUIT 

 +4       ;

KILL       IF ABM("MODE")

               WRITE !!,*7,"<Data Incomplete: Entry Deleted>"

               SET DIK=DIE

               DO ^DIK

               GOTO PAZ

 +1        GOTO XIT

 +2       ;

KEYWD     ; EP for building Keyword Long Name Field

 +1        SET ABM("X")=$PIECE(^AUTNINS(DA,0),U)

           SET ABM("L")=$ORDER(^AICDKWLC("B","INSURERS",0))

           SET ABM("R")=""

           SET ABM("O")=0

           IF ABM("L")

               FOR ABM("I")=1:1

                   Begin DoDot:1

 +2                    IF $PIECE($GET(^AUTNINS(DA,4)),U)]""

                           IF $PIECE(^(4),U)'=$PIECE(^(0),U)

                               SET ABM("O")=1

                               QUIT 

 +3                    SET ABM=$PIECE(ABM("X")," ",ABM("I"))

                       IF ABM=""

                           SET ABM("O")=1

                           QUIT 

 +4                    IF ABM["."

                           SET ABM=$PIECE(ABM,".")_$PIECE(ABM,".",2)

                           DO SKEY

                           QUIT 

 +5                    SET ABM("OL")=ABM

 +6                    FOR ABM("CH")="/","-",":",";"

                           IF ABM[ABM("CH")

                               Begin DoDot:2

 +7                                SET ABM=$PIECE(ABM,ABM("CH"))

                                   DO SKEY

 +8                                SET ABM=$PIECE(ABM("OL"),ABM("CH"),2)

                                   SET ABM("OL")=""

                                   DO SKEY

                               End DoDot:2

                               IF ABM("OL")=""

                                   QUIT 

 +9                    IF ABM("OL")'=""

                           DO SKEY

                           QUIT 

                   End DoDot:1

                   IF ABM("O")

                       QUIT 

 +10       IF ABM("R")=""

               QUIT 

           IF $PIECE($GET(^AUTNINS(DA,4)),U)=""

               SET ABM("X")=""

 +11       IF ABM("R")'=ABM("X")

               SET DR=".41////"_ABM("R")

               DO ^DIE

 +12       QUIT 

SKEY       IF ABM'="CO"

               IF ABM]""

                   IF $DATA(^AICDKWLC(ABM("L"),2,"B",ABM))

                       IF $DATA(^AICDKWLC(ABM("L"),2,$ORDER(^(ABM,0)),0))

                           SET ABM=$PIECE(^(0),U,2)

 +1        SET ABM("R")=ABM("R")_$SELECT(ABM("R")]"":" ",1:"")_ABM

 +2        QUIT