IBJTBB.m

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 ---IBJTBB   1178     printed  Mar 13, 2025@21:28:46                                                                                                                                                                                                      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