IBORAT2A.m

IBORAT2A	;ALB/RJS - FILTER FOR FILE 399.5- 1/22/92

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

	;THIS ROUTINE FILTERS FILE 399.5 TO BUILD A TEMPORARY

	;FILE NAMED TMP($J,"IBORAT2A") THIS FILE IS PASSED ON TO

	;ROUTINE IBORAT2B FOR FURTHER PROCESSING

START	;

	S IBCOUNT=0

	F IBRECNR=0:0 S IBRECNR=$O(^DGCR(399.5,IBRECNR)) Q:IBRECNR'>0  D NEXT

END	;

	K IBACTIVE,IBAMOUNT,IBBILL,IBEFFDAT,IBPAYORS,IBPTR,IBRECNR,IBREVCDE,IBXDATA,IBSTAND,IBCOUNT

	Q

NEXT	;

	S IBXDATA=$G(^DGCR(399.5,IBRECNR,0))

	I IBXDATA'="" D XTRACT,NEXT3

	Q

XTRACT	;

	S IBEFFDAT=$P(IBXDATA,U,1),IBPTR=$P(IBXDATA,U,2),IBREVCDE=$P(IBXDATA,U,3),IBAMOUNT=$P(IBXDATA,U,4),IBACTIVE=$P(IBXDATA,U,5),IBPAYORS=$P(IBXDATA,U,6),IBSTAND=$P(IBXDATA,U,7)

	Q

NEXT3	;

	Q:$G(IBPTR)=""

	S IBBILL=""

	S IBBILL=$P($G(^DGCR(399.1,IBPTR,0)),U,1)

	I IBBILL'="" D LOAD

	Q

LOAD	;

	Q:IBBILL=""!(IBREVCDE="")!(IBEFFDAT="")

	I (IBPAYORS'="") S ^TMP($J,"IBORAT2A",IBBILL,IBREVCDE,IBPAYORS,IBEFFDAT)=IBAMOUNT_"^"_IBPAYORS_"^"_IBACTIVE_"^"_IBSTAND

	E  S IBPAYORS=IBCOUNT+1,^TMP($J,"IBORAT2A",IBBILL,IBREVCDE,IBPAYORS,IBEFFDAT)=IBAMOUNT_"^"_IBPAYORS_"^"_IBACTIVE_"^"_IBSTAND,IBCOUNT=IBCOUNT+1

	Q

IBORAT2A  ;ALB/RJS - FILTER FOR FILE 399.5- 1/22/92

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

 +2       ;THIS ROUTINE FILTERS FILE 399.5 TO BUILD A TEMPORARY

 +3       ;FILE NAMED TMP($J,"IBORAT2A") THIS FILE IS PASSED ON TO

 +4       ;ROUTINE IBORAT2B FOR FURTHER PROCESSING

START     ;

 +1        SET IBCOUNT=0

 +2        FOR IBRECNR=0:0

               SET IBRECNR=$ORDER(^DGCR(399.5,IBRECNR))

               IF IBRECNR'>0

                   QUIT 

               DO NEXT

END       ;

 +1        KILL IBACTIVE,IBAMOUNT,IBBILL,IBEFFDAT,IBPAYORS,IBPTR,IBRECNR,IBREVCDE,IBXDATA,IBSTAND,IBCOUNT

 +2        QUIT 

NEXT      ;

 +1        SET IBXDATA=$GET(^DGCR(399.5,IBRECNR,0))

 +2        IF IBXDATA'=""

               DO XTRACT

               DO NEXT3

 +3        QUIT 

XTRACT    ;

 +1        SET IBEFFDAT=$PIECE(IBXDATA,U,1)

           SET IBPTR=$PIECE(IBXDATA,U,2)

           SET IBREVCDE=$PIECE(IBXDATA,U,3)

           SET IBAMOUNT=$PIECE(IBXDATA,U,4)

           SET IBACTIVE=$PIECE(IBXDATA,U,5)

           SET IBPAYORS=$PIECE(IBXDATA,U,6)

           SET IBSTAND=$PIECE(IBXDATA,U,7)

 +2        QUIT 

NEXT3     ;

 +1        IF $GET(IBPTR)=""

               QUIT 

 +2        SET IBBILL=""

 +3        SET IBBILL=$PIECE($GET(^DGCR(399.1,IBPTR,0)),U,1)

 +4        IF IBBILL'=""

               DO LOAD

 +5        QUIT 

LOAD      ;

 +1        IF IBBILL=""!(IBREVCDE="")!(IBEFFDAT="")

               QUIT 

 +2        IF (IBPAYORS'="")

               SET ^TMP($JOB,"IBORAT2A",IBBILL,IBREVCDE,IBPAYORS,IBEFFDAT)=IBAMOUNT_"^"_IBPAYORS_"^"_IBACTIVE_"^"_IBSTAND

 +3       IF '$TEST

               SET IBPAYORS=IBCOUNT+1

               SET ^TMP($JOB,"IBORAT2A",IBBILL,IBREVCDE,IBPAYORS,IBEFFDAT)=IBAMOUNT_"^"_IBPAYORS_"^"_IBACTIVE_"^"_IBSTAND

               SET IBCOUNT=IBCOUNT+1

 +4        QUIT