IBCEP5A ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
;;2.0;INTEGRATED BILLING;**137,232,320,348,447,592**;21-MAR-94;Build 58
;
NEW(IBPRV,IBINS) ; Add new prov id
D FULL^VALM1
N DIC,DIR,X,Y,DA,DO,DD,DLAYGO,IBQ,IBIEN,IBPRV0,DTOUT,DUOUT,IBIF,IBSIC
S IBQ=0,IBPRV0=$S(IBPRV'["355.93":"",1:$G(^IBA(355.93,+IBPRV,0)))
;
; Only 5 secondary providers allowed for lab/facilities
S IBIF=$P(IBPRV0,U,2)
S IBSIC=$O(^TMP("IBPRV_",$J,"ZIDX",""),-1)
I IBIF=1,IBSIC>4 D G NEWQ
. S DIR(0)="EA",DIR("A",1)="A maximum of 5 secondary IDs are allowed for a lab/facility.",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR W !
;
S DIR(0)="PAr^355.97:AEMQ"
S DIR("A")="Enter Provider ID Qualifier: "
;JWS;IB*2.0*592 - corrected spelling error
S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
;
;S DIR("S")=$S($G(IBINS):"I ""04""[+$P($G(^(0)),U,2)",1:"I +$P($G(^(1)),U,7)&'$G(^(1))&$S($P(IBPRV0,U,2)'=1:1,1:$P(^(0),U,3)'=""SY"")")
I $G(IBINS) D
. I $P(IBPRV0,U,2)=1 S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; Lab or Facility ID provided by ins
. S DIR("S")="I $$RAINS^IBCEPU(Y)" Q ; Non VA Ind provided by ins
I '$G(IBINS) D
. I $P(IBPRV0,U,2)=1 D Q
.. I IBPRV["VA(200," S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; VA facility own IDS
.. S DIR("S")="I $$NVALFOWN^IBCEPU(Y)" Q ; Non -VA facility own
. S DIR("S")="I $$RAOWN^IBCEPU(Y)" ; FACILITY/GROUP;PROVIDER'S OWN PERSONAL NUMBER
;
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S IBQ=1 G NEWQ
I $P($G(^IBE(355.97,+Y,1)),U,3),IBPRV["355.93" D G NEWQ
. K DIE,DR
. S DIE="^IBA(355.93,",DA=+IBPRV
. ;S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !!,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
. ; Changed with IB*2.0*447 BI
. S DR="S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
. S DR=DR_"W !!,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";"
. S DR=DR_"@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,16),0)),U,2);.12"
. D ^DIE
. I '$D(Y) D BLD^IBCEP5
K IB3559(.06)
S IB3559(.06)=+Y
;
I $G(IBINS)'="NO",'$G(IBINS),'$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:IBQ NEWQ
. S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select the INSURANCE CO that is furnishing you with the provider ID"
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
. S IBINS=$S(Y>0:+Y,1:"")
S IB3559(.02)=$S($G(IBINS):IBINS,1:"*ALL*")
;
I '$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:'IBIEN NEWQ
. 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 Q
. S IBIEN=+Y
. D NEWID^IBCEP5B(355.9,IB3559(.02),IBPRV,IB3559(.06),IBIEN,1)
;
E D ; Provider-specific id stored outside of billing
. N DIR,X,Y,Z
. ; State License # is stored in file 200
. ; DEA# may not be edited in IB
. S Z=$G(^IBE(355.97,IB3559(.06),1))
. I +Z D Q
.. W ! S DIR(0)="EA",DIR("A",1)="DEA # CANNOT BE EDITED WITHIN THE BILLING SOFTWARE",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR W !
. I $P(Z,U,3) D
.. D PRVED(+IBPRV)
D BLD^IBCEP5
NEWQ K VALMBCK
S VALMBCK="R"
Q
;
DEL1 ; Delete Provider specific ID's
N IBDA,DA,DIE,DR
D FULL^VALM1
D SEL^IBCEP5(.IBDA)
G:'$O(IBDA(0)) DEL1Q
S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
G:'IBDA&($E($P(IBDA,U),1,3)'="LIC") DEL1Q
I IBDA>0 D DEL^IBCEP5B(355.9,IBDA,""),BLD^IBCEP5
E D ; check for state license
. Q:$E($P(IBDA,U),1,3)'="LIC"
. I $P(IBDA,U,2)["IBA(355.93" D
.. S DA=+$P(IBDA,U,2),DR=".12///@;.16///@",DIE="^IBA(355.93," D ^DIE
. E D
.. D PRVED(+$P(IBDA,U,2))
. D BLD^IBCEP5
DEL1Q S VALMBCK="R"
Q
;
CHG1 ; Edit Provider ID's
N IBDA,DIR,DA,DIE,DR,Z
D FULL^VALM1
D SEL^IBCEP5(.IBDA)
G:'$O(IBDA(0)) CHG1Q
S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
I IBDA>0 D
. D CHG^IBCEP5B(355.9,IBDA),BLD^IBCEP5
; check for state license
E D
. Q:$E($P(IBDA,U),1,3)'="LIC"
. I $P(IBDA,U,2)["IBA(355.93" D
.. S DA=+$P(IBDA,U,2),DIE="^IBA(355.93,"
.. ;S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
.. ; Changed with IB*2.0*447 BI
.. S DR=".16;S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
.. S DR=DR_"W !,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;"
.. S DR=DR_"W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,16),0)),U,2);.12"
.. D ^DIE
. E D
.. D PRVED(+$P(IBDA,U,2))
. D BLD^IBCEP5
CHG1Q S VALMBCK="R"
Q
;
PRVED(IBPRV) ; Maintain license #'s for VA provider ien IBPRV
S IBPRV=IBPRV_";VA(200,"
D EN^IBCEP5D
Q
;
COPYPROV(IBINS) ; Check if any ID's were edited and this is a parent insurance company
; IBINS = IEN into Insurance co file
;
Q:'$D(^TMP("IB_EDITED_IDS",$J))
K ^TMP("IB_EDITED_IDS",$J)
D COPY^IBCEPCID(IBINS)
Q
;
; Get the next number so that the edits can be replicated in order for other providers/insurance companies
NEXTONE() ;
Q $O(^TMP("IB_EDITED_IDS",$J,""),-1)+1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP5A 5382 printed Dec 13, 2024@02:11:39 Page 2
IBCEP5A ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
+1 ;;2.0;INTEGRATED BILLING;**137,232,320,348,447,592**;21-MAR-94;Build 58
+2 ;
NEW(IBPRV,IBINS) ; Add new prov id
+1 DO FULL^VALM1
+2 NEW DIC,DIR,X,Y,DA,DO,DD,DLAYGO,IBQ,IBIEN,IBPRV0,DTOUT,DUOUT,IBIF,IBSIC
+3 SET IBQ=0
SET IBPRV0=$SELECT(IBPRV'["355.93":"",1:$GET(^IBA(355.93,+IBPRV,0)))
+4 ;
+5 ; Only 5 secondary providers allowed for lab/facilities
+6 SET IBIF=$PIECE(IBPRV0,U,2)
+7 SET IBSIC=$ORDER(^TMP("IBPRV_",$JOB,"ZIDX",""),-1)
+8 IF IBIF=1
IF IBSIC>4
Begin DoDot:1
+9 SET DIR(0)="EA"
SET DIR("A",1)="A maximum of 5 secondary IDs are allowed for a lab/facility."
SET DIR("A")="PRESS ENTER TO CONTINUE "
DO ^DIR
KILL DIR
WRITE !
End DoDot:1
GOTO NEWQ
+10 ;
+11 SET DIR(0)="PAr^355.97:AEMQ"
+12 SET DIR("A")="Enter Provider ID Qualifier: "
+13 ;JWS;IB*2.0*592 - corrected spelling error
+14 SET DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
+15 ;
+16 ;S DIR("S")=$S($G(IBINS):"I ""04""[+$P($G(^(0)),U,2)",1:"I +$P($G(^(1)),U,7)&'$G(^(1))&$S($P(IBPRV0,U,2)'=1:1,1:$P(^(0),U,3)'=""SY"")")
+17 IF $GET(IBINS)
Begin DoDot:1
+18 ; Lab or Facility ID provided by ins
IF $PIECE(IBPRV0,U,2)=1
SET DIR("S")="I $$LFINS^IBCEPU(Y)"
QUIT
+19 ; Non VA Ind provided by ins
SET DIR("S")="I $$RAINS^IBCEPU(Y)"
QUIT
End DoDot:1
+20 IF '$GET(IBINS)
Begin DoDot:1
+21 IF $PIECE(IBPRV0,U,2)=1
Begin DoDot:2
+22 ; VA facility own IDS
IF IBPRV["VA(200,"
SET DIR("S")="I $$LFINS^IBCEPU(Y)"
QUIT
+23 ; Non -VA facility own
SET DIR("S")="I $$NVALFOWN^IBCEPU(Y)"
QUIT
End DoDot:2
QUIT
+24 ; FACILITY/GROUP;PROVIDER'S OWN PERSONAL NUMBER
SET DIR("S")="I $$RAOWN^IBCEPU(Y)"
End DoDot:1
+25 ;
+26 DO ^DIR
KILL DIR
+27 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBQ=1
GOTO NEWQ
+28 IF $PIECE($GET(^IBE(355.97,+Y,1)),U,3)
IF IBPRV["355.93"
Begin DoDot:1
+29 KILL DIE,DR
+30 SET DIE="^IBA(355.93,"
SET DA=+IBPRV
+31 ;S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !!,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
+32 ; Changed with IB*2.0*447 BI
+33 SET DR="S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
+34 SET DR=DR_"W !!,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";"
+35 SET DR=DR_"@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,16),0)),U,2);.12"
+36 DO ^DIE
+37 IF '$DATA(Y)
DO BLD^IBCEP5
End DoDot:1
GOTO NEWQ
+38 KILL IB3559(.06)
+39 SET IB3559(.06)=+Y
+40 ;
+41 IF $GET(IBINS)'="NO"
IF '$GET(IBINS)
IF '$PIECE($GET(^IBE(355.97,IB3559(.06),1)),U,8)
Begin DoDot:1
+42 SET DIR(0)="PA^DIC(36,:AEMQ"
SET DIR("A")="Select INSURANCE CO: "
SET DIR("?")="Select the INSURANCE CO that is furnishing you with the provider ID"
+43 DO ^DIR
KILL DIR
+44 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBQ=1
QUIT
+45 SET IBINS=$SELECT(Y>0:+Y,1:"")
End DoDot:1
if IBQ
GOTO NEWQ
+46 SET IB3559(.02)=$SELECT($GET(IBINS):IBINS,1:"*ALL*")
+47 ;
+48 IF '$PIECE($GET(^IBE(355.97,IB3559(.06),1)),U,8)
Begin DoDot:1
+49 SET DIC(0)="L"
SET DLAYGO=355.9
SET DIC="^IBA(355.9,"
SET X=IBPRV
+50 if $GET(IBINS)
SET DIC("DR")=".02////"_IBINS
+51 DO FILE^DICN
KILL DIC,DLAYGO,DD,DO
+52 IF Y'>0!$DATA(DUOUT)!$DATA(DTOUT)
SET IBIEN=0
QUIT
+53 SET IBIEN=+Y
+54 DO NEWID^IBCEP5B(355.9,IB3559(.02),IBPRV,IB3559(.06),IBIEN,1)
End DoDot:1
if 'IBIEN
GOTO NEWQ
+55 ;
+56 ; Provider-specific id stored outside of billing
IF '$TEST
Begin DoDot:1
+57 NEW DIR,X,Y,Z
+58 ; State License # is stored in file 200
+59 ; DEA# may not be edited in IB
+60 SET Z=$GET(^IBE(355.97,IB3559(.06),1))
+61 IF +Z
Begin DoDot:2
+62 WRITE !
SET DIR(0)="EA"
SET DIR("A",1)="DEA # CANNOT BE EDITED WITHIN THE BILLING SOFTWARE"
SET DIR("A")="PRESS ENTER TO CONTINUE "
DO ^DIR
KILL DIR
WRITE !
End DoDot:2
QUIT
+63 IF $PIECE(Z,U,3)
Begin DoDot:2
+64 DO PRVED(+IBPRV)
End DoDot:2
End DoDot:1
+65 DO BLD^IBCEP5
NEWQ KILL VALMBCK
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
DEL1 ; Delete Provider specific ID's
+1 NEW IBDA,DA,DIE,DR
+2 DO FULL^VALM1
+3 DO SEL^IBCEP5(.IBDA)
+4 if '$ORDER(IBDA(0))
GOTO DEL1Q
+5 SET IBDA=+$ORDER(IBDA(""))
SET IBDA=$GET(IBDA(IBDA))
+6 if 'IBDA&($EXTRACT($PIECE(IBDA,U),1,3)'="LIC")
GOTO DEL1Q
+7 IF IBDA>0
DO DEL^IBCEP5B(355.9,IBDA,"")
DO BLD^IBCEP5
+8 ; check for state license
IF '$TEST
Begin DoDot:1
+9 if $EXTRACT($PIECE(IBDA,U),1,3)'="LIC"
QUIT
+10 IF $PIECE(IBDA,U,2)["IBA(355.93"
Begin DoDot:2
+11 SET DA=+$PIECE(IBDA,U,2)
SET DR=".12///@;.16///@"
SET DIE="^IBA(355.93,"
DO ^DIE
End DoDot:2
+12 IF '$TEST
Begin DoDot:2
+13 DO PRVED(+$PIECE(IBDA,U,2))
End DoDot:2
+14 DO BLD^IBCEP5
End DoDot:1
DEL1Q SET VALMBCK="R"
+1 QUIT
+2 ;
CHG1 ; Edit Provider ID's
+1 NEW IBDA,DIR,DA,DIE,DR,Z
+2 DO FULL^VALM1
+3 DO SEL^IBCEP5(.IBDA)
+4 if '$ORDER(IBDA(0))
GOTO CHG1Q
+5 SET IBDA=+$ORDER(IBDA(""))
SET IBDA=$GET(IBDA(IBDA))
+6 IF IBDA>0
Begin DoDot:1
+7 DO CHG^IBCEP5B(355.9,IBDA)
DO BLD^IBCEP5
End DoDot:1
+8 ; check for state license
+9 IF '$TEST
Begin DoDot:1
+10 if $EXTRACT($PIECE(IBDA,U),1,3)'="LIC"
QUIT
+11 IF $PIECE(IBDA,U,2)["IBA(355.93"
Begin DoDot:2
+12 SET DA=+$PIECE(IBDA,U,2)
SET DIE="^IBA(355.93,"
+13 ;S DR="S Y=""@5"";@1;.07;@5;I $P($G(^IBA(355.93,DA,0)),U,7)'="""" S Y=""@2"";W !,""YOU MUST HAVE A STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,7),0)),U,2);.12"
+14 ; Changed with IB*2.0*447 BI
+15 SET DR=".16;S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
+16 SET DR=DR_"W !,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;"
+17 SET DR=DR_"W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,16),0)),U,2);.12"
+18 DO ^DIE
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 DO PRVED(+$PIECE(IBDA,U,2))
End DoDot:2
+21 DO BLD^IBCEP5
End DoDot:1
CHG1Q SET VALMBCK="R"
+1 QUIT
+2 ;
PRVED(IBPRV) ; Maintain license #'s for VA provider ien IBPRV
+1 SET IBPRV=IBPRV_";VA(200,"
+2 DO EN^IBCEP5D
+3 QUIT
+4 ;
COPYPROV(IBINS) ; Check if any ID's were edited and this is a parent insurance company
+1 ; IBINS = IEN into Insurance co file
+2 ;
+3 if '$DATA(^TMP("IB_EDITED_IDS",$JOB))
QUIT
+4 KILL ^TMP("IB_EDITED_IDS",$JOB)
+5 DO COPY^IBCEPCID(IBINS)
+6 QUIT
+7 ;
+8 ; Get the next number so that the edits can be replicated in order for other providers/insurance companies
NEXTONE() ;
+1 QUIT $ORDER(^TMP("IB_EDITED_IDS",$JOB,""),-1)+1
