IBJTBB ;ALB/ARH - TPI BILL DIAGNOSIS SCREEN ;01-MAR-1995
;;2.0;INTEGRATED BILLING;**39,210,461**;21-MAR-94;Build 58
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; -- main entry point for IBJ TP BILL DX
D EN^VALM("IBJT BILL DX")
Q
;
HDR ; -- header code
D HDR^IBJTU1(+IBIFN,+DFN,12)
Q
;
INIT ; -- init variables and list array
K ^TMP("IBJTBB",$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("IBJTBB",$J)
D CLEAR^VALM1
Q
;
BLD ;
N IBADX,IBI,IBX,IBCNT,IBLN,IBSTR,IBDATE
S IBDATE=$$BDATE^IBACSV(IBIFN)
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)
S IBI="",IBLN=1,IBCNT=0 F S IBI=$O(IBADX(IBI)) Q:'IBI D S IBLN=$$SET(IBSTR,IBLN,1,80)
. S IBCNT=IBCNT+1,IBX=$$ICD9^IBACSV(+IBADX(IBI),IBDATE)
. S IBSTR=$J("",1)_$J(IBCNT,3)_") "_$P(IBX,U,1)_$J("",(10-$L($P(IBX,U,1))))_$P(IBX,U,3)
;
S VALMCNT=IBLN-1
Q
;
SET(STR,LN,COL,WD,RV) ; set up TMP array with screen data
D SET^VALM10(LN,STR)
S LN=LN+1
Q LN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTBB 1178 printed Oct 16, 2024@18:24:26 Page 2
IBJTBB ;ALB/ARH - TPI BILL DIAGNOSIS SCREEN ;01-MAR-1995
+1 ;;2.0;INTEGRATED BILLING;**39,210,461**;21-MAR-94;Build 58
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; -- main entry point for IBJ TP BILL DX
+1 DO EN^VALM("IBJT BILL DX")
+2 QUIT
+3 ;
HDR ; -- header code
+1 DO HDR^IBJTU1(+IBIFN,+DFN,12)
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("IBJTBB",$JOB)
NEW IBFT
+2 IF '$GET(DFN)!'$GET(IBIFN)
SET VALMQUIT=""
GOTO INITQ
+3 DO BLD
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBJTBB",$JOB)
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ;
+1 NEW IBADX,IBI,IBX,IBCNT,IBLN,IBSTR,IBDATE
+2 SET IBDATE=$$BDATE^IBACSV(IBIFN)
+3 DO SET^IBCSC4D(IBIFN,"",.IBADX)
IF $DATA(IBADX)'>1
SET IBLN=1
FOR IBSTR="","Bill contains no diagnosis."
SET IBLN=$$SET(IBSTR,IBLN,1,80)
+4 SET IBI=""
SET IBLN=1
SET IBCNT=0
FOR
SET IBI=$ORDER(IBADX(IBI))
if 'IBI
QUIT
Begin DoDot:1
+5 SET IBCNT=IBCNT+1
SET IBX=$$ICD9^IBACSV(+IBADX(IBI),IBDATE)
+6 SET IBSTR=$JUSTIFY("",1)_$JUSTIFY(IBCNT,3)_") "_$PIECE(IBX,U,1)_$JUSTIFY("",(10-$LENGTH($PIECE(IBX,U,1))))_$PIECE(IBX,U,3)
End DoDot:1
SET IBLN=$$SET(IBSTR,IBLN,1,80)
+7 ;
+8 SET VALMCNT=IBLN-1
+9 QUIT
+10 ;
SET(STR,LN,COL,WD,RV) ; set up TMP array with screen data
+1 DO SET^VALM10(LN,STR)
+2 SET LN=LN+1
+3 QUIT LN
