Routine: IBCRBG1

IBCRBG1 ;ALB/ARH - RATES: BILL SOURCE EVENTS (OPT,CPT) ; 5/21/96

 ;;2.0;INTEGRATED BILLING;**52,106,148,245**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

OPTVD(IBIFN,ARR) ; outpatient visit dates on a bill

 ; returns       ARR = cnt of visit dates found

 ;               ARR(DA of visit) = date

 N IBI,IBX K ARR S ARR=0,IBIFN=+$G(IBIFN)

 S IBI=0 F  S IBI=$O(^DGCR(399,IBIFN,"OP",IBI))  Q:'IBI  D

 . S IBX=+$G(^DGCR(399,IBIFN,"OP",IBI,0))

 . I +IBX S ARR=ARR+1,ARR(+IBI)=IBX

CPT(IBIFN,ARR) ; find all CPT codes for a bill (excludes ICD9)

 ; returns ARR = cnt of CPT's found

 ; ARR(CPT,DA of CPT) = date ^ modifiers ^ division ^ provider ^ clinic ^ ptr to 409.68 ^ minutes ^ miles ^ hours

 N IBI,IBX K ARR S ARR=0,IBIFN=+$G(IBIFN)

 S IBI=0 F  S IBI=$O(^DGCR(399,IBIFN,"CP",IBI)) Q:'IBI  D

 . S IBX=$G(^DGCR(399,IBIFN,"CP",IBI,0))

 . I +IBX,IBX[";ICPT(" S ARR=ARR+1,ARR(+IBX,IBI)=$P(IBX,U,2)_U_$$GETMOD^IBEFUNC(IBIFN,IBI)_U_$P(IBX,U,6)_U_$P(IBX,U,18)_U_$P(IBX,U,7)_U_$P(IBX,U,20)_U_$P(IBX,U,16)_U_$P(IBX,U,21)_U_$P(IBX,U,22)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRBG1   1098     printed  Mar 13, 2025@21:23:50                                                                                                                                                                                                     Page 2

IBCRBG1   ;ALB/ARH - RATES: BILL SOURCE EVENTS (OPT,CPT) ; 5/21/96

 +1       ;;2.0;INTEGRATED BILLING;**52,106,148,245**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

OPTVD(IBIFN,ARR) ; outpatient visit dates on a bill

 +1       ; returns       ARR = cnt of visit dates found

 +2       ;               ARR(DA of visit) = date

 +3       ;

 +4        NEW IBI,IBX

           KILL ARR

           SET ARR=0

           SET IBIFN=+$GET(IBIFN)

 +5        SET IBI=0

FOR

               SET IBI=$ORDER(^DGCR(399,IBIFN,"OP",IBI))

               if 'IBI

                   QUIT

               Begin DoDot:1

 +6                SET IBX=+$GET(^DGCR(399,IBIFN,"OP",IBI,0))

 +7                IF +IBX

                       SET ARR=ARR+1

                       SET ARR(+IBI)=IBX

               End DoDot:1

 +8        QUIT

 +9       ;

CPT(IBIFN,ARR) ; find all CPT codes for a bill (excludes ICD9)

 +1       ; returns ARR = cnt of CPT's found

 +2       ; ARR(CPT,DA of CPT) = date ^ modifiers ^ division ^ provider ^ clinic ^ ptr to 409.68 ^ minutes ^ miles ^ hours

 +3       ;

 +4        NEW IBI,IBX

           KILL ARR

           SET ARR=0

           SET IBIFN=+$GET(IBIFN)

 +5        SET IBI=0

FOR

               SET IBI=$ORDER(^DGCR(399,IBIFN,"CP",IBI))

               if 'IBI

                   QUIT

               Begin DoDot:1

 +6                SET IBX=$GET(^DGCR(399,IBIFN,"CP",IBI,0))

 +7                IF +IBX

                       IF IBX[";ICPT("

                           SET ARR=ARR+1

                           SET ARR(+IBX,IBI)=$PIECE(IBX,U,2)_U_$$GETMOD^IBEFUNC(IBIFN,IBI)_U_$PIECE(IBX,U,6)_U_$PIECE(IBX,U,18)_U_$PIECE(IBX,U,7)_U_$PIECE(IBX,U,20)_U_$PIECE(IBX,U,16)_U_$PIECE(IBX,U,21)_U_$PIECE(IBX,U,22)

               End DoDot:1

 +8        QUIT

IBCRBG1.m