IBCRLT ;ALB/ARH - RATES: DISPLAY RATE TYPES ; 16-MAY-1996
;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; -- main entry point for IBCR RATE TYPE
D EN^VALM("IBCR RATE TYPE")
Q
;
HDR ; -- header code
S VALMHDR(1)="This is a Standard file with entries released nationally."
Q
;
INIT ; -- init variables and list array
K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
D BLD
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J)
D CLEAR^VALM1,CLEAN^VALM10
Q
;
BLD ; build array for rate type display
N IBRT,IBRTFN,IBCNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE S VALMCNT=0,IBCNT=0
;
S (IBCNT,VALMCNT)=1
S IBTC(1)=2,IBTC(2)=39,IBTW(1)=15,IBTW(2)=16,IBSW(1)=21,IBSW(2)=25
;
; create LM display array
S IBRT="" F S IBRT=$O(^DGCR(399.3,"B",IBRT)) Q:IBRT="" D
. S IBRTFN=0 F S IBRTFN=$O(^DGCR(399.3,"B",IBRT,IBRTFN)) Q:'IBRTFN D
.. ;
.. S IBLN=$G(^DGCR(399.3,IBRTFN,0)) Q:IBLN="" D SETO(IBRTFN,IBCNT)
.. ;
.. S IBT="",IBD="" S IBCNT=$$SET(IBT,IBD,IBCNT,1)
.. S IBT="Rate Type: ",IBD=$P(IBLN,U,1) S IBCNT=$$SET(IBT,IBD,IBCNT,1)
.. D CNTRL^VALM10((IBCNT-1),(IBTC(1)+IBTW(1)),IBSW(1),IOINHI,IOINORM)
.. S IBGRPB=IBCNT,IBLR=1
.. ;
.. S IBT="Bill Name: ",IBD=$P(IBLN,U,2) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="Abbreviation: ",IBD=$P(IBLN,U,4) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="Third Party?: ",IBD=$S(+$P(IBLN,U,5):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="Inactive: ",IBD=$S(+$P(IBLN,U,3):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. ;
.. S IBGRPE=IBCNT,IBCNT=IBGRPB,IBLR=2
.. ;
.. S IBT="AR Category: ",IBD=$$EXPAND^IBCRU1(399.3,.06,$P(IBLN,U,6)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="Who's Respns: ",IBD=$$EXPAND^IBCRU1(399.3,.07,$P(IBLN,U,7)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="RI Statement?: ",IBD=$S(+$P(IBLN,U,8):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S IBT="NSC Statement?: ",IBD=$S(+$P(IBLN,U,9):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
.. S (IBCNT,VALMCNT)=$S(IBCNT>IBGRPE:IBCNT,1:IBGRPE)
;
S (IBCNT,VALMCNT)=IBCNT-1
;
I VALMCNT=0 S IBCNT=$$SET(" ","",1,1),IBCNT=$$SET("No Rate Types defined","",2,1)
;
Q
;
SETO(RT,LN) ; set line number of beginning line of a rate type
; (so when redisplay after edit it begins redisplay on the rate that was edited)
S ^TMP("IBCRLTX1",$J,+$G(RT))=+$G(LN)
Q
;
SET(TTL,DATA,LN,LR) ;
N IBY
S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
S LN=LN+1
Q LN
;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
N IBX S IBX=$G(^TMP("IBCRLT",$J,LN,0))
S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRLT 2870 printed Apr 09, 2024@21:12:58 Page 2
IBCRLT ;ALB/ARH - RATES: DISPLAY RATE TYPES ; 16-MAY-1996
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; -- main entry point for IBCR RATE TYPE
+1 DO EN^VALM("IBCR RATE TYPE")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="This is a Standard file with entries released nationally."
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBCRLT",$JOB),^TMP("IBCRLTX1",$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("IBCRLT",$JOB),^TMP("IBCRLTX1",$JOB)
+2 DO CLEAR^VALM1
DO CLEAN^VALM10
+3 QUIT
+4 ;
BLD ; build array for rate type display
+1 NEW IBRT,IBRTFN,IBCNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE
SET VALMCNT=0
SET IBCNT=0
+2 ;
+3 SET (IBCNT,VALMCNT)=1
+4 SET IBTC(1)=2
SET IBTC(2)=39
SET IBTW(1)=15
SET IBTW(2)=16
SET IBSW(1)=21
SET IBSW(2)=25
+5 ;
+6 ; create LM display array
+7 SET IBRT=""
FOR
SET IBRT=$ORDER(^DGCR(399.3,"B",IBRT))
if IBRT=""
QUIT
Begin DoDot:1
+8 SET IBRTFN=0
FOR
SET IBRTFN=$ORDER(^DGCR(399.3,"B",IBRT,IBRTFN))
if 'IBRTFN
QUIT
Begin DoDot:2
+9 ;
+10 SET IBLN=$GET(^DGCR(399.3,IBRTFN,0))
if IBLN=""
QUIT
DO SETO(IBRTFN,IBCNT)
+11 ;
+12 SET IBT=""
SET IBD=""
SET IBCNT=$$SET(IBT,IBD,IBCNT,1)
+13 SET IBT="Rate Type: "
SET IBD=$PIECE(IBLN,U,1)
SET IBCNT=$$SET(IBT,IBD,IBCNT,1)
+14 DO CNTRL^VALM10((IBCNT-1),(IBTC(1)+IBTW(1)),IBSW(1),IOINHI,IOINORM)
+15 SET IBGRPB=IBCNT
SET IBLR=1
+16 ;
+17 SET IBT="Bill Name: "
SET IBD=$PIECE(IBLN,U,2)
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+18 SET IBT="Abbreviation: "
SET IBD=$PIECE(IBLN,U,4)
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+19 SET IBT="Third Party?: "
SET IBD=$SELECT(+$PIECE(IBLN,U,5):"YES",1:"")
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+20 SET IBT="Inactive: "
SET IBD=$SELECT(+$PIECE(IBLN,U,3):"YES",1:"")
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+21 ;
+22 SET IBGRPE=IBCNT
SET IBCNT=IBGRPB
SET IBLR=2
+23 ;
+24 SET IBT="AR Category: "
SET IBD=$$EXPAND^IBCRU1(399.3,.06,$PIECE(IBLN,U,6))
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+25 SET IBT="Who's Respns: "
SET IBD=$$EXPAND^IBCRU1(399.3,.07,$PIECE(IBLN,U,7))
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+26 SET IBT="RI Statement?: "
SET IBD=$SELECT(+$PIECE(IBLN,U,8):"YES",1:"")
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+27 SET IBT="NSC Statement?: "
SET IBD=$SELECT(+$PIECE(IBLN,U,9):"YES",1:"")
SET IBCNT=$$SET(IBT,IBD,IBCNT,IBLR)
+28 SET (IBCNT,VALMCNT)=$SELECT(IBCNT>IBGRPE:IBCNT,1:IBGRPE)
End DoDot:2
End DoDot:1
+29 ;
+30 SET (IBCNT,VALMCNT)=IBCNT-1
+31 ;
+32 IF VALMCNT=0
SET IBCNT=$$SET(" ","",1,1)
SET IBCNT=$$SET("No Rate Types defined","",2,1)
+33 ;
+34 QUIT
+35 ;
SETO(RT,LN) ; set line number of beginning line of a rate type
+1 ; (so when redisplay after edit it begins redisplay on the rate that was edited)
+2 SET ^TMP("IBCRLTX1",$JOB,+$GET(RT))=+$GET(LN)
+3 QUIT
+4 ;
SET(TTL,DATA,LN,LR) ;
+1 NEW IBY
+2 SET IBY=$JUSTIFY(TTL,IBTW(LR))_DATA
DO SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR)))
+3 SET LN=LN+1
+4 QUIT LN
+5 ;
SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data
+1 NEW IBX
SET IBX=$GET(^TMP("IBCRLT",$JOB,LN,0))
+2 SET IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
+3 DO SET^VALM10(LN,IBX)
IF $GET(RV)'=""
DO CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF)
+4 QUIT
