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