IBCEP5B ;ALB/TMP - EDI UTILITIES for prov ID ;29-SEP-00
;;2.0;INTEGRATED BILLING;**137,239,232,320,348,349,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
NEWID(IBFILE,IBINS,IBPRV,IBPTYP,IBIEN,IBF) ; Generic add prov id
; at both prov (file 355.9) and ins co levels (355.91)
; IBFILE = 355.9 or 355.91 - the file being edited
; IBINS = ien of ins co (36) or *ALL* for all ins co
; IBPRV = vp ien of billing prov
; IBPTYP = ien of prov type (file 355.97)
; IBIEN = ien of entry being added (req'd)
; IBF = 1 if deleting from ins-related options, "" from prov-related
N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,DTOUT,DUOUT,IBQ,IBCUND,IB3559,IB35591,Q,IBDR,IBID,AFT
S IB35591(.03)="",IBPTYP=$G(IBPTYP)
F Z=.04,.05,.03 D G:Z="" NEWQ
. I $S(Z'=.03:1,1:$S('$G(IBINS):0,1:$G(IBCUND))) D Q:Z=""
.. N DA
.. I Z'=.03 S DIR(0)=IBFILE_","_Z
.. I Z=.03 D
... S DIR(0)="PAO^355.95:AEMQ"
... S DIR("S")="I $O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,"_$G(IB3559(.04))_","_$G(IB3559(.05))_","_IBPTYP_",0))!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,"_$G(IB3559(.04))_",0,"_IBPTYP_",0)))"
... S DIR("S")=DIR("S")_"!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,0,"_$G(IB3559(.05))_","_IBPTYP_",0)))!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,0,0,"_IBPTYP_",0)))"
... S DIR("?",1)="Care unit describes areas of service and is assigned by the payer, if",DIR("?")=" applicable. Use Care Unit Maintenance to add or modify care units."
.. ;
.. I Z=.04,IBPRV["355.93",$$GET1^DIQ(355.93,+IBPRV,.02,"I")=1 D
... I $$GET1^DIQ(355.97,IBPTYP,.03,"I")="EI" S $P(DIR(0),U,3)="K:Y'=1 X",DIR("?")="Provider ID Qualifier selected only allows institutional (UB type) forms" Q
... I $$GET1^DIQ(355.97,IBPTYP,.03,"I")="TJ" S $P(DIR(0),U,3)="K:Y'=2 X",DIR("?")="Provider ID Qualifier selected only allows professional (CMS-1500) forms" Q
... ;IA# 2056;IB*2.0*592
... N AFT
... S AFT=$$GET1^DIQ(355.97,IBPTYP,.07,"I") ; get allowable form type for this Provider ID Type
... I AFT="B" S $P(DIR(0),U,3)="K:"".0.1.2.4.""'[("".""_Y_""."") X",DIR("?")="Provider ID Qualifier selected allows institutional, professional or both" Q
... I AFT="P" S $P(DIR(0),U,3)="K:Y'=2 X",DIR("?")="Provider ID Qualifier selected only allows professional (CMS-1500) forms" Q
... I AFT="I" S $P(DIR(0),U,3)="K:Y'=1 X",DIR("?")="Provider ID Qualifier selected only allows institutional (UB type) forms" Q
.. ;
.. S DA=0
.. I Z=.04,$P($G(^IBE(355.97,+IBPTYP,0)),U,3)="1A" D SETDIR(.DIR)
.. D ^DIR K DIR
.. I $D(DTOUT)!$D(DUOUT) S Z="" K IB3559,IB35591 Q
.. S IB3559(Z)=$S(Z'=.03:$P(Y,U),1:$S($P(Y,U)>0:$P(Y,U),1:"*N/A*"))
. I Z=.05 D
.. S IBCUND=$$CAREUN^IBCEP3(IBINS,IBPTYP,IB3559(.04),IB3559(.05),IB3559(.05)=3)
.. S:'IBCUND!($G(IB3559(.03))=0) IB3559(.03)="*N/A*"
.. I '$G(IBINS) S IBINS="*ALL*"
. I Z=.03 D CAREUN^IBCEP5C
;
I $D(IB3559) D
. N Q,Z2,Z3,Z4,Z5,Z6,IBLAST,IBOK,DIR,Y,X
. S IBLAST=0
. D DISP^IBCEP4("Q",IBINS,IBPTYP,IB3559(.04),IB3559(.05),1)
. W !!,"THE FOLLOWING WAS CHOSEN:"
. S Q=0 F S Q=$O(Q(Q)) Q:'Q W !,?3,Q(Q)
. I IBCUND W !,?3,"CARE UNIT: "_$$EXPAND^IBTRE(355.96,.01,IB3559(.03))
. S Z2=IBINS,Z3=IB35591(.03),Z4=IB3559(.04),Z5=IB3559(.05),Z6=IBPTYP
. S IBOK=1
. ; If both forms, chk for specific
. I 'Z4 S IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_4_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,1,$G(IBFILE)=355.91)
. ; If specific form, chk for all
. I IBOK,Z4 S IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_4_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,0,$G(IBFILE)=355.91)
. ; If both care types, chk for specific
. I IBOK,'Z5 S IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_5_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,1,$G(IBFILE)=355.91)
. ; If specific care type, chk for all
. I IBOK,Z5 S IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_5_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,0,$G(IBFILE)=355.91)
. I 'IBOK K IB3559,IB35591
. I IBOK D
.. S DIR(0)=IBFILE_",.07"
.. W ! D ^DIR K DIR
.. S IBID=Y
.. I $D(DTOUT)!$D(DUOUT) K IB3559,IB35591 S IBOK=0 Q
.. S IBDR=$S(IBFILE=355.9:$S($G(IBINS):".02////"_IBINS_";",1:""),1:"")_$S($G(IBCUND):".03////"_$S(IB35591(.03):IB35591(.03),1:"*N/A*")_";",1:"")_".04////"_IB3559(.04)_";.05////"_IB3559(.05)_";.06////"_IBPTYP_$S(IBID'="":";.07////"_IBID,1:"")
.. ;
.. I $G(IBIEN) D
... S DR=IBDR,DA=IBIEN,DIE="^IBA("_IBFILE_","
... D ^DIE
... I $D(Y) K IB3559,IB35591 S IBOK=0
;
NEWQ ;
I '$D(IB3559),$G(IBIEN) D Q
. N DIR,DIK,DA,X,Y
. S DA=IBIEN,DIK="^IBA("_IBFILE_"," D ^DIK
. S DIR(0)="EA",DIR("A",1)=$S('$G(IBOK):"",1:"PROBLEM ENCOUNTERED FILING THE RECORD - ")_"RECORD NOT ADDED",DIR("A")="PRESS ENTER to continue " W ! D ^DIR K DIR
;
; Save this for Copy ID actions
I $G(IBIEN) D
. I IBFILE=355.91!(IBFILE=355.9&($P($G(^IBA(IBFILE,IBIEN,0)),U)["VA(200,")) D
.. N NEXTONE S NEXTONE=$$NEXTONE^IBCEP5A()
.. S ^TMP("IB_EDITED_IDS",$J,NEXTONE)=IBIEN_U_"ADD"_U_IBFILE
.. S ^TMP("IB_EDITED_IDS",$J,NEXTONE,0)=$G(^IBA(IBFILE,IBIEN,0))
Q
;
CHG(IBFILE,IBDA) ; Generic call - edit prov id
; IBFILE = 355.9 or 355.91 (file being edited)
; IBDA = ien in file
;
N DIR,DIE,DA,DR,IBCUCHK,IBOK,IB0,IBOLD,X,Y,Z
F Z=1:1:3 L +^IBA(IBFILE,IBDA):5 Q:$T W !,"Attempting to lock record"
I '$T D G CHGQ
. W !,"RECORD LOCKED BY ANOTHER USER - TRY AGAIN LATER"
. D ENTER(.DIR)
. W ! D ^DIR K DIR W !
S (IB0,IBOLD)=$G(^IBA(IBFILE,IBDA,0))
G:IB0="" CHGQ
F Z=.04,.05,.06,.03 S IBOK=$$EDIT(IBFILE,Z,IB0,IBOLD,IBDA,0) S:IBOK="*ALL*" IBOK="" Q:$P(IBOK,U,2) S $P(IB0,U,Z*100)=$P(IBOK,U)
I $P(IBOK,U,2) S DIR(0)="EA",DIR("A")="NO CHANGES MADE, PRESS ENTER TO CONTINUE: " W ! D ^DIR K DIR W ! G CHGQ
S IBOK=$$EDIT(IBFILE,.07,IB0,IBOLD,IBDA,1)
I '$P(IBOK,U,2) S $P(IB0,U,7)=$P(IBOK,U)
I $P(IBOK,U,2)!(IB0=IBOLD) S DIR(0)="EA",DIR("A")="NO CHANGES MADE, PRESS ENTER TO CONTINUE: " W ! D ^DIR K DIR W ! G CHGQ
S IBCUCHK=$$CUCHK^IBCEP5C(IBDA,IB0) G:IBCUCHK CHGQ
S DR=""
F Z=2,4:1:7,3 I $P(IB0,U,Z)'=$P(IBOLD,U,Z) S DR=DR_$S(DR'="":";",1:"")_(Z/100)_"///"_$S($P(IB0,U,Z)'="@":"/",1:"")_$P(IB0,U,Z)
I DR'="" D
. I IBFILE=355.91!(IBFILE=355.9&($P(IB0,U)["VA(200,")) D
.. N NEXTONE
.. S NEXTONE=$$NEXTONE^IBCEP5A()
.. S ^TMP("IB_EDITED_IDS",$J,NEXTONE)=IBDA_U_"MOD"_U_IBFILE_U_IBDA
.. S ^TMP("IB_EDITED_IDS",$J,NEXTONE,"OLD0")=IBOLD
.. S ^TMP("IB_EDITED_IDS",$J,NEXTONE,0)=IB0
. S DIE="^IBA("_IBFILE_",",DA=IBDA D ^DIE
CHGQ L -^IBA(IBFILE,IBDA)
Q
;
DEL(IBFILE,IBDA,IBF) ; Delete prov specific ID's
; IBFILE = 355.9 or 355.91 for the file
; IBDA = ien of entry in file IBFILE
; IBF = 1 if deleting from ins co-related options, ""
; from prov-related options
D DEL^IBCEP5C(IBFILE,IBDA,$G(IBF))
Q
;
EDIT(IBFILE,IBFLD,IB0,IBOLD,IBIEN,IBCK1) ; Generic edit flds
Q $$EDIT^IBCEP5D($G(IBFILE),$G(IBFLD),$G(IB0),$G(IBOLD),$G(IBIEN),$G(IBCK1))
;
SETDIR(DIR) ; Sets dir for BLUE CROSS only UB-04 form type
S DIR("B")="UB-04",$P(DIR(0),U,3)="K:Y'=1 X",DIR("?")="ONLY UB-04 FORM TYPE IS VALID FOR BLUE CROSS ID"
Q
;
ENTER(DIR) ;
S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE: "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP5B 7020 printed Dec 13, 2024@02:11:40 Page 2
IBCEP5B ;ALB/TMP - EDI UTILITIES for prov ID ;29-SEP-00
+1 ;;2.0;INTEGRATED BILLING;**137,239,232,320,348,349,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
NEWID(IBFILE,IBINS,IBPRV,IBPTYP,IBIEN,IBF) ; Generic add prov id
+1 ; at both prov (file 355.9) and ins co levels (355.91)
+2 ; IBFILE = 355.9 or 355.91 - the file being edited
+3 ; IBINS = ien of ins co (36) or *ALL* for all ins co
+4 ; IBPRV = vp ien of billing prov
+5 ; IBPTYP = ien of prov type (file 355.97)
+6 ; IBIEN = ien of entry being added (req'd)
+7 ; IBF = 1 if deleting from ins-related options, "" from prov-related
+8 NEW DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,DTOUT,DUOUT,IBQ,IBCUND,IB3559,IB35591,Q,IBDR,IBID,AFT
+9 SET IB35591(.03)=""
SET IBPTYP=$GET(IBPTYP)
+10 FOR Z=.04,.05,.03
Begin DoDot:1
+11 IF $SELECT(Z'=.03:1,1:$SELECT('$GET(IBINS):0,1:$GET(IBCUND)))
Begin DoDot:2
+12 NEW DA
+13 IF Z'=.03
SET DIR(0)=IBFILE_","_Z
+14 IF Z=.03
Begin DoDot:3
+15 SET DIR(0)="PAO^355.95:AEMQ"
+16 SET DIR("S")="I $O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,"_$GET(IB3559(.04))_","_$GET(IB3559(.05))_","_IBPTYP_",0))!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,"_$GET(IB3559(.04))_",0,"_IBPTYP_",0)))"
+17 SET DIR("S")=DIR("S")_"!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,0,"_$GET(IB3559(.05))_","_IBPTYP_",0)))!($O(^IBA(355.96,""AUNIQ"","_IBINS_",Y,0,0,"_IBPTYP_",0)))"
+18 SET DIR("?",1)="Care unit describes areas of service and is assigned by the payer, if"
SET DIR("?")=" applicable. Use Care Unit Maintenance to add or modify care units."
End DoDot:3
+19 ;
+20 IF Z=.04
IF IBPRV["355.93"
IF $$GET1^DIQ(355.93,+IBPRV,.02,"I")=1
Begin DoDot:3
+21 IF $$GET1^DIQ(355.97,IBPTYP,.03,"I")="EI"
SET $PIECE(DIR(0),U,3)="K:Y'=1 X"
SET DIR("?")="Provider ID Qualifier selected only allows institutional (UB type) forms"
QUIT
+22 IF $$GET1^DIQ(355.97,IBPTYP,.03,"I")="TJ"
SET $PIECE(DIR(0),U,3)="K:Y'=2 X"
SET DIR("?")="Provider ID Qualifier selected only allows professional (CMS-1500) forms"
QUIT
+23 ;IA# 2056;IB*2.0*592
+24 NEW AFT
+25 ; get allowable form type for this Provider ID Type
SET AFT=$$GET1^DIQ(355.97,IBPTYP,.07,"I")
+26 IF AFT="B"
SET $PIECE(DIR(0),U,3)="K:"".0.1.2.4.""'[("".""_Y_""."") X"
SET DIR("?")="Provider ID Qualifier selected allows institutional, professional or both"
QUIT
+27 IF AFT="P"
SET $PIECE(DIR(0),U,3)="K:Y'=2 X"
SET DIR("?")="Provider ID Qualifier selected only allows professional (CMS-1500) forms"
QUIT
+28 IF AFT="I"
SET $PIECE(DIR(0),U,3)="K:Y'=1 X"
SET DIR("?")="Provider ID Qualifier selected only allows institutional (UB type) forms"
QUIT
End DoDot:3
+29 ;
+30 SET DA=0
+31 IF Z=.04
IF $PIECE($GET(^IBE(355.97,+IBPTYP,0)),U,3)="1A"
DO SETDIR(.DIR)
+32 DO ^DIR
KILL DIR
+33 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Z=""
KILL IB3559,IB35591
QUIT
+34 SET IB3559(Z)=$SELECT(Z'=.03:$PIECE(Y,U),1:$SELECT($PIECE(Y,U)>0:$PIECE(Y,U),1:"*N/A*"))
End DoDot:2
if Z=""
QUIT
+35 IF Z=.05
Begin DoDot:2
+36 SET IBCUND=$$CAREUN^IBCEP3(IBINS,IBPTYP,IB3559(.04),IB3559(.05),IB3559(.05)=3)
+37 if 'IBCUND!($GET(IB3559(.03))=0)
SET IB3559(.03)="*N/A*"
+38 IF '$GET(IBINS)
SET IBINS="*ALL*"
End DoDot:2
+39 IF Z=.03
DO CAREUN^IBCEP5C
End DoDot:1
if Z=""
GOTO NEWQ
+40 ;
+41 IF $DATA(IB3559)
Begin DoDot:1
+42 NEW Q,Z2,Z3,Z4,Z5,Z6,IBLAST,IBOK,DIR,Y,X
+43 SET IBLAST=0
+44 DO DISP^IBCEP4("Q",IBINS,IBPTYP,IB3559(.04),IB3559(.05),1)
+45 WRITE !!,"THE FOLLOWING WAS CHOSEN:"
+46 SET Q=0
FOR
SET Q=$ORDER(Q(Q))
if 'Q
QUIT
WRITE !,?3,Q(Q)
+47 IF IBCUND
WRITE !,?3,"CARE UNIT: "_$$EXPAND^IBTRE(355.96,.01,IB3559(.03))
+48 SET Z2=IBINS
SET Z3=IB35591(.03)
SET Z4=IB3559(.04)
SET Z5=IB3559(.05)
SET Z6=IBPTYP
+49 SET IBOK=1
+50 ; If both forms, chk for specific
+51 IF 'Z4
SET IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_4_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,1,$GET(IBFILE)=355.91)
+52 ; If specific form, chk for all
+53 IF IBOK
IF Z4
SET IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_4_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,0,$GET(IBFILE)=355.91)
+54 ; If both care types, chk for specific
+55 IF IBOK
IF 'Z5
SET IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_5_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,1,$GET(IBFILE)=355.91)
+56 ; If specific care type, chk for all
+57 IF IBOK
IF Z5
SET IBOK=$$COMBOK^IBCEP5C(IBFILE,IBPRV_U_5_U_Z2_U_Z3_U_Z4_U_Z5_U_Z6,0,$GET(IBFILE)=355.91)
+58 IF 'IBOK
KILL IB3559,IB35591
+59 IF IBOK
Begin DoDot:2
+60 SET DIR(0)=IBFILE_",.07"
+61 WRITE !
DO ^DIR
KILL DIR
+62 SET IBID=Y
+63 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL IB3559,IB35591
SET IBOK=0
QUIT
+64 SET IBDR=$SELECT(IBFILE=355.9:$SELECT(...
... $GET(IBINS):".02////"_IBINS_";",1:""),1:"")_$SELECT($GET(IBCUND):".03////"_$SELECT(IB35591(.03):IB35591(.03),1:"*N/A*")_";",1:"")_".04////"_IB3559(.04)_";.05////"_IB3559(.05)_";.06////"_IBPTYP_$SELECT(IBID'="":";.07////"_IBI
D,1:"")
+65 ;
+66 IF $GET(IBIEN)
Begin DoDot:3
+67 SET DR=IBDR
SET DA=IBIEN
SET DIE="^IBA("_IBFILE_","
+68 DO ^DIE
+69 IF $DATA(Y)
KILL IB3559,IB35591
SET IBOK=0
End DoDot:3
End DoDot:2
End DoDot:1
+70 ;
NEWQ ;
+1 IF '$DATA(IB3559)
IF $GET(IBIEN)
Begin DoDot:1
+2 NEW DIR,DIK,DA,X,Y
+3 SET DA=IBIEN
SET DIK="^IBA("_IBFILE_","
DO ^DIK
+4 SET DIR(0)="EA"
SET DIR("A",1)=$SELECT('$GET(IBOK):"",1:"PROBLEM ENCOUNTERED FILING THE RECORD - ")_"RECORD NOT ADDED"
SET DIR("A")="PRESS ENTER to continue "
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+5 ;
+6 ; Save this for Copy ID actions
+7 IF $GET(IBIEN)
Begin DoDot:1
+8 IF IBFILE=355.91!(IBFILE=355.9&($PIECE($GET(^IBA(IBFILE,IBIEN,0)),U)["VA(200,"))
Begin DoDot:2
+9 NEW NEXTONE
SET NEXTONE=$$NEXTONE^IBCEP5A()
+10 SET ^TMP("IB_EDITED_IDS",$JOB,NEXTONE)=IBIEN_U_"ADD"_U_IBFILE
+11 SET ^TMP("IB_EDITED_IDS",$JOB,NEXTONE,0)=$GET(^IBA(IBFILE,IBIEN,0))
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
CHG(IBFILE,IBDA) ; Generic call - edit prov id
+1 ; IBFILE = 355.9 or 355.91 (file being edited)
+2 ; IBDA = ien in file
+3 ;
+4 NEW DIR,DIE,DA,DR,IBCUCHK,IBOK,IB0,IBOLD,X,Y,Z
+5 FOR Z=1:1:3
LOCK +^IBA(IBFILE,IBDA):5
if $TEST
QUIT
WRITE !,"Attempting to lock record"
+6 IF '$TEST
Begin DoDot:1
+7 WRITE !,"RECORD LOCKED BY ANOTHER USER - TRY AGAIN LATER"
+8 DO ENTER(.DIR)
+9 WRITE !
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
GOTO CHGQ
+10 SET (IB0,IBOLD)=$GET(^IBA(IBFILE,IBDA,0))
+11 if IB0=""
GOTO CHGQ
+12 FOR Z=.04,.05,.06,.03
SET IBOK=$$EDIT(IBFILE,Z,IB0,IBOLD,IBDA,0)
if IBOK="*ALL*"
SET IBOK=""
if $PIECE(IBOK,U,2)
QUIT
SET $PIECE(IB0,U,Z*100)=$PIECE(IBOK,U)
+13 IF $PIECE(IBOK,U,2)
SET DIR(0)="EA"
SET DIR("A")="NO CHANGES MADE, PRESS ENTER TO CONTINUE: "
WRITE !
DO ^DIR
KILL DIR
WRITE !
GOTO CHGQ
+14 SET IBOK=$$EDIT(IBFILE,.07,IB0,IBOLD,IBDA,1)
+15 IF '$PIECE(IBOK,U,2)
SET $PIECE(IB0,U,7)=$PIECE(IBOK,U)
+16 IF $PIECE(IBOK,U,2)!(IB0=IBOLD)
SET DIR(0)="EA"
SET DIR("A")="NO CHANGES MADE, PRESS ENTER TO CONTINUE: "
WRITE !
DO ^DIR
KILL DIR
WRITE !
GOTO CHGQ
+17 SET IBCUCHK=$$CUCHK^IBCEP5C(IBDA,IB0)
if IBCUCHK
GOTO CHGQ
+18 SET DR=""
+19 FOR Z=2,4:1:7,3
IF $PIECE(IB0,U,Z)'=$PIECE(IBOLD,U,Z)
SET DR=DR_$SELECT(DR'="":";",1:"")_(Z/100)_"///"_$SELECT($PIECE(IB0,U,Z)'="@":"/",1:"")_$PIECE(IB0,U,Z)
+20 IF DR'=""
Begin DoDot:1
+21 IF IBFILE=355.91!(IBFILE=355.9&($PIECE(IB0,U)["VA(200,"))
Begin DoDot:2
+22 NEW NEXTONE
+23 SET NEXTONE=$$NEXTONE^IBCEP5A()
+24 SET ^TMP("IB_EDITED_IDS",$JOB,NEXTONE)=IBDA_U_"MOD"_U_IBFILE_U_IBDA
+25 SET ^TMP("IB_EDITED_IDS",$JOB,NEXTONE,"OLD0")=IBOLD
+26 SET ^TMP("IB_EDITED_IDS",$JOB,NEXTONE,0)=IB0
End DoDot:2
+27 SET DIE="^IBA("_IBFILE_","
SET DA=IBDA
DO ^DIE
End DoDot:1
CHGQ LOCK -^IBA(IBFILE,IBDA)
+1 QUIT
+2 ;
DEL(IBFILE,IBDA,IBF) ; Delete prov specific ID's
+1 ; IBFILE = 355.9 or 355.91 for the file
+2 ; IBDA = ien of entry in file IBFILE
+3 ; IBF = 1 if deleting from ins co-related options, ""
+4 ; from prov-related options
+5 DO DEL^IBCEP5C(IBFILE,IBDA,$GET(IBF))
+6 QUIT
+7 ;
EDIT(IBFILE,IBFLD,IB0,IBOLD,IBIEN,IBCK1) ; Generic edit flds
+1 QUIT $$EDIT^IBCEP5D($GET(IBFILE),$GET(IBFLD),$GET(IB0),$GET(IBOLD),$GET(IBIEN),$GET(IBCK1))
+2 ;
SETDIR(DIR) ; Sets dir for BLUE CROSS only UB-04 form type
+1 SET DIR("B")="UB-04"
SET $PIECE(DIR(0),U,3)="K:Y'=1 X"
SET DIR("?")="ONLY UB-04 FORM TYPE IS VALID FOR BLUE CROSS ID"
+2 QUIT
+3 ;
ENTER(DIR) ;
+1 SET DIR(0)="EA"
SET DIR("A")="PRESS ENTER TO CONTINUE: "
+2 QUIT
