IBARXEU4.m

IBARXEU4	;ALB/AAS - RX COPAY EXEMPTION CHECK IF PREVIOUSLY CANCELED ; 12-JAN-93

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

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

	;

CANDT	; -- set beginning and ending dates

	;    input     dfn     =: patient internal number

	;              ibedt   =: end date to cancel

	;              ibdt    =: beging date to cancel

	;

	;    output    ibcandt =: begin date^end date to cancel

	;

	N X

	;S IBCANDT=IBDT_"^"_IBEDT

	;

	; -- get last end date

	S X=+$O(^IBA(354.1,"ACAN",DFN,"")) S:X<0 X=-X D:'X CONV ;never previously cancelled

	I X,X>IBDT S IBDT=X

	;

	; -- only cancel back 1 year from today, or eff. legislation max

	I IBDT<$$MINUS^IBARXEU0(DT) S IBDT=$$MINUS^IBARXEU0(DT)

	I IBDT<$$STDATE^IBARXEU S IBDT=$$STDATE^IBARXEU

	S IBCANDT=IBDT_"^"_IBEDT

CANDTQ	Q

	;

CONV	; -- see if conversion done

	N X

	S X=$G(^IBE(350.9,1,3)) G:$P(X,"^",14) CONVQ ; conversion complete

	I $P(X,"^",3),DFN<$P(X,"^",4) G CONVQ ; patient already converted

	;

	; -- need to convert patient on the fly

	S IBDT=$$STDATE^IBARXEU

CONVQ	Q

	;

ARCAN(DFN,IBSTAT,IBDT,IBEDT)	; -- process cancellation with ar logic here

	;

	;   Input =:     dfn      patient internal entry number

	;             ibstat      patient status from $$rxexmt or $$rxst

	;               ibdt      beginning date to cancel

	;              ibedt      ending date to cancel

	;

	Q:'+IBSTAT  ; non-exempt patient

	;

	S:IBEDT>DT IBEDT=DT S:IBDT<$$STDATE^IBARXEU IBDT=$$STDATE^IBARXEU

	;

	; -- set begin and ending date, check x-ref

	S X=+$O(^IBA(354.1,"ACAN",DFN,"")) S:X<0 X=-X

	I X,X>IBDT S IBDT=X

	;

	; -- end date must be after begin date

	I IBDT>IBEDT G ARCANQ

	;

	; -- set begin and ending dates in last entry created

	D UPCAN

	;

	N IBWHER

	S ERR=0,IBWHER=17

	D EN1^PRCAX(DFN,IBDT,IBEDT,.ERR)

	I ERR]"",+ERR'=ERR S ^TMP("IB-ERROR",$J,DFN)=ERR,IBEXERR=10 S:'$D(IBJOB) IBJOB=11 D ^IBAERR K IBEXERR

ARCANQ	Q

	;

UPCAN	; -- update canceled date fields

	N X2

	S DIE="^IBA(354.1,",DR=".13////"_$P(IBCANDT,"^")_";.14////"_$P(IBCANDT,"^",2)

	S DA=$O(^($O(^IBA(354.1,"AIVDT",1,DFN,"")),0))

	S X2=$G(^IBA(354.1,DA,0))

	I $P(X2,"^",2)'=DFN!($P(X2,"^",14)) G UPCANQ

	D ^DIE

	K DIC,DIE,DA,DR,X

UPCANQ	Q

IBARXEU4  ;ALB/AAS - RX COPAY EXEMPTION CHECK IF PREVIOUSLY CANCELED ; 12-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       ;

CANDT     ; -- set beginning and ending dates

 +1       ;    input     dfn     =: patient internal number

 +2       ;              ibedt   =: end date to cancel

 +3       ;              ibdt    =: beging date to cancel

 +4       ;

 +5       ;    output    ibcandt =: begin date^end date to cancel

 +6       ;

 +7        NEW X

 +8       ;S IBCANDT=IBDT_"^"_IBEDT

 +9       ;

 +10      ; -- get last end date

 +11      ;never previously cancelled

           SET X=+$ORDER(^IBA(354.1,"ACAN",DFN,""))

           IF X<0

               SET X=-X

           IF 'X

               DO CONV

 +12       IF X

               IF X>IBDT

                   SET IBDT=X

 +13      ;

 +14      ; -- only cancel back 1 year from today, or eff. legislation max

 +15       IF IBDT<$$MINUS^IBARXEU0(DT)

               SET IBDT=$$MINUS^IBARXEU0(DT)

 +16       IF IBDT<$$STDATE^IBARXEU

               SET IBDT=$$STDATE^IBARXEU

 +17       SET IBCANDT=IBDT_"^"_IBEDT

CANDTQ     QUIT 

 +1       ;

CONV      ; -- see if conversion done

 +1        NEW X

 +2       ; conversion complete

           SET X=$GET(^IBE(350.9,1,3))

           IF $PIECE(X,"^",14)

               GOTO CONVQ

 +3       ; patient already converted

           IF $PIECE(X,"^",3)

               IF DFN<$PIECE(X,"^",4)

                   GOTO CONVQ

 +4       ;

 +5       ; -- need to convert patient on the fly

 +6        SET IBDT=$$STDATE^IBARXEU

CONVQ      QUIT 

 +1       ;

ARCAN(DFN,IBSTAT,IBDT,IBEDT) ; -- process cancellation with ar logic here

 +1       ;

 +2       ;   Input =:     dfn      patient internal entry number

 +3       ;             ibstat      patient status from $$rxexmt or $$rxst

 +4       ;               ibdt      beginning date to cancel

 +5       ;              ibedt      ending date to cancel

 +6       ;

 +7       ; non-exempt patient

           IF '+IBSTAT

               QUIT 

 +8       ;

 +9        IF IBEDT>DT

               SET IBEDT=DT

           IF IBDT<$$STDATE^IBARXEU

               SET IBDT=$$STDATE^IBARXEU

 +10      ;

 +11      ; -- set begin and ending date, check x-ref

 +12       SET X=+$ORDER(^IBA(354.1,"ACAN",DFN,""))

           IF X<0

               SET X=-X

 +13       IF X

               IF X>IBDT

                   SET IBDT=X

 +14      ;

 +15      ; -- end date must be after begin date

 +16       IF IBDT>IBEDT

               GOTO ARCANQ

 +17      ;

 +18      ; -- set begin and ending dates in last entry created

 +19       DO UPCAN

 +20      ;

 +21       NEW IBWHER

 +22       SET ERR=0

           SET IBWHER=17

 +23       DO EN1^PRCAX(DFN,IBDT,IBEDT,.ERR)

 +24       IF ERR]""

               IF +ERR'=ERR

                   SET ^TMP("IB-ERROR",$JOB,DFN)=ERR

                   SET IBEXERR=10

                   IF '$DATA(IBJOB)

                       SET IBJOB=11

                   DO ^IBAERR

                   KILL IBEXERR

ARCANQ     QUIT 

 +1       ;

UPCAN     ; -- update canceled date fields

 +1        NEW X2

 +2        SET DIE="^IBA(354.1,"

           SET DR=".13////"_$PIECE(IBCANDT,"^")_";.14////"_$PIECE(IBCANDT,"^",2)

 +3        SET DA=$ORDER(^($ORDER(^IBA(354.1,"AIVDT",1,DFN,"")),0))

 +4        SET X2=$GET(^IBA(354.1,DA,0))

 +5        IF $PIECE(X2,"^",2)'=DFN!($PIECE(X2,"^",14))

               GOTO UPCANQ

 +6        DO ^DIE

 +7        KILL DIC,DIE,DA,DR,X

UPCANQ     QUIT