IBCRLA1 ;ALB/ARH - RATES: DISPLAY ACTION PROTOCOLS ; 16-MAY-1996
 ;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ;
 ; the IBCRLxX1 level of TMP array shows where specific types of data begins display (like RT=RI)
 ; this is used to begin redisplay of the screen at the section of data edited by the user (VALMBG)
 ;
EDRS ; -- IBCR RATE SCHEDULE EDIT action
 N VALMQUIT,IBRSFNX,IBBR,IBBT,IBX,IBY S IBRSFNX=0
 D FULL^VALM1
 D EDITRS^IBCREE
 K ^TMP("IBCRLS",$J),^TMP("IBCRLSX1",$J) D CLEAN^VALM10
 D BLD^IBCRLS,HDR^IBCRLS
 S IBX=$G(^IBE(363,+$G(IBRSFNX),0)),IBY=+$G(^TMP("IBCRLSX1",$J,+$P(IBX,U,2),+$P(IBX,U,3)))
 S VALMBCK="R" I +IBY S VALMBG=+IBY
 Q
 ;
EDRT ; -- IBCR RATE TYPE EDIT action
 N VALMQUIT,IBRTFNX,IBY S IBRTFNX=0
 D FULL^VALM1
 D EDITRT^IBCREE
 K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J) D CLEAN^VALM10
 D BLD^IBCRLT S IBY=+$G(^TMP("IBCRLTX1",$J,+$G(IBRTFNX)))
 S VALMBCK="R" I +IBY S VALMBG=+IBY
 Q
 ;
EDBR ; -- IBCR BILLING RATE EDIT action
 N VALMQUIT
 D FULL^VALM1
 D EDITBR^IBCREE
 K ^TMP("IBCRLR",$J)
 D BLD^IBCRLR
 S VALMBCK="R"
 Q
 ;
EDRG ; -- IBCR BILLING REGION EDIT action
 N VALMQUIT,IBY
 D FULL^VALM1
 D EDITRG^IBCREE
 K ^TMP("IBCRLG",$J)
 D BLD^IBCRLG
 S VALMBCK="R"
 Q
 ;
EDCS ; -- IBCR CHARGE SET EDIT action
 N VALMQUIT,IBCSFNX,IBX,IBY S IBCSFNX=0
 D FULL^VALM1
 D EDITCS^IBCREE
 K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J) D CLEAN^VALM10
 D BLD^IBCRLC
 S IBX=$G(^IBE(363.1,$G(IBCSFNX),0)),IBY=+$G(^TMP("IBCRLCX1",$J,+$P(IBX,U,2)))
 S VALMBCK="R" I +IBY S VALMBG=+IBY
 Q
 ;
EDBI ; -- IBCR BILLING ITEM EDIT action
 N VALMQUIT
 D FULL^VALM1
 D EDITBI^IBCREE
 S VALMBCK="R"
 Q
 ;
EDCI ; -- IBCR CHARGE ITEM EDIT action:  (screen variables are updated durinig edit)
 N VALMQUIT
 D FULL^VALM1
 D EDITCI^IBCREE1
 K ^TMP("IBCRLI",$J)
 D BLD^IBCRLI,HDR^IBCRLI
 S VALMBCK="R"
 Q
 ;
ENCI ; -- IBCR CHARGE ITEM SCREEN action:  (get Charge Set then open Charge Item screen for Set)
 N VALMQUIT,IBCSFN
 D FULL^VALM1
 S IBCSFN=$$GETCS^IBCRU1 I +IBCSFN>0 I $$GET^IBCRLI'<0 D EN^IBCRLI
 S VALMBCK="R"
 Q
 ;
CICITM ; -- IBCR CHARGE ITEM CHANGE action:  (user select of specific items to display on CI screen)
 N VALMQUIT,IBITEMX I '$G(IBCSFN) Q
 S (IBSRNITM,IBITEMX)=$G(IBSRNITM)
 D FULL^VALM1
 S IBITEMX=$$GETITEM^IBCRU1(IBCSFN,"",1) I +IBITEMX S IBSRNITM=IBITEMX
 K ^TMP("IBCRLI",$J)
 D BLD^IBCRLI,HDR^IBCRLI
 S VALMBCK="R",VALMBG=1
 Q
 ;
CICDTS ; -- IBCR CHARGE ITEM DATES action:   (user select of date range to display on CI screen)
 N VALMQUIT,IBX I '$G(IBCSFN) Q
 S IBSRNBDT=+$G(IBSRNBDT),IBSRNEDT=+$G(IBSRNEDT)
 D FULL^VALM1
 S IBX=$$GETDT^IBCRU1(IBSRNBDT,"Charges Effective on Date") I IBX?7N S (IBSRNBDT,IBSRNEDT)=+IBX
 S IBX=$$GETDT^IBCRU1(IBSRNEDT,"Charges Effective to Date") I IBX?7N S IBSRNEDT=+IBX
 K ^TMP("IBCRLI",$J)
 D BLD^IBCRLI,HDR^IBCRLI
 S VALMBCK="R",VALMBG=1
 Q
 ;
FASTEXIT ; -- IBCR EXIT action:  (sets flag signaling if user wants to sxit completely)
 S VALMBCK="Q"
 D FULL^VALM1
 K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
 I $D(DIRUT)!(Y) S IBFASTXT=5
 K DIR,DIRUT
 Q
 ;
MAINSCR ; -- IBCR MAIN SCREEN action:  (sets flag signaling to return to main screen (INTRODUCTION))
 S VALMBCK="Q"
 D FULL^VALM1
 S IBFASTXT=4
 K DIR,DIRUT
 Q
 ;
EDSG ; -- IBCR SPECIAL GROUPS EDIT action
 N VALMQUIT,IBY
 D FULL^VALM1
 D EDITSG^IBCREE2
 K ^TMP("IBCRLL",$J) D CLEAN^VALM10
 D BLD^IBCRLL
 S VALMBCK="R"
 Q
 ;
EDRL ; -- IBCR REVENUE CODE LINK EDIT action
 N VALMQUIT,IBY
 D FULL^VALM1
 D EDITRL^IBCREE2
 K ^TMP("IBCRLM",$J)
 D BLD^IBCRLM,HDR^IBCRLM
 S VALMBCK="R"
 Q
 ;
ENRL ; -- IBCR REVENUE CODE LINK SCREEN action:  (get Billing Rate/Special Group and CPT then open Rv links screen )
 N VALMQUIT,IBSGFN,IBBRFN,IBCPT
 D FULL^VALM1
 W !!,"Select CPT to display.",!! S IBCPT=$$GETCPT^IBCRU1("",1) I IBCPT>0 D EN^IBCRLM
 S VALMBCK="R"
 Q
 ;
RLCLNK ; -- IBCR REVENUE CODE LINK CHANGE action:  (user select CPT to display rev code links on screen)
 N VALMQUIT,IBITEMX
 D FULL^VALM1
 S IBITEMX=$$GETCPT^IBCRU1("",1) I +IBITEMX>0 S IBCPT=IBITEMX
 K ^TMP("IBCRLM",$J)
 D BLD^IBCRLM,HDR^IBCRLM
 S VALMBCK="R",VALMBG=1
 Q
 ;
EDPD ; -- IBCR PROVIDER DISCOUNT EDIT action
 N VALMQUIT,IBPDFNX,IBX,IBY S IBPDFNX=0
 D FULL^VALM1
 D EDITPD^IBCREE2
 K ^TMP("IBCRLN",$J),^TMP("IBCRLNX1",$J) D CLEAN^VALM10
 D BLD^IBCRLN
 S IBY=+$G(^TMP("IBCRLNX1",$J,+IBPDFNX))
 S VALMBCK="R" I +IBY S VALMBG=+IBY
 Q
 ;
ENPD ; -- IBCR PROVIDER DISCOUNT SCREEN action:  (get Special Group then open screen )
 N VALMQUIT,IBSGFN
 D FULL^VALM1
 S IBSGFN=$$GETSG^IBCRU1(2) I +IBSGFN>0 D EN^IBCRLN
 S VALMBCK="R"
 Q