IBCEP7C ;ALB/TMP - Functions for fac level PROVIDER ID MAINT ;11-07-00
;;2.0;INTEGRATED BILLING;**137,232,320,348,349,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
G AWAY
AWAY Q
;
; IBDA - IEN for file 355.92
; IBFUNC = "A"dd or "E"dit
FACFLDS(IBDA,IBINS,IBITYP,IBFORM,IBDIV,IBFUNC,IBCAREUN,IBEFTFL) ; Chk for dups on fac id fld combos
;
N IB,IBOK,DIC,DIR,X,Y,DTOUT,DUOUT,Z,Z0,DIE,DA,IBMAIN,IBQUIT,IBPARAM,IBCUF,IBDA0,IBCNTADD,I,IBLIMIT
;
S IBOK=0,IBDA0=""
I $G(IBDA) S IBDA0=$G(^IBA(355.92,IBDA,0))
S IBPARAM=$G(^TMP("IBCE_PRVFAC_MAINT_INS",$J))
S IBCUF=$S($P(IBDA0,U,3)]"":1,1:0) ; Care Unit Flag
;
I IBEFTFL="E",IBFUNC="A" D G:$D(DTOUT)!$D(DUOUT) FLDSQ
. K DIR
. S DIR("A")="Define Billing Provider Secondary IDs by Care Units? "
. S DIR("B")="No"
. S DIR(0)="YAO"
. S DIR("?",1)="Enter No to define a Billing Provider Secondary ID for the Division."
. S DIR("?",2)="Enter Yes to define a Billing Provider Secondary ID for a specific Care Unit."
. S DIR("?",3)="If no Care Unit is entered on Billing Screen 3, the Billing Provider"
. S DIR("?")="Secondary ID defined for the Division will be transmitted in the claim."
. D ^DIR
. S IBCUF=$G(Y) ; Care Unit Flag
;
; Get the Division
S IBMAIN=$$MAIN^IBCEP2B()
S IBDIV=0
I IBEFTFL="E"!(IBEFTFL="LF") D G:$D(DTOUT)!$D(DUOUT) FLDSQ
. K DIR
. S (IBQUIT,IBOK)=0,DA=$G(IBDA)
. S DIR("A")="Division: ",DIR(0)="355.92,.05AOr"
. ; Default Division - Main if adding or Existing if editing
. I IBFUNC="E" S DIR("B")=$P($$DIV^IBCEP7($P(IBDA0,U,5)),"/")
. I IBFUNC="A" S DIR("B")=$P($$EXTERNAL^DILFD(355.92,.05,"",IBMAIN),"/")
. D ^DIR K DIR
. Q:$D(DTOUT)!$D(DUOUT)
. S IBDIV=+$S(Y>0:+Y,1:0)
;
; See if there are any Care Units
S IBCAREUN="*N/A*"
I IBEFTFL="E",IBCUF D
. N TAR
. D LIST^DIC(355.95,,.01,,,,,,"I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",,"TAR")
. Q:+$G(TAR("DILIST",0))
. S IBCUF=0
. W !!,"There are no Care Units defined for this Division.",!
;
; Get the Care Unit
I IBEFTFL="E",IBCUF D I Y<1 G FLDSQ
. K DIC
. S DIC("A")="Care Unit: "
. I IBFUNC="E" D ; default only if editing
.. Q:IBDIV'=$P(IBDA0,U,5) ; don't default if division has changed
.. S DIC("B")=$$EXTERNAL^DILFD(355.92,.03,"",$P(IBDA0,U,3))
. S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
. D ^DIC
. I Y>0 S IBCAREUN=+Y
;
; Think this is done for sorting purposes. Makes the main division first
I IBDIV=IBMAIN S IBDIV=0
;
; Get the Provider ID Type
K DIR
S IBQUIT=0
I $P(IBPARAM,U,3)'=1 D
. S DIR("?")="Can NOT be State LIC # or Billing Facility Primary"
. S DIR("A")="ID Qualifier: "
. S DIR(0)="355.92,.06A^^K:'$$FACID^IBCEP7(+Y)!$P($G(^IBE(355.97,+Y,1)),U,9)!($P($G(^(0)),U,3)=""0B"") X"
. W ! D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S IBQUIT=1
E D G:$D(DTOUT)!$D(DUOUT) FLDSQ
. S DIR("A")="ID Qualifier: " ;,DIR(0)="355.92,.06Ar"
. S DIR(0)="PAr^355.97:AEMQ"
. S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
. ; Default Type of ID - Electronic Plan Type if adding or Existing if editing
. N PITIEN S PITIEN=$S(IBFUNC="A"&(IBEFTFL="E"):$$BF^IBCU(),IBFUNC="E":$P(IBDA0,U,6),1:"")
. I PITIEN]"" S DIR("B")=$P($G(^IBE(355.97,PITIEN,0)),U)
. I IBEFTFL="E" D
.. S DIR("?",1)=" The current default ID Qualifier is based upon the Electronic Plan Type."
.. S DIR("?",2)=" You may change the ID Qualifier and the change will apply to all Plan"
.. S DIR("?")=" Types."
.. S DIR("S")="I ($P($G(^(0)),U,3)=$P($G(^IBE(355.97,PITIEN,0)),U,3))!$$BPS^IBCEPU(Y)"
. I IBEFTFL="A" S DIR("S")="I $$BPS^IBCEPU(Y)"
. I IBEFTFL="LF" S DIR("S")="I $$LFINS^IBCEPU(Y)"
. D ^DIR K DIR
G:IBQUIT FLDSQ
S IBITYP=$P(Y,U)
;
; Get Form Type
K DIR
S DIR("A")="Form Type: "
S DIR(0)=$S(IBEFTFL="LF":"SA^0:BOTH;1:UB-04;2:CMS-1500",1:"SA^1:UB-04;2:CMS-1500")
I $G(IBDA) S DIR("B")=$S(+$P($G(^IBA(355.92,IBDA,0)),U,4)=0:"BOTH",1:$P("UB-04^CMS-1500",U,+$P($G(^IBA(355.92,IBDA,0)),U,4)))
D ^DIR K DIR
G:$D(DTOUT)!$D(DUOUT) FLDSQ
S IBFORM=$P(Y,U)
;
; Set up array of exisiting IDs by form type, divison, and care units to avoid duplications
S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D
. S Z0=$G(^IBA(355.92,Z,0))
. I '(IBFUNC="E"&(Z=IBDA)) D
.. I IBEFTFL="LF",$P(Z0,U,8)'="LF" Q ; If lab/facility ID, it only needs to be unique among lab/facility IDs
.. I IBEFTFL'="LF",$P(Z0,U,8)="LF" Q ; If not lab/facility ID, it must be unigue for the others (secondary and additional)
.. I IBEFTFL="A",$P(Z0,U,8)="E" Q
.. I $P(Z0,U,8)="E",IBEFTFL'="A" S IB("*N/A*",$P(Z0,U,4),+$P(Z0,U,5),$S($P(Z0,U,3)]"":$P(Z0,U,3),1:"*N/A*"))=Z
.. S IB($P(Z0,U,6),$P(Z0,U,4),+$P(Z0,U,5),$S($P(Z0,U,3)]"":$P(Z0,U,3),1:"*N/A*"))=Z
. ;
. ; count them
. I IBFUNC="A",$P(Z0,U,8)=IBEFTFL,IBDIV=$P(Z0,U,5)!(IBDIV=0&($P(Z0,U,5)="")) D
.. I ".1.2."[("."_$P(Z0,U,4)_".") S IBCNTADD($P(Z0,U,4))=$G(IBCNTADD($P(Z0,U,4)))+1 Q
.. N I
.. F I=1,2 S IBCNTADD(I)=$G(IBCNTADD(I))+1
; Check for duplications
S IBOK=1
; Don't check if nothing is being changed. The ID itself can be changed after return to calling program.
I IBFUNC="E" S Z0=$G(^IBA(355.92,IBDA,0)) I $P(Z0,U,3)=IBCAREUN!($P(Z0,U,3)=""&(IBCAREUN="*N/A*")),IBFORM=$P(Z0,U,4),IBDIV=$P(Z0,U,5),IBITYP=$P(Z0,U,6) G FLDSQ
I $G(IB($S(IBEFTFL="E":"*N/A*",1:IBITYP),IBFORM,IBDIV,IBCAREUN)) D
. N Z,ZPC8 S Z=$G(IB($S(IBEFTFL="E":"*N/A*",1:IBITYP),IBFORM,IBDIV,IBCAREUN))
. S ZPC8=""
. I +Z S ZPC8=$P($G(^IBA(355.92,Z,0)),U,8)
. S IBOK="0^DUPLICATE"_U_ZPC8
I IBOK,IBFORM=0,$S($D(IB($S(IBEFTFL="E":"*N/A*",1:IBITYP),1,IBDIV,IBCAREUN))!$D(IB($S(IBEFTFL="E":"*N/A*",1:IBITYP),2,IBDIV,IBCAREUN)):1,1:0) S IBOK="0^FORM^SPECIFIC"
I IBOK,IBFORM'=0,IBFORM'=3,$S($D(IB($S(IBEFTFL="E":"*N/A*",1:IBITYP),0,IBDIV,IBCAREUN)):1,1:0) S IBOK="0^FORM^BOTH"
;
S IBLIMIT=$S(IBEFTFL="A":6,IBEFTFL="LF":5,1:"")
I IBOK,IBFUNC="A",IBEFTFL'="E" D
. I ".1.2."[("."_IBFORM_".") D Q
.. I $G(IBCNTADD(IBFORM))>(IBLIMIT-1) S IBOK="0^LIMIT"
. N I
. I IBFORM=0 F I=1,2 I $G(IBCNTADD(I))>IBLIMIT S IBOK="0^LIMIT" Q
;
I 'IBOK D
. I $P(IBOK,U,2)="DUPLICATE" D Q
.. S DIR("A",1)="This ID combination is already defined",DIR("A",2)=""
.. ; under "_$S($P(IBOK,U,3)="A":" Additional IDs",$P(IBOK,U,3)="E":"Billing Provider Secondary ID",1:"VA Lab/Facility IDs")_$S(IBFUNC="A":" - try editing it instead",1:""),DIR("A",2)=" "
. ;
. I $P(IBOK,U,2)="BOTH" D Q
.. S DIR("A",1)="An ID combination for both form types already exists. Delete this one",DIR("A",2)="before defining a form specific ID"_$S(IBDIV:" for this division"),DIR("A",4)=" "
. ;
. I $P(IBOK,U,2)="FORM" D Q
.. I $P(IBOK,U,3)="BOTH" S DIR("A",1)="This ID already exists for both form types - Delete it to enter this ID for",DIR("A",2)=" a specific form type",DIR("A",3)=" " Q
.. S DIR("A",1)="This ID already exists for a specific form type - Delete specific form type",DIR("A",2)=" ID(s) before entering one for both form types",DIR("A",3)=" "
. ;
. I $P(IBOK,U,2)="LIMIT" D Q
.. S DIR("A",1)="Limit is "_IBLIMIT_" IDs for each form type",DIR("A",2)=" "
.. I IBEFTFL="A" D
... S DIR("A",1)="A maximum of 6 Additional Billing Provider Sec IDs can be entered for each Form"
... S DIR("A",2)="Type. Before you can add another ID, you must delete an existing ID."
... S DIR("A",3)=" "
;
I 'IBOK S DIR(0)="EA",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
;
FLDSQ Q +IBOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP7C 7561 printed Dec 13, 2024@02:11:46 Page 2
IBCEP7C ;ALB/TMP - Functions for fac level PROVIDER ID MAINT ;11-07-00
+1 ;;2.0;INTEGRATED BILLING;**137,232,320,348,349,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 GOTO AWAY
AWAY QUIT
+1 ;
+2 ; IBDA - IEN for file 355.92
+3 ; IBFUNC = "A"dd or "E"dit
FACFLDS(IBDA,IBINS,IBITYP,IBFORM,IBDIV,IBFUNC,IBCAREUN,IBEFTFL) ; Chk for dups on fac id fld combos
+1 ;
+2 NEW IB,IBOK,DIC,DIR,X,Y,DTOUT,DUOUT,Z,Z0,DIE,DA,IBMAIN,IBQUIT,IBPARAM,IBCUF,IBDA0,IBCNTADD,I,IBLIMIT
+3 ;
+4 SET IBOK=0
SET IBDA0=""
+5 IF $GET(IBDA)
SET IBDA0=$GET(^IBA(355.92,IBDA,0))
+6 SET IBPARAM=$GET(^TMP("IBCE_PRVFAC_MAINT_INS",$JOB))
+7 ; Care Unit Flag
SET IBCUF=$SELECT($PIECE(IBDA0,U,3)]"":1,1:0)
+8 ;
+9 IF IBEFTFL="E"
IF IBFUNC="A"
Begin DoDot:1
+10 KILL DIR
+11 SET DIR("A")="Define Billing Provider Secondary IDs by Care Units? "
+12 SET DIR("B")="No"
+13 SET DIR(0)="YAO"
+14 SET DIR("?",1)="Enter No to define a Billing Provider Secondary ID for the Division."
+15 SET DIR("?",2)="Enter Yes to define a Billing Provider Secondary ID for a specific Care Unit."
+16 SET DIR("?",3)="If no Care Unit is entered on Billing Screen 3, the Billing Provider"
+17 SET DIR("?")="Secondary ID defined for the Division will be transmitted in the claim."
+18 DO ^DIR
+19 ; Care Unit Flag
SET IBCUF=$GET(Y)
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO FLDSQ
+20 ;
+21 ; Get the Division
+22 SET IBMAIN=$$MAIN^IBCEP2B()
+23 SET IBDIV=0
+24 IF IBEFTFL="E"!(IBEFTFL="LF")
Begin DoDot:1
+25 KILL DIR
+26 SET (IBQUIT,IBOK)=0
SET DA=$GET(IBDA)
+27 SET DIR("A")="Division: "
SET DIR(0)="355.92,.05AOr"
+28 ; Default Division - Main if adding or Existing if editing
+29 IF IBFUNC="E"
SET DIR("B")=$PIECE($$DIV^IBCEP7($PIECE(IBDA0,U,5)),"/")
+30 IF IBFUNC="A"
SET DIR("B")=$PIECE($$EXTERNAL^DILFD(355.92,.05,"",IBMAIN),"/")
+31 DO ^DIR
KILL DIR
+32 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+33 SET IBDIV=+$SELECT(Y>0:+Y,1:0)
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO FLDSQ
+34 ;
+35 ; See if there are any Care Units
+36 SET IBCAREUN="*N/A*"
+37 IF IBEFTFL="E"
IF IBCUF
Begin DoDot:1
+38 NEW TAR
+39 DO LIST^DIC(355.95,,.01,,,,,,"I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",,"TAR")
+40 if +$GET(TAR("DILIST",0))
QUIT
+41 SET IBCUF=0
+42 WRITE !!,"There are no Care Units defined for this Division.",!
End DoDot:1
+43 ;
+44 ; Get the Care Unit
+45 IF IBEFTFL="E"
IF IBCUF
Begin DoDot:1
+46 KILL DIC
+47 SET DIC("A")="Care Unit: "
+48 ; default only if editing
IF IBFUNC="E"
Begin DoDot:2
+49 ; don't default if division has changed
if IBDIV'=$PIECE(IBDA0,U,5)
QUIT
+50 SET DIC("B")=$$EXTERNAL^DILFD(355.92,.03,"",$PIECE(IBDA0,U,3))
End DoDot:2
+51 SET DIC=355.95
SET DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)"
SET DIC(0)="AEMQ"
+52 DO ^DIC
+53 IF Y>0
SET IBCAREUN=+Y
End DoDot:1
IF Y<1
GOTO FLDSQ
+54 ;
+55 ; Think this is done for sorting purposes. Makes the main division first
+56 IF IBDIV=IBMAIN
SET IBDIV=0
+57 ;
+58 ; Get the Provider ID Type
+59 KILL DIR
+60 SET IBQUIT=0
+61 IF $PIECE(IBPARAM,U,3)'=1
Begin DoDot:1
+62 SET DIR("?")="Can NOT be State LIC # or Billing Facility Primary"
+63 SET DIR("A")="ID Qualifier: "
+64 SET DIR(0)="355.92,.06A^^K:'$$FACID^IBCEP7(+Y)!$P($G(^IBE(355.97,+Y,1)),U,9)!($P($G(^(0)),U,3)=""0B"") X"
+65 WRITE !
DO ^DIR
KILL DIR
+66 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBQUIT=1
End DoDot:1
+67 IF '$TEST
Begin DoDot:1
+68 ;,DIR(0)="355.92,.06Ar"
SET DIR("A")="ID Qualifier: "
+69 SET DIR(0)="PAr^355.97:AEMQ"
+70 SET DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
+71 ; Default Type of ID - Electronic Plan Type if adding or Existing if editing
+72 NEW PITIEN
SET PITIEN=$SELECT(IBFUNC="A"&(IBEFTFL="E"):$$BF^IBCU(),IBFUNC="E":$PIECE(IBDA0,U,6),1:"")
+73 IF PITIEN]""
SET DIR("B")=$PIECE($GET(^IBE(355.97,PITIEN,0)),U)
+74 IF IBEFTFL="E"
Begin DoDot:2
+75 SET DIR("?",1)=" The current default ID Qualifier is based upon the Electronic Plan Type."
+76 SET DIR("?",2)=" You may change the ID Qualifier and the change will apply to all Plan"
+77 SET DIR("?")=" Types."
+78 SET DIR("S")="I ($P($G(^(0)),U,3)=$P($G(^IBE(355.97,PITIEN,0)),U,3))!$$BPS^IBCEPU(Y)"
End DoDot:2
+79 IF IBEFTFL="A"
SET DIR("S")="I $$BPS^IBCEPU(Y)"
+80 IF IBEFTFL="LF"
SET DIR("S")="I $$LFINS^IBCEPU(Y)"
+81 DO ^DIR
KILL DIR
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO FLDSQ
+82 if IBQUIT
GOTO FLDSQ
+83 SET IBITYP=$PIECE(Y,U)
+84 ;
+85 ; Get Form Type
+86 KILL DIR
+87 SET DIR("A")="Form Type: "
+88 SET DIR(0)=$SELECT(IBEFTFL="LF":"SA^0:BOTH;1:UB-04;2:CMS-1500",1:"SA^1:UB-04;2:CMS-1500")
+89 IF $GET(IBDA)
SET DIR("B")=$SELECT(+$PIECE($GET(^IBA(355.92,IBDA,0)),U,4)=0:"BOTH",1:$PIECE("UB-04^CMS-1500",U,+$PIECE($GET(^IBA(355.92,IBDA,0)),U,4)))
+90 DO ^DIR
KILL DIR
+91 if $DATA(DTOUT)!$DATA(DUOUT)
GOTO FLDSQ
+92 SET IBFORM=$PIECE(Y,U)
+93 ;
+94 ; Set up array of exisiting IDs by form type, divison, and care units to avoid duplications
+95 SET Z=0
FOR
SET Z=$ORDER(^IBA(355.92,"B",IBINS,Z))
if 'Z
QUIT
Begin DoDot:1
+96 SET Z0=$GET(^IBA(355.92,Z,0))
+97 IF '(IBFUNC="E"&(Z=IBDA))
Begin DoDot:2
+98 ; If lab/facility ID, it only needs to be unique among lab/facility IDs
IF IBEFTFL="LF"
IF $PIECE(Z0,U,8)'="LF"
QUIT
+99 ; If not lab/facility ID, it must be unigue for the others (secondary and additional)
IF IBEFTFL'="LF"
IF $PIECE(Z0,U,8)="LF"
QUIT
+100 IF IBEFTFL="A"
IF $PIECE(Z0,U,8)="E"
QUIT
+101 IF $PIECE(Z0,U,8)="E"
IF IBEFTFL'="A"
SET IB("*N/A*",$PIECE(Z0,U,4),+$PIECE(Z0,U,5),$SELECT($PIECE(Z0,U,3)]"":$PIECE(Z0,U,3),1:"*N/A*"))=Z
+102 SET IB($PIECE(Z0,U,6),$PIECE(Z0,U,4),+$PIECE(Z0,U,5),$SELECT($PIECE(Z0,U,3)]"":$PIECE(Z0,U,3),1:"*N/A*"))=Z
End DoDot:2
+103 ;
+104 ; count them
+105 IF IBFUNC="A"
IF $PIECE(Z0,U,8)=IBEFTFL
IF IBDIV=$PIECE(Z0,U,5)!(IBDIV=0&($PIECE(Z0,U,5)=""))
Begin DoDot:2
+106 IF ".1.2."[("."_$PIECE(Z0,U,4)_".")
SET IBCNTADD($PIECE(Z0,U,4))=$GET(IBCNTADD($PIECE(Z0,U,4)))+1
QUIT
+107 NEW I
+108 FOR I=1,2
SET IBCNTADD(I)=$GET(IBCNTADD(I))+1
End DoDot:2
End DoDot:1
+109 ; Check for duplications
+110 SET IBOK=1
+111 ; Don't check if nothing is being changed. The ID itself can be changed after return to calling program.
+112 IF IBFUNC="E"
SET Z0=$GET(^IBA(355.92,IBDA,0))
IF $PIECE(Z0,U,3)=IBCAREUN!($PIECE(Z0,U,3)=""&(IBCAREUN="*N/A*"))
IF IBFORM=$PIECE(Z0,U,4)
IF IBDIV=$PIECE(Z0,U,5)
IF IBITYP=$PIECE(Z0,U,6)
GOTO FLDSQ
+113 IF $GET(IB($SELECT(IBEFTFL="E":"*N/A*",1:IBITYP),IBFORM,IBDIV,IBCAREUN))
Begin DoDot:1
+114 NEW Z,ZPC8
SET Z=$GET(IB($SELECT(IBEFTFL="E":"*N/A*",1:IBITYP),IBFORM,IBDIV,IBCAREUN))
+115 SET ZPC8=""
+116 IF +Z
SET ZPC8=$PIECE($GET(^IBA(355.92,Z,0)),U,8)
+117 SET IBOK="0^DUPLICATE"_U_ZPC8
End DoDot:1
+118 IF IBOK
IF IBFORM=0
IF $SELECT($DATA(IB($SELECT(IBEFTFL="E":"*N/A*",1:IBITYP),1,IBDIV,IBCAREUN))!$DATA(IB($SELECT(IBEFTFL="E":"*N/A*",1:IBITYP),2,IBDIV,IBCAREUN)):1,1:0)
SET IBOK="0^FORM^SPECIFIC"
+119 IF IBOK
IF IBFORM'=0
IF IBFORM'=3
IF $SELECT($DATA(IB($SELECT(IBEFTFL="E":"*N/A*",1:IBITYP),0,IBDIV,IBCAREUN)):1,1:0)
SET IBOK="0^FORM^BOTH"
+120 ;
+121 SET IBLIMIT=$SELECT(IBEFTFL="A":6,IBEFTFL="LF":5,1:"")
+122 IF IBOK
IF IBFUNC="A"
IF IBEFTFL'="E"
Begin DoDot:1
+123 IF ".1.2."[("."_IBFORM_".")
Begin DoDot:2
+124 IF $GET(IBCNTADD(IBFORM))>(IBLIMIT-1)
SET IBOK="0^LIMIT"
End DoDot:2
QUIT
+125 NEW I
+126 IF IBFORM=0
FOR I=1,2
IF $GET(IBCNTADD(I))>IBLIMIT
SET IBOK="0^LIMIT"
QUIT
End DoDot:1
+127 ;
+128 IF 'IBOK
Begin DoDot:1
+129 IF $PIECE(IBOK,U,2)="DUPLICATE"
Begin DoDot:2
+130 SET DIR("A",1)="This ID combination is already defined"
SET DIR("A",2)=""
+131 ; under "_$S($P(IBOK,U,3)="A":" Additional IDs",$P(IBOK,U,3)="E":"Billing Provider Secondary ID",1:"VA Lab/Facility IDs")_$S(IBFUNC="A":" - try editing it instead",1:""),DIR("A",2)=" "
End DoDot:2
QUIT
+132 ;
+133 IF $PIECE(IBOK,U,2)="BOTH"
Begin DoDot:2
+134 SET DIR("A",1)="An ID combination for both form types already exists. Delete this one"
SET DIR("A",2)="before defining a form specific ID"_$SELECT(IBDIV:" for this division")
SET DIR("A",4)=" "
End DoDot:2
QUIT
+135 ;
+136 IF $PIECE(IBOK,U,2)="FORM"
Begin DoDot:2
+137 IF $PIECE(IBOK,U,3)="BOTH"
SET DIR("A",1)="This ID already exists for both form types - Delete it to enter this ID for"
SET DIR("A",2)=" a specific form type"
SET DIR("A",3)=" "
QUIT
+138 SET DIR("A",1)="This ID already exists for a specific form type - Delete specific form type"
SET DIR("A",2)=" ID(s) before entering one for both form types"
SET DIR("A",3)=" "
End DoDot:2
QUIT
+139 ;
+140 IF $PIECE(IBOK,U,2)="LIMIT"
Begin DoDot:2
+141 SET DIR("A",1)="Limit is "_IBLIMIT_" IDs for each form type"
SET DIR("A",2)=" "
+142 IF IBEFTFL="A"
Begin DoDot:3
+143 SET DIR("A",1)="A maximum of 6 Additional Billing Provider Sec IDs can be entered for each Form"
+144 SET DIR("A",2)="Type. Before you can add another ID, you must delete an existing ID."
+145 SET DIR("A",3)=" "
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+146 ;
+147 IF 'IBOK
SET DIR(0)="EA"
SET DIR("A")="PRESS RETURN TO CONTINUE: "
WRITE !
DO ^DIR
KILL DIR
+148 ;
FLDSQ QUIT +IBOK
