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
