IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
;
NEW(IBINS,IBPRV,IBPTYP,IBDEF) ; Add new insurance co assigned id
; IBDEF = flag sent as 1 if only insurance co defaults are being added
N DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
D FULL^VALM1
S IBQ=0
I $G(IBDEF)="D" W !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
I '$G(IBPRV),$G(IBDEF)'="D" D G:IBQ NEWQ
. N DA,IBO
. S IBO=($G(IBDSP)'="I")
. S DIR(0)="355.9,.01A"_$S(IBO:"O",1:""),DIR("A")="Select PROVIDER"_$S(IBO:" (optional)",1:"")_": "
. S DIR("?")="Select the PROVIDER to be assigned a provider ID"
. I IBO S DIR("?",1)=DIR("?"),DIR("?")="Or Press ENTER to add an insurance co level default id (all providers)"
. W ! D ^DIR K DIR W !
. I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
. S IBPRV=$S(Y>0:$P(Y,U),1:"")
. Q:IBPRV
. S DIR(0)="YA",DIR("B")="YES",DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",DIR("A")="IS THIS OK?: "
. W ! D ^DIR K DIR W !
. I $D(DTOUT)!$D(DUOUT)!(Y'=1) S IBQ=1
. Q
;
I '$G(IBPTYP) D G:IBQ NEWQ
. S DIR(0)="PAr^355.97:AEMQ",DIR("A")="Select Provider ID Qualifier: "
. S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
. S DIR("S")="I $$RAINS^IBCEPU(Y)" ; Rendering/Attending IDs provided by ins
. S DA=0
. W ! D ^DIR K DIR W !
. I $D(DTOUT)!$D(DUOUT)!'Y S IBQ=1 Q
. S IBPTYP=+Y
;
S IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
;
NEWQ D:'$G(IBQ) BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
S VALMBCK="R"
Q
;
DEL1 ; Delete Insurance Co assigned provider ID's
; IBPRV = vp ien of provider if editing entry in file 355.9
; otherwise, null
N IB1,IBDA,IBFILE
D FULL^VALM1
D SEL^IBCEP0(.IBDA)
G:'$O(IBDA(0)) DEL1Q
S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
G:'IBDA DEL1Q
S IB1=$P(IBDA,U,2),IBDA=+IBDA
S IBFILE=$S(IB1:355.9,1:355.91)
I IBDA>0 D DEL^IBCEP5B(IBFILE,IBDA,1),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
;
DEL1Q S VALMBCK="R"
Q
;
CHG1 ; Edit Provider ID's
N IBDA,IB1,IBFILE
D FULL^VALM1
D SEL^IBCEP0(.IBDA)
G:'$O(IBDA(0)) CHG1Q
S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
G:'IBDA CHG1Q
S IB1=$P(IBDA,U,2),IBDA=+IBDA
S IBFILE=$S(IB1:355.9,1:355.91)
I IBDA>0 D
. I IBFILE=355.9 W !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
. I IBFILE'=355.9 W !!," <<INS CO DEFAULT>>"
. D CHG^IBCEP5B(IBFILE,IBDA),BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
;
CHG1Q S VALMBCK="R"
Q
;
PRVJMP(IBDSP) ; Navigate to a specific sort level in current LM list
; (from insurance co option)
; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
; ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
; Sets VALMBG = LINE # if a provider in list selected
;
I $G(IBDSP)="I" D PRVNJMP(.VALMBG)
I $G(IBDSP)="D"!($G(IBDSP)="A") D PRVTJMP(.VALMBG)
S VALMBCK="R"
Q
;
PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
; option)
;
N DIR,X,Y,DA
D FULL^VALM1
S DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
S DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***",DIR("?",2)=" ",DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT",DIR("?")=" PROVIDER"
S DIR("A")="SELECT PROVIDER: "
S DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
W ! D ^DIR K DIR W !
I Y>0,'$D(DTOUT),'$D(DUOUT) D
. N Z
. S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$P(Y,U))_U_$P(Y,U)))
. I Z S VALMBG=Z Q
. S DIR(0)="EA",DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY",DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
. W ! D ^DIR K DIR W !
Q
;
PRVTJMP(VALMBG) ; Navigate to a specific type of ID qualifier (from ins co option)
;
N DIR,X,Y
D FULL^VALM1
S DIR(0)="PAO^355.97:AEMQ",DIR("A")="Select type of ID Qualifier: "
S DIR("?")="Select a type of ID Qualifier to display the IDs of that type."
S DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
W ! D ^DIR K DIR W !
I Y>0,'$D(DTOUT),'$D(DUOUT) D
. N Z
. S Z=$G(^TMP("IBPRV_INS_ID",$J,"ZXPTYP",+Y))
. I Z S VALMBG=Z Q
. S DIR(0)="EA",DIR("A",1)="This type of ID Qualifier does not exist in the current display",DIR("A")="Press the Enter key to continue"
. W ! D ^DIR K DIR W !
Q
;
CHGINS ; Change insurance co being displayed, using the same or new params
; Assumes IBINS exists = IEN of insurance co (file 36)
N IBINEW,IBSAVE,DIC,DA,Y,X,DIR
D FULL^VALM1
S DIC="^DIC(36,",DIC(0)="AEMQ" D ^DIC
S IBINEW=+Y
;
I IBINEW>0,IBINS'=IBINEW D
. D COPYPROV^IBCEP5A(IBINS)
. S DIR(0)="YA",DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
. S DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: ",DIR("B")="YES" W ! D ^DIR W ! K DIR
. Q:Y'=1
. S IBSAVE("IBINS")=IBINS
. K ^TMP("IBPRV_INS_ID",$J),VALMHDR S VALMBG=1,IBINS=IBINEW
. I Y=1 D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT)) Q
. D INIT^IBCEP0
. I '$G(VALMQUIT) Q
. S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
S VALMBCK="R"
Q
;
CHGFMT ; Change format parameters for display
N IBSAVE
S IBSAVE("IBINS")=$G(IBINS)
D INIT^IBCEP0
I '$G(VALMQUIT) G CHGFMTQ
S IBINS=IBSAVE("IBINS") D BLD^IBCEP0($G(IBINS),$G(IBDSP),$G(IBSORT))
CHGFMTQ S VALMBCK="R"
Q
;
IPARAM ; Display Insurance co parameters and care unit requirements
; Assumes IBINS exists = IEN of insurance co
N IBDSP,IBSORT,IBHOLD
D FULL^VALM1
S IBHOLD("IBINS")=$G(IBINS)
D EN^VALM("IBCE PRVINS PARAM DISPLAY")
S:$G(IBHOLD("IBINS"))'="" IBINS=IBHOLD("IBINS")
K VALMQUIT
S VALMBCK="R"
Q
;
ADDID(IBINS,IBPRV,IBPTYP) ; Adds a new ID for the provider and/or ins co
; IBINS = ien of file 36
; IBPRV = vp ien of file 355.9
; IBPTYP = ien of file 355.97
; FUNCTION returns 1 if record not added, 0 if filed OK
N IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
S IBQ=0
I $G(IBPRV) D G:IBQ ADDIDQ
. ; Provider specific for insurance co - add to file 355.9
. S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
. S:$G(IBINS) DIC("DR")=".02////"_IBINS
. D FILE^DICN K DIC,DLAYGO,DD,DO
. I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
. S IBIEN=+Y
. D NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
E D
. ; Insurance co default - add to file 355.91
. S DIC(0)="L",DLAYGO=355.91,DIC="^IBA(355.91,",X=IBINS
. D FILE^DICN K DIC,DLAYGO,DD,DO
. I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0,IBQ=1 Q
. S IBIEN=+Y
. D NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
ADDIDQ Q IBQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP0A 6869 printed Apr 09, 2024@21:06:25 Page 2
IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
+1 ;;2.0;INTEGRATED BILLING;**137,232,320,377**;21-MAR-94;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
NEW(IBINS,IBPRV,IBPTYP,IBDEF) ; Add new insurance co assigned id
+1 ; IBDEF = flag sent as 1 if only insurance co defaults are being added
+2 NEW DIC,DIR,X,Y,Z,DA,DR,DIE,DO,DD,DLAYGO,IBQ,IBIEN,IBCUND,DTOUT,DUOUT
+3 DO FULL^VALM1
+4 SET IBQ=0
+5 IF $GET(IBDEF)="D"
WRITE !!,"YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT",!
+6 IF '$GET(IBPRV)
IF $GET(IBDEF)'="D"
Begin DoDot:1
+7 NEW DA,IBO
+8 SET IBO=($GET(IBDSP)'="I")
+9 SET DIR(0)="355.9,.01A"_$SELECT(IBO:"O",1:"")
SET DIR("A")="Select PROVIDER"_$SELECT(IBO:" (optional)",1:"")_": "
+10 SET DIR("?")="Select the PROVIDER to be assigned a provider ID"
+11 IF IBO
SET DIR("?",1)=DIR("?")
SET DIR("?")="Or Press ENTER to add an insurance co level default id (all providers)"
+12 WRITE !
DO ^DIR
KILL DIR
WRITE !
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBQ=1
QUIT
+14 SET IBPRV=$SELECT(Y>0:$PIECE(Y,U),1:"")
+15 if IBPRV
QUIT
+16 SET DIR(0)="YA"
SET DIR("B")="YES"
SET DIR("A",1)="YOU ARE ADDING A PROVIDER ID THAT WILL BE THE INSURANCE CO DEFAULT"
SET DIR("A")="IS THIS OK?: "
+17 WRITE !
DO ^DIR
KILL DIR
WRITE !
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y'=1)
SET IBQ=1
+19 QUIT
End DoDot:1
if IBQ
GOTO NEWQ
+20 ;
+21 IF '$GET(IBPTYP)
Begin DoDot:1
+22 SET DIR(0)="PAr^355.97:AEMQ"
SET DIR("A")="Select Provider ID Qualifier: "
+23 SET DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
+24 ; Rendering/Attending IDs provided by ins
SET DIR("S")="I $$RAINS^IBCEPU(Y)"
+25 SET DA=0
+26 WRITE !
DO ^DIR
KILL DIR
WRITE !
+27 IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET IBQ=1
QUIT
+28 SET IBPTYP=+Y
End DoDot:1
if IBQ
GOTO NEWQ
+29 ;
+30 SET IBQ=$$ADDID(IBINS,IBPRV,IBPTYP)
+31 ;
NEWQ if '$GET(IBQ)
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
DEL1 ; Delete Insurance Co assigned provider ID's
+1 ; IBPRV = vp ien of provider if editing entry in file 355.9
+2 ; otherwise, null
+3 NEW IB1,IBDA,IBFILE
+4 DO FULL^VALM1
+5 DO SEL^IBCEP0(.IBDA)
+6 if '$ORDER(IBDA(0))
GOTO DEL1Q
+7 SET IBDA=+$ORDER(IBDA(""))
SET IBDA=$GET(IBDA(IBDA))
+8 if 'IBDA
GOTO DEL1Q
+9 SET IB1=$PIECE(IBDA,U,2)
SET IBDA=+IBDA
+10 SET IBFILE=$SELECT(IB1:355.9,1:355.91)
+11 IF IBDA>0
DO DEL^IBCEP5B(IBFILE,IBDA,1)
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
+12 ;
DEL1Q SET VALMBCK="R"
+1 QUIT
+2 ;
CHG1 ; Edit Provider ID's
+1 NEW IBDA,IB1,IBFILE
+2 DO FULL^VALM1
+3 DO SEL^IBCEP0(.IBDA)
+4 if '$ORDER(IBDA(0))
GOTO CHG1Q
+5 SET IBDA=+$ORDER(IBDA(""))
SET IBDA=$GET(IBDA(IBDA))
+6 if 'IBDA
GOTO CHG1Q
+7 SET IB1=$PIECE(IBDA,U,2)
SET IBDA=+IBDA
+8 SET IBFILE=$SELECT(IB1:355.9,1:355.91)
+9 IF IBDA>0
Begin DoDot:1
+10 IF IBFILE=355.9
WRITE !!,"PROVIDER: ",$$EXPAND^IBTRE(355.9,.01,IB1)
+11 IF IBFILE'=355.9
WRITE !!," <<INS CO DEFAULT>>"
+12 DO CHG^IBCEP5B(IBFILE,IBDA)
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
End DoDot:1
+13 ;
CHG1Q SET VALMBCK="R"
+1 QUIT
+2 ;
PRVJMP(IBDSP) ; Navigate to a specific sort level in current LM list
+1 ; (from insurance co option)
+2 ; IBDSP = 'I', 'A' or 'D' to indicate format selected for display
+3 ; ([P]ROVIDER, PROVIDER [T]YPE OR [I]NSURANCE DEFAULT)
+4 ; Sets VALMBG = LINE # if a provider in list selected
+5 ;
+6 IF $GET(IBDSP)="I"
DO PRVNJMP(.VALMBG)
+7 IF $GET(IBDSP)="D"!($GET(IBDSP)="A")
DO PRVTJMP(.VALMBG)
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
PRVNJMP(VALMBG) ; Navigate to a specific provider name (from insurance co
+1 ; option)
+2 ;
+3 NEW DIR,X,Y,DA
+4 DO FULL^VALM1
+5 SET DIR(0)="355.9,.01AO^^I '$D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Y)_U_$P(Y,U))) K X"
+6 SET DIR("?",1)="*** YOU MAY ONLY SELECT PROVIDERS INCLUDED IN THE CURRENT LIST ***"
SET DIR("?",2)=" "
SET DIR("?",3)="SELECTING A PROVIDER WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR THAT"
SET DIR("?")=" PROVIDER"
+7 SET DIR("A")="SELECT PROVIDER: "
+8 SET DIR("S")="N Z S Z=$P(^(0),U) I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPRV"",U_$$EXPAND^IBTRE(355.9,.01,Z)_U_Z))"
+9 WRITE !
DO ^DIR
KILL DIR
WRITE !
+10 IF Y>0
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
Begin DoDot:1
+11 NEW Z
+12 SET Z=$GET(^TMP("IBPRV_INS_ID",$JOB,"ZXPRV",U_$$EXPAND^IBTRE(355.9,.01,$PIECE(Y,U))_U_$PIECE(Y,U)))
+13 IF Z
SET VALMBG=Z
QUIT
+14 SET DIR(0)="EA"
SET DIR("A",1)="THIS PROVIDER DOES NOT EXIST IN THE CURRENT DISPLAY"
SET DIR("A")="PRESS THE ENTER KEY TO CONTINUE"
+15 WRITE !
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
+16 QUIT
+17 ;
PRVTJMP(VALMBG) ; Navigate to a specific type of ID qualifier (from ins co option)
+1 ;
+2 NEW DIR,X,Y
+3 DO FULL^VALM1
+4 SET DIR(0)="PAO^355.97:AEMQ"
SET DIR("A")="Select type of ID Qualifier: "
+5 SET DIR("?")="Select a type of ID Qualifier to display the IDs of that type."
+6 SET DIR("S")="I $D(^TMP(""IBPRV_INS_ID"",$J,""ZXPTYP"",+Y))"
+7 WRITE !
DO ^DIR
KILL DIR
WRITE !
+8 IF Y>0
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
Begin DoDot:1
+9 NEW Z
+10 SET Z=$GET(^TMP("IBPRV_INS_ID",$JOB,"ZXPTYP",+Y))
+11 IF Z
SET VALMBG=Z
QUIT
+12 SET DIR(0)="EA"
SET DIR("A",1)="This type of ID Qualifier does not exist in the current display"
SET DIR("A")="Press the Enter key to continue"
+13 WRITE !
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
+14 QUIT
+15 ;
CHGINS ; Change insurance co being displayed, using the same or new params
+1 ; Assumes IBINS exists = IEN of insurance co (file 36)
+2 NEW IBINEW,IBSAVE,DIC,DA,Y,X,DIR
+3 DO FULL^VALM1
+4 SET DIC="^DIC(36,"
SET DIC(0)="AEMQ"
DO ^DIC
+5 SET IBINEW=+Y
+6 ;
+7 IF IBINEW>0
IF IBINS'=IBINEW
Begin DoDot:1
+8 DO COPYPROV^IBCEP5A(IBINS)
+9 SET DIR(0)="YA"
SET DIR("?")="IF YOU WANT TO CHANGE THE FORMAT OF THE DISPLAY, RESPOND NO HERE"
+10 SET DIR("A")="DO YOU WANT TO DISPLAY THE NEW INS. CO IDS USING THE CURRENT DISPLAY FORMAT?: "
SET DIR("B")="YES"
WRITE !
DO ^DIR
WRITE !
KILL DIR
+11 if Y'=1
QUIT
+12 SET IBSAVE("IBINS")=IBINS
+13 KILL ^TMP("IBPRV_INS_ID",$JOB),VALMHDR
SET VALMBG=1
SET IBINS=IBINEW
+14 IF Y=1
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
QUIT
+15 DO INIT^IBCEP0
+16 IF '$GET(VALMQUIT)
QUIT
+17 SET IBINS=IBSAVE("IBINS")
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
End DoDot:1
+18 SET VALMBCK="R"
+19 QUIT
+20 ;
CHGFMT ; Change format parameters for display
+1 NEW IBSAVE
+2 SET IBSAVE("IBINS")=$GET(IBINS)
+3 DO INIT^IBCEP0
+4 IF '$GET(VALMQUIT)
GOTO CHGFMTQ
+5 SET IBINS=IBSAVE("IBINS")
DO BLD^IBCEP0($GET(IBINS),$GET(IBDSP),$GET(IBSORT))
CHGFMTQ SET VALMBCK="R"
+1 QUIT
+2 ;
IPARAM ; Display Insurance co parameters and care unit requirements
+1 ; Assumes IBINS exists = IEN of insurance co
+2 NEW IBDSP,IBSORT,IBHOLD
+3 DO FULL^VALM1
+4 SET IBHOLD("IBINS")=$GET(IBINS)
+5 DO EN^VALM("IBCE PRVINS PARAM DISPLAY")
+6 if $GET(IBHOLD("IBINS"))'=""
SET IBINS=IBHOLD("IBINS")
+7 KILL VALMQUIT
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
ADDID(IBINS,IBPRV,IBPTYP) ; Adds a new ID for the provider and/or ins co
+1 ; IBINS = ien of file 36
+2 ; IBPRV = vp ien of file 355.9
+3 ; IBPTYP = ien of file 355.97
+4 ; FUNCTION returns 1 if record not added, 0 if filed OK
+5 NEW IBIEN,IBQ,DIC,DA,DO,DD,DLAYGO,X,Y
+6 SET IBQ=0
+7 IF $GET(IBPRV)
Begin DoDot:1
+8 ; Provider specific for insurance co - add to file 355.9
+9 SET DIC(0)="L"
SET DLAYGO=355.9
SET DIC="^IBA(355.9,"
SET X=IBPRV
+10 if $GET(IBINS)
SET DIC("DR")=".02////"_IBINS
+11 DO FILE^DICN
KILL DIC,DLAYGO,DD,DO
+12 IF Y'>0!$DATA(DUOUT)!$DATA(DTOUT)
SET IBIEN=0
SET IBQ=1
QUIT
+13 SET IBIEN=+Y
+14 DO NEWID^IBCEP5B(355.9,IBINS,IBPRV,IBPTYP,IBIEN,"")
End DoDot:1
if IBQ
GOTO ADDIDQ
+15 IF '$TEST
Begin DoDot:1
+16 ; Insurance co default - add to file 355.91
+17 SET DIC(0)="L"
SET DLAYGO=355.91
SET DIC="^IBA(355.91,"
SET X=IBINS
+18 DO FILE^DICN
KILL DIC,DLAYGO,DD,DO
+19 IF Y'>0!$DATA(DUOUT)!$DATA(DTOUT)
SET IBIEN=0
SET IBQ=1
QUIT
+20 SET IBIEN=+Y
+21 DO NEWID^IBCEP5B(355.91,IBINS,"",IBPTYP,IBIEN,1)
End DoDot:1
ADDIDQ QUIT IBQ
