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

IBCRLA1.m

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