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 Oct 16, 2024@18:20:19 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
