Routine: IBEFCOP

IBEFCOP	;ALB/AAS - INTEGRATED BILLING BACKGROUND FILER FOR RX COPAY ; 26-FEB-91

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

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

COPAY	;  - find pharmacy copay entries to process

	S IBHT=1

	S IBNOW="" F  S IBNOW=$O(^IB("APOST",IBNOW)) Q:'IBNOW  L +^IB("APOST",IBNOW):0 I $T S DFN=$O(^IB("APOST",IBNOW,"")) Q:'DFN  D C1 L -^IB("APOST",IBNOW)

C1	S IBSEQNO=$O(^IB("APOST",IBNOW,DFN,"")) Q:'IBSEQNO  S IBDUZ=$O(^IB("APOST",IBNOW,DFN,IBSEQNO,"")) Q:'IBDUZ  D C2

C2	D CHKDT S IBNOS=^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ) K ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ) D ^IBR

	D LAST

LAST	S DIE="^IBE(350.9,",DA=1,DR=".06///NOW" D ^DIE K DIE,DA,DR

CHKDT	; -- update dt if not the same

	N X,%

	D NOW^%DTC

	S:X'=DT DT=X

IBEFCOP   ;ALB/AAS - INTEGRATED BILLING BACKGROUND FILER FOR RX COPAY ; 26-FEB-91

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

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

 +3       ;

COPAY     ;  - find pharmacy copay entries to process

 +1       ;

 +2        SET IBHT=1

 +3        SET IBNOW=""

FOR

               SET IBNOW=$ORDER(^IB("APOST",IBNOW))

               IF 'IBNOW

                   QUIT

               LOCK +^IB("APOST",IBNOW):0

               IF $TEST

                   SET DFN=$ORDER(^IB("APOST",IBNOW,""))

                   IF 'DFN

                       QUIT

                   DO C1

                   LOCK -^IB("APOST",IBNOW)

 +4        QUIT

 +5       ;

C1         SET IBSEQNO=$ORDER(^IB("APOST",IBNOW,DFN,""))

           IF 'IBSEQNO

               QUIT

           SET IBDUZ=$ORDER(^IB("APOST",IBNOW,DFN,IBSEQNO,""))

           IF 'IBDUZ

               QUIT

           DO C2

 +1        QUIT

 +2       ;

C2         DO CHKDT

           SET IBNOS=^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ)

           KILL ^IB("APOST",IBNOW,DFN,IBSEQNO,IBDUZ)

           DO ^IBR

 +1        DO LAST

 +2        QUIT

 +3       ;

LAST       SET DIE="^IBE(350.9,"

           SET DA=1

           SET DR=".06///NOW"

           DO ^DIE

           KILL DIE,DA,DR

 +1        QUIT

 +2       ;

CHKDT     ; -- update dt if not the same

 +1        NEW X,%

 +2        DO NOW^%DTC

 +3        IF X'=DT

               SET DT=X

 +4        QUIT

IBEFCOP.m