| [613] | 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 | 
|---|