| 1 | IBJTBB ;ALB/ARH - TPI BILL DIAGNOSIS SCREEN ;01-MAR-1995 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**39,210**;21-MAR-94 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | EN ; -- main entry point for IBJ TP BILL DX | 
|---|
| 6 | D EN^VALM("IBJT BILL DX") | 
|---|
| 7 | Q | 
|---|
| 8 | ; | 
|---|
| 9 | HDR ; -- header code | 
|---|
| 10 | D HDR^IBJTU1(+IBIFN,+DFN,12) | 
|---|
| 11 | Q | 
|---|
| 12 | ; | 
|---|
| 13 | INIT ; -- init variables and list array | 
|---|
| 14 | K ^TMP("IBJTBB",$J) N IBFT | 
|---|
| 15 | I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ | 
|---|
| 16 | D BLD | 
|---|
| 17 | INITQ Q | 
|---|
| 18 | ; | 
|---|
| 19 | HELP ; -- help code | 
|---|
| 20 | S X="?" D DISP^XQORM1 W !! | 
|---|
| 21 | Q | 
|---|
| 22 | ; | 
|---|
| 23 | EXIT ; -- exit code | 
|---|
| 24 | K ^TMP("IBJTBB",$J) | 
|---|
| 25 | D CLEAR^VALM1 | 
|---|
| 26 | Q | 
|---|
| 27 | ; | 
|---|
| 28 | BLD ; | 
|---|
| 29 | N IBADX,IBI,IBX,IBCNT,IBLN,IBSTR,IBDATE | 
|---|
| 30 | S IBDATE=$$BDATE^IBACSV(IBIFN) | 
|---|
| 31 | D SET^IBCSC4D(IBIFN,"",.IBADX) I $D(IBADX)'>1 S IBLN=1 F IBSTR="","Bill contains no diagnosis." S IBLN=$$SET(IBSTR,IBLN,1,80) | 
|---|
| 32 | S IBI="",IBLN=1,IBCNT=0 F  S IBI=$O(IBADX(IBI)) Q:'IBI  D  S IBLN=$$SET(IBSTR,IBLN,1,80) | 
|---|
| 33 | . S IBCNT=IBCNT+1,IBX=$$ICD9^IBACSV(+IBADX(IBI),IBDATE) | 
|---|
| 34 | . S IBSTR=$J("",5)_$J(IBCNT,3)_")  "_$P(IBX,U,1)_$J("",(10-$L($P(IBX,U,1))))_$P(IBX,U,3) | 
|---|
| 35 | ; | 
|---|
| 36 | S VALMCNT=IBLN-1 | 
|---|
| 37 | Q | 
|---|
| 38 | ; | 
|---|
| 39 | SET(STR,LN,COL,WD,RV) ; set up TMP array with screen data | 
|---|
| 40 | D SET^VALM10(LN,STR) | 
|---|
| 41 | S LN=LN+1 | 
|---|
| 42 | Q LN | 
|---|