IBCRLC ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for IBCR CHARGE SET
D EN^VALM("IBCR CHARGE SET")
Q
;
HDR ; -- header code
S VALMHDR(1)=" Default"
Q
;
INIT ; -- init variables and list array
K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
D BLD
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
D CLEAR^VALM1,CLEAN^VALM10
Q
;
BLD ; build charge set display array
N IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCS")
;
D SORTCS
;
; create LM display array
S IBBRNM="" F S IBBRNM=$O(^TMP($J,"IBCRCS",IBBRNM)) Q:IBBRNM="" D
. ;
. S IBBRFN=+$G(^TMP($J,"IBCRCS",IBBRNM))
. D SET("",IBBRFN) S IBY=" Billing Rate: "_IBBRNM
. D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
. ;
. S IBBEVNT="" F S IBBEVNT=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT)) Q:IBBEVNT="" D
.. S IBCSNM="" F S IBCSNM=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM)) Q:IBCSNM="" D
... S IBCSFN=0 F S IBCSFN=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN)) Q:'IBCSFN D
.... ;
.... S IBLN=$G(^IBE(363.1,IBCSFN,0)) Q:IBLN=""
.... S IBY=""
.... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")
.... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,3),2),IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")
.... S IBX=$$CGTYPE(+$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")
.... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,5),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")
.... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,6),2),IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")
.... S IBX=$P($G(^IBE(363.31,+$P(IBLN,U,7),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
.... D SET(IBY)
;
I VALMCNT=0 D SET(" ",0),SET("No Charge Sets defined",0)
;
K ^TMP($J,"IBCRCS")
Q
;
SET(X,BRFN) ; set up list manager screen array
S VALMCNT=VALMCNT+1
S ^TMP("IBCRLC",$J,VALMCNT,0)=X
I +$G(BRFN) S ^TMP("IBCRLCX1",$J,+BRFN)=VALMCNT
Q
;
SORTCS ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name
; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN
; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""
N IBCSFN,IBBRNM,IBBEVNT,IBLN
S IBCSFN=0 F S IBCSFN=$O(^IBE(363.1,IBCSFN)) Q:'IBCSFN D
. S IBLN=$G(^IBE(363.1,IBCSFN,0))
. S IBBRNM=$P($G(^IBE(363.3,+$P(IBLN,U,2),0)),U,1) I IBBRNM="" S IBBRNM=" "
. S IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3),2) I IBBEVNT="" S IBBEVNT=" "
. S ^TMP($J,"IBCRCS",IBBRNM)=$P(IBLN,U,2)
. S ^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,$P(IBLN,U,1),IBCSFN)=""
Q
;
CGTYPE(X) ; return external form of Charge Type (363.1)
S X=$G(X),X=$S(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRLC 2908 printed Dec 13, 2024@02:19:40 Page 2
IBCRLC ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-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 ;
EN ; -- main entry point for IBCR CHARGE SET
+1 DO EN^VALM("IBCR CHARGE SET")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" Default"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBCRLC",$JOB),^TMP("IBCRLCX1",$JOB)
+2 DO BLD
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCRLC",$JOB),^TMP("IBCRLCX1",$JOB)
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
BLD ; build charge set display array
+1 NEW IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY
SET VALMCNT=0
KILL ^TMP($JOB,"IBCRCS")
+2 ;
+3 DO SORTCS
+4 ;
+5 ; create LM display array
+6 SET IBBRNM=""
FOR
SET IBBRNM=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM))
if IBBRNM=""
QUIT
Begin DoDot:1
+7 ;
+8 SET IBBRFN=+$GET(^TMP($JOB,"IBCRCS",IBBRNM))
+9 DO SET("",IBBRFN)
SET IBY=" Billing Rate: "_IBBRNM
+10 DO SET(IBY)
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
+11 ;
+12 SET IBBEVNT=""
FOR
SET IBBEVNT=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT))
if IBBEVNT=""
QUIT
Begin DoDot:2
+13 SET IBCSNM=""
FOR
SET IBCSNM=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM))
if IBCSNM=""
QUIT
Begin DoDot:3
+14 SET IBCSFN=0
FOR
SET IBCSFN=$ORDER(^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN))
if 'IBCSFN
QUIT
Begin DoDot:4
+15 ;
+16 SET IBLN=$GET(^IBE(363.1,IBCSFN,0))
if IBLN=""
QUIT
+17 SET IBY=""
+18 SET IBX=$PIECE(IBLN,U,1)
SET IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")
+19 SET IBX=$$EMUTL^IBCRU1(+$PIECE(IBLN,U,3),2)
SET IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")
+20 SET IBX=$$CGTYPE(+$PIECE(IBLN,U,4))
SET IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")
+21 SET IBX=$PIECE($GET(^DGCR(399.2,+$PIECE(IBLN,U,5),0)),U,1)
SET IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")
+22 SET IBX=$$EMUTL^IBCRU1(+$PIECE(IBLN,U,6),2)
SET IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")
+23 SET IBX=$PIECE($GET(^IBE(363.31,+$PIECE(IBLN,U,7),0)),U,1)
SET IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
+24 DO SET(IBY)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 IF VALMCNT=0
DO SET(" ",0)
DO SET("No Charge Sets defined",0)
+27 ;
+28 KILL ^TMP($JOB,"IBCRCS")
+29 QUIT
+30 ;
SET(X,BRFN) ; set up list manager screen array
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCRLC",$JOB,VALMCNT,0)=X
+3 IF +$GET(BRFN)
SET ^TMP("IBCRLCX1",$JOB,+BRFN)=VALMCNT
+4 QUIT
+5 ;
SORTCS ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name
+1 ; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN
+2 ; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""
+3 NEW IBCSFN,IBBRNM,IBBEVNT,IBLN
+4 SET IBCSFN=0
FOR
SET IBCSFN=$ORDER(^IBE(363.1,IBCSFN))
if 'IBCSFN
QUIT
Begin DoDot:1
+5 SET IBLN=$GET(^IBE(363.1,IBCSFN,0))
+6 SET IBBRNM=$PIECE($GET(^IBE(363.3,+$PIECE(IBLN,U,2),0)),U,1)
IF IBBRNM=""
SET IBBRNM=" "
+7 SET IBBEVNT=$$EMUTL^IBCRU1($PIECE(IBLN,U,3),2)
IF IBBEVNT=""
SET IBBEVNT=" "
+8 SET ^TMP($JOB,"IBCRCS",IBBRNM)=$PIECE(IBLN,U,2)
+9 SET ^TMP($JOB,"IBCRCS",IBBRNM,IBBEVNT,$PIECE(IBLN,U,1),IBCSFN)=""
End DoDot:1
+10 QUIT
+11 ;
CGTYPE(X) ; return external form of Charge Type (363.1)
+1 SET X=$GET(X)
SET X=$SELECT(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")
+2 QUIT X
