IBARXEC4.m

IBARXEC4	;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT BUILD ; 14-JAN-93

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

	;

%	;

BUILD	; -- Build report

	;

	S (IBOK,IBN)=0

	F  S IBN=$O(^IB("AC",11,IBN)) Q:'IBN  D CHK,SET:IBOK

	Q

	;

CHK	; -- is entry in date range

	S IBOK=0

	S X=$G(^IB(IBN,0)),X1=$G(^IB(IBN,1))

	I X=""!(X1="") G CHK Q

	I (IBBDT-.00001)<$P(X1,"^",2),(IBEDT+.9)>$P(X1,"^",2) S IBOK=1

CHKQ	Q

	;

SET	; -- set entry in ^tmp

	S DFN=$P(X,"^",2)

	S IBP=$$PT^IBEFUNC(DFN) ; name^bid^pid

	S ^TMP("IBCONV",$J,$P(IBP,"^"),DFN,IBN)=IBP

	Q

IBARXEC4  ;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT BUILD ; 14-JAN-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

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

 +3       ;

%         ;

BUILD     ; -- Build report

 +1       ;

 +2        SET (IBOK,IBN)=0

 +3        FOR 

               SET IBN=$ORDER(^IB("AC",11,IBN))

               IF 'IBN

                   QUIT 

               DO CHK

               IF IBOK

                   DO SET

 +4        QUIT 

 +5       ;

CHK       ; -- is entry in date range

 +1        SET IBOK=0

 +2        SET X=$GET(^IB(IBN,0))

           SET X1=$GET(^IB(IBN,1))

 +3        IF X=""!(X1="")

               GOTO CHK

               QUIT 

 +4        IF (IBBDT-.00001)<$PIECE(X1,"^",2)

               IF (IBEDT+.9)>$PIECE(X1,"^",2)

                   SET IBOK=1

CHKQ       QUIT 

 +1       ;

SET       ; -- set entry in ^tmp

 +1        SET DFN=$PIECE(X,"^",2)

 +2       ; name^bid^pid

           SET IBP=$$PT^IBEFUNC(DFN)

 +3        SET ^TMP("IBCONV",$JOB,$PIECE(IBP,"^"),DFN,IBN)=IBP

 +4        QUIT