Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEP5A

IBCEP5A.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. NEW(IBPRV,IBINS) ; Add new prov id
  1. D FULL^VALM1
  1. N DIC,DIR,X,Y,DA,DO,DD,DLAYGO,IBQ,IBIEN,IBPRV0,DTOUT,DUOUT,IBIF,IBSIC
  1. S IBQ=0,IBPRV0=$S(IBPRV'["355.93":"",1:$G(^IBA(355.93,+IBPRV,0)))
  1. ;
  1. ; Only 5 secondary providers allowed for lab/facilities
  1. S IBIF=$P(IBPRV0,U,2)
  1. S IBSIC=$O(^TMP("IBPRV_",$J,"ZIDX",""),-1)
  1. I IBIF=1,IBSIC>4 D G NEWQ
  1. . 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 !
  1. ;
  1. S DIR(0)="PAr^355.97:AEMQ"
  1. S DIR("A")="Enter Provider ID Qualifier: "
  1. ;JWS;IB*2.0*592 - corrected spelling error
  1. S DIR("?")="Enter a Qualifier to identify the type of ID number you are entering."
  1. ;
  1. ;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"")")
  1. I $G(IBINS) D
  1. . I $P(IBPRV0,U,2)=1 S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; Lab or Facility ID provided by ins
  1. . S DIR("S")="I $$RAINS^IBCEPU(Y)" Q ; Non VA Ind provided by ins
  1. I '$G(IBINS) D
  1. . I $P(IBPRV0,U,2)=1 D Q
  1. .. I IBPRV["VA(200," S DIR("S")="I $$LFINS^IBCEPU(Y)" Q ; VA facility own IDS
  1. .. S DIR("S")="I $$NVALFOWN^IBCEPU(Y)" Q ; Non -VA facility own
  1. . S DIR("S")="I $$RAOWN^IBCEPU(Y)" ; FACILITY/GROUP;PROVIDER'S OWN PERSONAL NUMBER
  1. ;
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) S IBQ=1 G NEWQ
  1. I $P($G(^IBE(355.97,+Y,1)),U,3),IBPRV["355.93" D G NEWQ
  1. . K DIE,DR
  1. . S DIE="^IBA(355.93,",DA=+IBPRV
  1. . ;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"
  1. . ; Changed with IB*2.0*447 BI
  1. . S DR="S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
  1. . S DR=DR_"W !!,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"",! S Y=""@1"";"
  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"
  1. . D ^DIE
  1. . I '$D(Y) D BLD^IBCEP5
  1. K IB3559(.06)
  1. S IB3559(.06)=+Y
  1. ;
  1. I $G(IBINS)'="NO",'$G(IBINS),'$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:IBQ NEWQ
  1. . 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"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S IBQ=1 Q
  1. . S IBINS=$S(Y>0:+Y,1:"")
  1. S IB3559(.02)=$S($G(IBINS):IBINS,1:"*ALL*")
  1. ;
  1. I '$P($G(^IBE(355.97,IB3559(.06),1)),U,8) D G:'IBIEN NEWQ
  1. . S DIC(0)="L",DLAYGO=355.9,DIC="^IBA(355.9,",X=IBPRV
  1. . S:$G(IBINS) DIC("DR")=".02////"_IBINS
  1. . D FILE^DICN K DIC,DLAYGO,DD,DO
  1. . I Y'>0!$D(DUOUT)!$D(DTOUT) S IBIEN=0 Q
  1. . S IBIEN=+Y
  1. . D NEWID^IBCEP5B(355.9,IB3559(.02),IBPRV,IB3559(.06),IBIEN,1)
  1. ;
  1. E D ; Provider-specific id stored outside of billing
  1. . N DIR,X,Y,Z
  1. . ; State License # is stored in file 200
  1. . ; DEA# may not be edited in IB
  1. . S Z=$G(^IBE(355.97,IB3559(.06),1))
  1. . I +Z D Q
  1. .. 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 !
  1. . I $P(Z,U,3) D
  1. .. D PRVED(+IBPRV)
  1. D BLD^IBCEP5
  1. NEWQ K VALMBCK
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DEL1 ; Delete Provider specific ID's
  1. N IBDA,DA,DIE,DR
  1. D FULL^VALM1
  1. D SEL^IBCEP5(.IBDA)
  1. G:'$O(IBDA(0)) DEL1Q
  1. S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
  1. G:'IBDA&($E($P(IBDA,U),1,3)'="LIC") DEL1Q
  1. I IBDA>0 D DEL^IBCEP5B(355.9,IBDA,""),BLD^IBCEP5
  1. E D ; check for state license
  1. . Q:$E($P(IBDA,U),1,3)'="LIC"
  1. . I $P(IBDA,U,2)["IBA(355.93" D
  1. .. S DA=+$P(IBDA,U,2),DR=".12///@;.16///@",DIE="^IBA(355.93," D ^DIE
  1. . E D
  1. .. D PRVED(+$P(IBDA,U,2))
  1. . D BLD^IBCEP5
  1. DEL1Q S VALMBCK="R"
  1. Q
  1. ;
  1. CHG1 ; Edit Provider ID's
  1. N IBDA,DIR,DA,DIE,DR,Z
  1. D FULL^VALM1
  1. D SEL^IBCEP5(.IBDA)
  1. G:'$O(IBDA(0)) CHG1Q
  1. S IBDA=+$O(IBDA("")),IBDA=$G(IBDA(IBDA))
  1. I IBDA>0 D
  1. . D CHG^IBCEP5B(355.9,IBDA),BLD^IBCEP5
  1. ; check for state license
  1. E D
  1. . Q:$E($P(IBDA,U),1,3)'="LIC"
  1. . I $P(IBDA,U,2)["IBA(355.93" D
  1. .. S DA=+$P(IBDA,U,2),DIE="^IBA(355.93,"
  1. .. ;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"
  1. .. ; Changed with IB*2.0*447 BI
  1. .. S DR=".16;S Y=""@5"";@1;.16;@5;I $P($G(^IBA(355.93,DA,0)),U,16)'="""" S Y=""@2"";"
  1. .. S DR=DR_"W !,""YOU MUST HAVE A LICENSE STATE TO USE LICENSE # AS AN ID!!"" S Y=""@1"";@2;"
  1. .. S DR=DR_"W !!,""LICENSING STATE: "",$P($G(^DIC(5,+$P($G(^IBA(355.93,DA,0)),U,16),0)),U,2);.12"
  1. .. D ^DIE
  1. . E D
  1. .. D PRVED(+$P(IBDA,U,2))
  1. . D BLD^IBCEP5
  1. CHG1Q S VALMBCK="R"
  1. Q
  1. ;
  1. PRVED(IBPRV) ; Maintain license #'s for VA provider ien IBPRV
  1. S IBPRV=IBPRV_";VA(200,"
  1. D EN^IBCEP5D
  1. Q
  1. ;
  1. COPYPROV(IBINS) ; Check if any ID's were edited and this is a parent insurance company
  1. ; IBINS = IEN into Insurance co file
  1. ;
  1. Q:'$D(^TMP("IB_EDITED_IDS",$J))
  1. K ^TMP("IB_EDITED_IDS",$J)
  1. D COPY^IBCEPCID(IBINS)
  1. Q
  1. ;
  1. ; Get the next number so that the edits can be replicated in order for other providers/insurance companies
  1. NEXTONE() ;
  1. Q $O(^TMP("IB_EDITED_IDS",$J,""),-1)+1