IBAMTED ;ALB/CPM,GN,PHH,EG - MEANS TEST EVENT DRIVER INTERFACE ; 11/30/05 1:48pm
;;2.0;INTEGRATED BILLING;**15,255,269,321,312,751**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
;IB*2*269 add IVM converted RX Copay Test update calls to a new API.
;
; -- do medication copayment exemption processing
;
;Z06 processing for RX Copay then Quit
I $D(EASZ06),DGMTYPT=2 D ^IBAMTED2 G END ;IB*2*269
;Original Non-Z06 Copay processing
I '$D(EASZ06) D
. ;this routine is called from the DG namespace and IB namespace
. ;when coming in from the DG namespace, variable DGMTD and DGMTDT is
. ;used to define the means test. When coming in
. ;from the IB namespace, variable IBDT OR IVMMTDT is used
. I '$D(IBDT) N IBDT
. S IBDT=$S($D(IBDT):IBDT,$D(IVMMTDT):IVMMTDT,$D(DGMTDT):DGMTDT,$D(DGMTD):DGMTD,1:0)
. S IBFLAG=0 ;RTW IB*2*751
. I $P($G(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),0)),"^",23)=2 D IVM Q:IBFLAG=0 ;RTW IB*2*751
. I $G(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),"C",1,0))["Z06 MT via Edb" Q
. D ^IBAMTED1
. Q
;
; -- end medication copayment exemption processing
;
Q:+$$SWSTAT^IBBAPI() ;IB*2.0*312
;
; Quit if supported variables are unavailable.
Q:'$D(DFN)!('$D(DGMTA))!('$D(DGMTP))!('$D(DUZ))!('$D(DGMTINF))!('$D(DGMTACT))
;
;***
;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 ; on-line deletion
I DGMTA]"",DGMTP]"",DGMTACT="DEL" G END ; IVM 'delete' transmission
;
; Process Means Tests uploaded by IVM.
I DGMTACT="UPL"!(DGMTACT="DUP") D G END
.;
.; - if IVM is uploading a verified test, create new MT charges
.I $P(DGMTP,"^",23)<2,$P(DGMTA,"^",23)>1,'$$CK^DGMTUB(DGMTP),$$CK^DGMTUB(DGMTA) D ^IBAMTV Q
.;
.; - if IVM is sending a 'Delete' transmission, cancel previous charges
.I $P(DGMTP,"^",23)>1,$P(DGMTA,"^",23)<2,$$CK^DGMTUB(DGMTP),'$$CK^DGMTUB(DGMTA) D CANC^IBAMTV
;
; 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,IBFLAG,IBMTYR,IBTHSH
;***
;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)
IVM ;If last MEANS TEST was an IVM check RX THRESHOLDS 354.3 against the current year means test.
;need to add code for dependent status of the patient and use that number. IB*2.0*751
;rx thresholds are based on number of dependents.
S IBMTYR=$O(^DG(43,1,"MT",""),-1)
S IBTHSH=$P(^DG(43,1,"MT",IBMTYR,0),U,2)
I $D(DGMTA),$P(DGMTA,U,4)<IBTHSH S IBFLAG=1
D ^IBAMTED1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTED 3974 printed Dec 13, 2024@02:06:33 Page 2
IBAMTED ;ALB/CPM,GN,PHH,EG - MEANS TEST EVENT DRIVER INTERFACE ; 11/30/05 1:48pm
+1 ;;2.0;INTEGRATED BILLING;**15,255,269,321,312,751**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IB*2*269 add IVM converted RX Copay Test update calls to a new API.
+5 ;
+6 ; -- do medication copayment exemption processing
+7 ;
+8 ;Z06 processing for RX Copay then Quit
+9 ;IB*2*269
IF $DATA(EASZ06)
IF DGMTYPT=2
DO ^IBAMTED2
GOTO END
+10 ;Original Non-Z06 Copay processing
+11 IF '$DATA(EASZ06)
Begin DoDot:1
+12 ;this routine is called from the DG namespace and IB namespace
+13 ;when coming in from the DG namespace, variable DGMTD and DGMTDT is
+14 ;used to define the means test. When coming in
+15 ;from the IB namespace, variable IBDT OR IVMMTDT is used
+16 IF '$DATA(IBDT)
NEW IBDT
+17 SET IBDT=$SELECT($DATA(IBDT):IBDT,$DATA(IVMMTDT):IVMMTDT,$DATA(DGMTDT):DGMTDT,$DATA(DGMTD):DGMTD,1:0)
+18 ;RTW IB*2*751
SET IBFLAG=0
+19 ;RTW IB*2*751
IF $PIECE($GET(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),0)),"^",23)=2
DO IVM
if IBFLAG=0
QUIT
+20 IF $GET(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),"C",1,0))["Z06 MT via Edb"
QUIT
+21 DO ^IBAMTED1
+22 QUIT
End DoDot:1
+23 ;
+24 ; -- end medication copayment exemption processing
+25 ;
+26 ;IB*2.0*312
if +$$SWSTAT^IBBAPI()
QUIT
+27 ;
+28 ; Quit if supported variables are unavailable.
+29 if '$DATA(DFN)!('$DATA(DGMTA))!('$DATA(DGMTP))!('$DATA(DUZ))!('$DATA(DGMTINF))!('$DATA(DGMTACT))
QUIT
+30 ;
+31 ;***
+32 ;S XRTL=$ZU(0),XRTN="IBAMTED-1" D T0^%ZOSV ;start rt clock
+33 ;
+34 ; -- quit if copay exemption test
+35 IF $PIECE(DGMTA,"^",19)=2!($PIECE(DGMTP,"^",19)=2)
GOTO END
+36 ;
+37 ; Quit if test is a Category change resulting from a deleted test.
+38 ; on-line deletion
IF DGMTA]""
IF DGMTP]""
IF +DGMTA'=+DGMTP
GOTO END
+39 ; IVM 'delete' transmission
IF DGMTA]""
IF DGMTP]""
IF DGMTACT="DEL"
GOTO END
+40 ;
+41 ; Process Means Tests uploaded by IVM.
+42 IF DGMTACT="UPL"!(DGMTACT="DUP")
Begin DoDot:1
+43 ;
+44 ; - if IVM is uploading a verified test, create new MT charges
+45 IF $PIECE(DGMTP,"^",23)<2
IF $PIECE(DGMTA,"^",23)>1
IF '$$CK^DGMTUB(DGMTP)
IF $$CK^DGMTUB(DGMTA)
DO ^IBAMTV
QUIT
+46 ;
+47 ; - if IVM is sending a 'Delete' transmission, cancel previous charges
+48 IF $PIECE(DGMTP,"^",23)>1
IF $PIECE(DGMTA,"^",23)<2
IF $$CK^DGMTUB(DGMTP)
IF '$$CK^DGMTUB(DGMTA)
DO CANC^IBAMTV
End DoDot:1
GOTO END
+49 ;
+50 ; Quit if the most current Means Test was not altered.
+51 SET IBMT=$SELECT(DGMTA="":DGMTP,1:DGMTA)
+52 SET X=$$LST^DGMTU(DFN)
IF X
IF $PIECE(X,"^",2)>+IBMT
GOTO END
+53 ;
+54 ; Quit if an added or deleted test is a Required test.
+55 IF (DGMTA=""!(DGMTP=""))
IF $PIECE(IBMT,"^",3)=1
GOTO END
+56 ;
+57 ; Determine the billable status before and after the transaction.
+58 DO NOW^%DTC
SET IBCATCA=$$BIL^DGMTUB(DFN,%)
+59 SET IBCATCP=$SELECT(DGMTP="":$$ADD,DGMTA="":$$CK^DGMTUB(DGMTP),1:$$EDIT)
+60 ;
+61 ; Generate a bulletin if the patient's billing status has changed.
+62 IF (IBCATCP&('IBCATCA))!('IBCATCP&(IBCATCA))
Begin DoDot:1
+63 SET IBEFDT=$SELECT($PIECE(IBMT,"^",7):+$PIECE(IBMT,"^",7),1:+IBMT)
+64 ; hasn't been billed since going c->a
IF IBCATCP
IF 'IBCATCA
IF '$$CHG^IBAMTEDU(IBEFDT)
QUIT
+65 ; hasn't been treated since going a->c
IF 'IBCATCP
IF IBCATCA
IF '$$EP^IBAMTEDU(IBEFDT)
QUIT
+66 ; create bulletin
DO MT^IBAMTBU2
End DoDot:1
+67 ;
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,IBFLAG,IBMTYR,IBTHSH
+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)
IVM ;If last MEANS TEST was an IVM check RX THRESHOLDS 354.3 against the current year means test.
+1 ;need to add code for dependent status of the patient and use that number. IB*2.0*751
+2 ;rx thresholds are based on number of dependents.
+3 SET IBMTYR=$ORDER(^DG(43,1,"MT",""),-1)
+4 SET IBTHSH=$PIECE(^DG(43,1,"MT",IBMTYR,0),U,2)
+5 IF $DATA(DGMTA)
IF $PIECE(DGMTA,U,4)<IBTHSH
SET IBFLAG=1
+6 DO ^IBAMTED1
+7 QUIT
