- 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 Feb 18, 2025@23:38:03 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