| [613] | 1 | IBCRLT ;ALB/ARH - RATES: DISPLAY RATE TYPES ; 16-MAY-1996 | 
|---|
|  | 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94 | 
|---|
|  | 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
|  | 4 | ; | 
|---|
|  | 5 | EN ; -- main entry point for IBCR RATE TYPE | 
|---|
|  | 6 | D EN^VALM("IBCR RATE TYPE") | 
|---|
|  | 7 | Q | 
|---|
|  | 8 | ; | 
|---|
|  | 9 | HDR ; -- header code | 
|---|
|  | 10 | S VALMHDR(1)="This is a Standard file with entries released nationally." | 
|---|
|  | 11 | Q | 
|---|
|  | 12 | ; | 
|---|
|  | 13 | INIT ; -- init variables and list array | 
|---|
|  | 14 | K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J) | 
|---|
|  | 15 | D BLD | 
|---|
|  | 16 | Q | 
|---|
|  | 17 | ; | 
|---|
|  | 18 | HELP ; -- help code | 
|---|
|  | 19 | S X="?" D DISP^XQORM1 W !! | 
|---|
|  | 20 | Q | 
|---|
|  | 21 | ; | 
|---|
|  | 22 | EXIT ; -- exit code | 
|---|
|  | 23 | K ^TMP("IBCRLT",$J),^TMP("IBCRLTX1",$J) | 
|---|
|  | 24 | D CLEAR^VALM1,CLEAN^VALM10 | 
|---|
|  | 25 | Q | 
|---|
|  | 26 | ; | 
|---|
|  | 27 | BLD ; build array for rate type display | 
|---|
|  | 28 | N IBRT,IBRTFN,IBCNT,IBTC,IBTW,IBSW,IBLR,IBLN,IBT,IBD,IBGRPB,IBGRPE S VALMCNT=0,IBCNT=0 | 
|---|
|  | 29 | ; | 
|---|
|  | 30 | S (IBCNT,VALMCNT)=1 | 
|---|
|  | 31 | S IBTC(1)=2,IBTC(2)=39,IBTW(1)=15,IBTW(2)=16,IBSW(1)=21,IBSW(2)=25 | 
|---|
|  | 32 | ; | 
|---|
|  | 33 | ; create LM display array | 
|---|
|  | 34 | S IBRT="" F  S IBRT=$O(^DGCR(399.3,"B",IBRT)) Q:IBRT=""  D | 
|---|
|  | 35 | . S IBRTFN=0 F  S IBRTFN=$O(^DGCR(399.3,"B",IBRT,IBRTFN)) Q:'IBRTFN  D | 
|---|
|  | 36 | .. ; | 
|---|
|  | 37 | .. S IBLN=$G(^DGCR(399.3,IBRTFN,0)) Q:IBLN=""  D SETO(IBRTFN,IBCNT) | 
|---|
|  | 38 | .. ; | 
|---|
|  | 39 | .. S IBT="",IBD="" S IBCNT=$$SET(IBT,IBD,IBCNT,1) | 
|---|
|  | 40 | .. S IBT="Rate Type: ",IBD=$P(IBLN,U,1) S IBCNT=$$SET(IBT,IBD,IBCNT,1) | 
|---|
|  | 41 | .. D CNTRL^VALM10((IBCNT-1),(IBTC(1)+IBTW(1)),IBSW(1),IOINHI,IOINORM) | 
|---|
|  | 42 | .. S IBGRPB=IBCNT,IBLR=1 | 
|---|
|  | 43 | .. ; | 
|---|
|  | 44 | .. S IBT="Bill Name: ",IBD=$P(IBLN,U,2) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 45 | .. S IBT="Abbreviation: ",IBD=$P(IBLN,U,4) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 46 | .. S IBT="Third Party?: ",IBD=$S(+$P(IBLN,U,5):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 47 | .. S IBT="Inactive: ",IBD=$S(+$P(IBLN,U,3):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 48 | .. ; | 
|---|
|  | 49 | .. S IBGRPE=IBCNT,IBCNT=IBGRPB,IBLR=2 | 
|---|
|  | 50 | .. ; | 
|---|
|  | 51 | .. S IBT="AR Category: ",IBD=$$EXPAND^IBCRU1(399.3,.06,$P(IBLN,U,6)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 52 | .. S IBT="Who's Respns: ",IBD=$$EXPAND^IBCRU1(399.3,.07,$P(IBLN,U,7)) S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 53 | .. S IBT="RI Statement?: ",IBD=$S(+$P(IBLN,U,8):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 54 | .. S IBT="NSC Statement?: ",IBD=$S(+$P(IBLN,U,9):"YES",1:"") S IBCNT=$$SET(IBT,IBD,IBCNT,IBLR) | 
|---|
|  | 55 | .. S (IBCNT,VALMCNT)=$S(IBCNT>IBGRPE:IBCNT,1:IBGRPE) | 
|---|
|  | 56 | ; | 
|---|
|  | 57 | S (IBCNT,VALMCNT)=IBCNT-1 | 
|---|
|  | 58 | ; | 
|---|
|  | 59 | I VALMCNT=0 S IBCNT=$$SET(" ","",1,1),IBCNT=$$SET("No Rate Types defined","",2,1) | 
|---|
|  | 60 | ; | 
|---|
|  | 61 | Q | 
|---|
|  | 62 | ; | 
|---|
|  | 63 | SETO(RT,LN) ; set line number of beginning line of a rate type | 
|---|
|  | 64 | ; (so when redisplay after edit it begins redisplay on the rate that was edited) | 
|---|
|  | 65 | S ^TMP("IBCRLTX1",$J,+$G(RT))=+$G(LN) | 
|---|
|  | 66 | Q | 
|---|
|  | 67 | ; | 
|---|
|  | 68 | SET(TTL,DATA,LN,LR) ; | 
|---|
|  | 69 | N IBY | 
|---|
|  | 70 | S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR))) | 
|---|
|  | 71 | S LN=LN+1 | 
|---|
|  | 72 | Q LN | 
|---|
|  | 73 | ; | 
|---|
|  | 74 | SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data | 
|---|
|  | 75 | N IBX S IBX=$G(^TMP("IBCRLT",$J,LN,0)) | 
|---|
|  | 76 | S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD) | 
|---|
|  | 77 | D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF) | 
|---|
|  | 78 | Q | 
|---|