IBCEP0A ;ALB/TMP - EDI UTILITIES for insurance assigned provider ID ;01-NOV-00
 ;;2.0;INTEGRATED BILLING;**137,232,320**;21-MAR-94
 ;
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 indentify 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 provider id type (from ins co option)
 ;
 N DIR,X,Y
 D FULL^VALM1
 S DIR(0)="PAO^355.97:AEMQ",DIR("A")="SELECT PROVIDER ID TYPE: ",DIR("?",1)="SELECTING A PROVIDER ID TYPE WILL FORCE THE DISPLAY TO SKIP TO THE DATA FOR ",DIR("?")="  THAT PROVIDER ID 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 PROVIDER ID TYPE 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