IBAMTED.m

IBAMTED	;ALB/CPM - MEANS TEST EVENT DRIVER INTERFACE ; 21-FEB-92

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

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

	;

	; -- do medication copayment exemption processing

	D ^IBAMTED1

	;

	; Quit if supported variables are unavailable.

	Q:'$D(DFN)!('$D(DGMTA))!('$D(DGMTP))!('$D(DUZ))!('$D(DGMTINF))

	;

	;***

	;S XRTL=$ZU(0),XRTN="IBAMTED-1" D T0^%ZOSV ;start rt clock

	;

	; -- quit if copay exemption test

	I $P(DGMTA,"^",19)=2!($P(DGMTP,"^",19)=2) G END

	;

	; Quit if test is a Category change resulting from a deleted test.

	I DGMTA]"",DGMTP]"",+DGMTA'=+DGMTP G END

	;

	; Quit if the most current Means Test was not altered.

	S IBMT=$S(DGMTA="":DGMTP,1:DGMTA)

	S X=$$LST^DGMTU(DFN) I X,$P(X,"^",2)>+IBMT G END

	;

	; Quit if an added or deleted test is a Required test.

	I (DGMTA=""!(DGMTP="")),$P(IBMT,"^",3)=1 G END

	;

	; Determine the billable status before and after the transaction.

	D NOW^%DTC S IBCATCA=$$BIL^DGMTUB(DFN,%)

	S IBCATCP=$S(DGMTP="":$$ADD,DGMTA="":$$CK^DGMTUB(DGMTP),1:$$EDIT)

	;

	; Generate a bulletin if the patient's billing status has changed.

	I (IBCATCP&('IBCATCA))!('IBCATCP&(IBCATCA)) D

	.S IBEFDT=$S($P(IBMT,"^",7):+$P(IBMT,"^",7),1:+IBMT)

	.I IBCATCP,'IBCATCA,'$$CHG^IBAMTEDU(IBEFDT) Q  ; hasn't been billed since going c->a

	.I 'IBCATCP,IBCATCA,'$$EP^IBAMTEDU(IBEFDT) Q  ; hasn't been treated since going a->c

	.D MT^IBAMTBU2 ; create bulletin

	;

END	K IBARR,IBCANCEL,IBCATCA,IBCATCP,IBDIQ,IBDUZ,IBEFDT,IBMT,IBI,IBC,IBPT,IBT

	K DIC,DIQ,DR,DA,VA,VAERR,VAEL,X,X1,X2,XMDUZ,XMTEXT,XMY,XMSUB

	;***

	;I $D(XRT0) S:'$D(XRTN) XRTN="IBAMTED" D T1^%ZOSV ;stop rt clock

	Q

	;

	;

ADD()	; Determine the billable status before adding a Means Test.

	S X1=$S($P(DGMTA,"^",3)=3:+DGMTA,1:+$P(DGMTA,"^",7)\1),X2=-1 D C^%DTC

	Q $$BIL^DGMTUB(DFN,X)

	;

	;

EDIT()	; Determine the billable status before editing a Means Test.

	I $P(DGMTP,"^",3)'=1 Q $$CK^DGMTUB(DGMTP)

	S X1=+DGMTP,X2=-1 D C^%DTC Q $$BIL^DGMTUB(DFN,X)

IBAMTED   ;ALB/CPM - MEANS TEST EVENT DRIVER INTERFACE ; 21-FEB-92

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

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

 +3       ;

 +4       ; -- do medication copayment exemption processing

 +5        DO ^IBAMTED1

 +6       ;

 +7       ; Quit if supported variables are unavailable.

 +8        IF '$DATA(DFN)!('$DATA(DGMTA))!('$DATA(DGMTP))!('$DATA(DUZ))!('$DATA(DGMTINF))

               QUIT 

 +9       ;

 +10      ;***

 +11      ;S XRTL=$ZU(0),XRTN="IBAMTED-1" D T0^%ZOSV ;start rt clock

 +12      ;

 +13      ; -- quit if copay exemption test

 +14       IF $PIECE(DGMTA,"^",19)=2!($PIECE(DGMTP,"^",19)=2)

               GOTO END

 +15      ;

 +16      ; Quit if test is a Category change resulting from a deleted test.

 +17       IF DGMTA]""

               IF DGMTP]""

                   IF +DGMTA'=+DGMTP

                       GOTO END

 +18      ;

 +19      ; Quit if the most current Means Test was not altered.

 +20       SET IBMT=$SELECT(DGMTA="":DGMTP,1:DGMTA)

 +21       SET X=$$LST^DGMTU(DFN)

           IF X

               IF $PIECE(X,"^",2)>+IBMT

                   GOTO END

 +22      ;

 +23      ; Quit if an added or deleted test is a Required test.

 +24       IF (DGMTA=""!(DGMTP=""))

               IF $PIECE(IBMT,"^",3)=1

                   GOTO END

 +25      ;

 +26      ; Determine the billable status before and after the transaction.

 +27       DO NOW^%DTC

           SET IBCATCA=$$BIL^DGMTUB(DFN,%)

 +28       SET IBCATCP=$SELECT(DGMTP="":$$ADD,DGMTA="":$$CK^DGMTUB(DGMTP),1:$$EDIT)

 +29      ;

 +30      ; Generate a bulletin if the patient's billing status has changed.

 +31       IF (IBCATCP&('IBCATCA))!('IBCATCP&(IBCATCA))

               Begin DoDot:1

 +32               SET IBEFDT=$SELECT($PIECE(IBMT,"^",7):+$PIECE(IBMT,"^",7),1:+IBMT)

 +33      ; hasn't been billed since going c->a

                   IF IBCATCP

                       IF 'IBCATCA

                           IF '$$CHG^IBAMTEDU(IBEFDT)

                               QUIT 

 +34      ; hasn't been treated since going a->c

                   IF 'IBCATCP

                       IF IBCATCA

                           IF '$$EP^IBAMTEDU(IBEFDT)

                               QUIT 

 +35      ; create bulletin

                   DO MT^IBAMTBU2

               End DoDot:1

 +36      ;

END        KILL IBARR,IBCANCEL,IBCATCA,IBCATCP,IBDIQ,IBDUZ,IBEFDT,IBMT,IBI,IBC,IBPT,IBT

 +1        KILL DIC,DIQ,DR,DA,VA,VAERR,VAEL,X,X1,X2,XMDUZ,XMTEXT,XMY,XMSUB

 +2       ;***

 +3       ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAMTED" D T1^%ZOSV ;stop rt clock

 +4        QUIT 

 +5       ;

 +6       ;

ADD()     ; Determine the billable status before adding a Means Test.

 +1        SET X1=$SELECT($PIECE(DGMTA,"^",3)=3:+DGMTA,1:+$PIECE(DGMTA,"^",7)\1)

           SET X2=-1

           DO C^%DTC

 +2        QUIT $$BIL^DGMTUB(DFN,X)

 +3       ;

 +4       ;

EDIT()    ; Determine the billable status before editing a Means Test.

 +1        IF $PIECE(DGMTP,"^",3)'=1

               QUIT $$CK^DGMTUB(DGMTP)

 +2        SET X1=+DGMTP

           SET X2=-1

           DO C^%DTC

           QUIT $$BIL^DGMTUB(DFN,X)