source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBJTBC.m@ 847

IBJTBC ;ALB/ARH - TPI BILL PROCEDURES SCREEN ;02-MAR-1995
 ;;2.0;INTEGRATED BILLING;**39,80,51,137,210,349**;21-MAR-94;Build 46
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
EN ; -- main entry point for IBJ TP BILL PROCEDURES
 D EN^VALM("IBJT BILL PROCEDURES")
 Q
 ;
HDR ; -- header code
 D HDR^IBJTU1(+IBIFN,+DFN,12)
 Q
 ;
INIT ; -- init variables and list array
 K ^TMP("IBJTBC",$J) N IBFT
 I '$G(DFN)!'$G(IBIFN) S VALMQUIT="" G INITQ
 D BLD
INITQ Q
 ;
HELP ; -- help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
EXIT ; -- exit code
 K ^TMP("IBJTBC",$J)
 D CLEAR^VALM1
 Q
 ;
BLD ;
 N IB,IBI,IBJ,IBX,IBY,IBDXI,IBLN,IBSTR,IBD,IBT,IBPRC,IBXDATA,IBZPRC,IBZDX
 D F^IBCEF("N-UB-04 PROCEDURES","IBZPRC",,IBIFN)
 S IBSTR=""
 I +$O(IBZPRC(0))=0 S IBLN=1 F IBSTR="","Bill contains no procedures." S IBLN=$$SET(IBSTR,IBLN)
 ;
 D F^IBCEF("N-DIAGNOSES","IBZDX",,IBIFN)
 S IBX=0,IBI="" F  S IBI=$O(IBZDX(IBI)) Q:'IBI  S IBDXI($P(IBZDX(IBI),U,2))=IBI
 S IBLN=1,IBI="" F  S IBI=$O(IBZPRC(IBI)) Q:'IBI  D  S IBLN=$$SET(IBSTR,IBLN)
 . N IBDATE ; Date of procedure
 . S IBX=IBZPRC(IBI)
 . S IBDATE=$P(IBX,U,2) I 'IBDATE S IBDATE=$$BDATE^IBACSV(IBIFN) ; The bills date
 . S IBPRC=$$PRCD^IBCEF1($P(IBX,U),1,IBDATE) Q:IBPRC=""
 . S IBT=0,IBSTR=" "_$P(IBPRC,U,2)
 . I +$P(IBZPRC(IBI),U,15) S IBSTR=IBSTR_" "_$$MODLST^IBEFUNC2($P(IBZPRC(IBI),U,15))
 . S IBT=20,IBD=$P(IBPRC,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBT,20)
 . S IBT=41,IBD=$$DATE^IBJU1(+$P(IBX,U,2)) S IBSTR=$$SETLN(IBD,IBSTR,IBT,8)
 . S IBT=51,IBY=$P(IBX,U,5) I IBY'="" S IBD="BASC:   Yes" D
 .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 . S IBY=$P(IBX,U,6) I IBY'="" S IBD="DIV:    "_$P($G(^DG(40.8,+IBY,0)),U,1) D
 .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 . S IBY=$P(IBX,U,7) I IBY'="" S IBD="CLINIC: "_$P($G(^SC(+IBY,0)),U,1) D
 .. S IBSTR=$$SETLN(IBD,IBSTR,IBT,29),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 . S IBY=$P(IBX,U,9) I IBY'="" D
 .. S IBT=51,IBY=$G(^IBE(353.1,+IBY,0)),IBD="POS:    "_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
 .. S IBT=63,IBD=$P(IBY,U,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,12),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 . S IBY=$P(IBX,U,10) I IBY'="" D
 .. S IBT=51,IBY=$G(^IBE(353.2,+IBY,0)),IBD="TOS:    "_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,11)
 .. S IBT=63,IBD=$P(IBY,U,2) S IBSTR=$$SETLN(IBD,IBSTR,IBT,17),IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 . S IBT=51,IBD=$P(IBX,U,16) I IBD,$P(IBX,U,10)=7 S IBSTR=$$SETLN("MINUTES: "_$P(IBX,U,16),IBSTR,IBT,15)
 . ;
 . S IBT=51 F IBJ=11:1:14 S IBY=$P(IBX,U,IBJ) I IBY'="" D  S IBLN=$$SET(IBSTR,IBLN),IBSTR=""
 .. S IBY=$G(IBDXI(+IBY)) Q:'IBY  S IBD="DX ("_IBY_"): "
 .. S IBY=+$G(IBZDX(+IBY)) Q:'IBY  S IBY=$$ICD9^IBACSV(+IBY,IBDATE)
 .. S IBT=51,IBD=IBD_$P(IBY,U,1) S IBSTR=$$SETLN(IBD,IBSTR,IBT,15)
 .. S IBT=67,IBD=$P(IBY,U,3) S IBSTR=$$SETLN(IBD,IBSTR,IBT,13)
 ;
 S VALMCNT=IBLN-1
 Q
 ;
SETLN(STR,IBX,COL,WD) ;
 S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD)
 Q IBX
 ;
SET(STR,LN) ; set up TMP array with screen data
 N IBX,IBI
 D SET^VALM10(LN,STR)
 S LN=LN+1
SETQ Q LN