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**;21-MAR-94
;;Per VHA Directive 10-93-142, 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 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)
. I $P($G(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),0)),"^",23)=2 Q
. 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
;***
;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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTED 3509 printed Jun 09, 2022@14:23:22 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**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, 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 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 IF $PIECE($GET(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),0)),"^",23)=2
QUIT
+19 IF $GET(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),"C",1,0))["Z06 MT via Edb"
QUIT
+20 DO ^IBAMTED1
+21 QUIT
End DoDot:1
+22 ;
+23 ; -- end medication copayment exemption processing
+24 ;
+25 ;IB*2.0*312
if +$$SWSTAT^IBBAPI()
QUIT
+26 ;
+27 ; Quit if supported variables are unavailable.
+28 if '$DATA(DFN)!('$DATA(DGMTA))!('$DATA(DGMTP))!('$DATA(DUZ))!('$DATA(DGMTINF))!('$DATA(DGMTACT))
QUIT
+29 ;
+30 ;***
+31 ;S XRTL=$ZU(0),XRTN="IBAMTED-1" D T0^%ZOSV ;start rt clock
+32 ;
+33 ; -- quit if copay exemption test
+34 IF $PIECE(DGMTA,"^",19)=2!($PIECE(DGMTP,"^",19)=2)
GOTO END
+35 ;
+36 ; Quit if test is a Category change resulting from a deleted test.
+37 ; on-line deletion
IF DGMTA]""
IF DGMTP]""
IF +DGMTA'=+DGMTP
GOTO END
+38 ; IVM 'delete' transmission
IF DGMTA]""
IF DGMTP]""
IF DGMTACT="DEL"
GOTO END
+39 ;
+40 ; Process Means Tests uploaded by IVM.
+41 IF DGMTACT="UPL"!(DGMTACT="DUP")
Begin DoDot:1
+42 ;
+43 ; - if IVM is uploading a verified test, create new MT charges
+44 IF $PIECE(DGMTP,"^",23)<2
IF $PIECE(DGMTA,"^",23)>1
IF '$$CK^DGMTUB(DGMTP)
IF $$CK^DGMTUB(DGMTA)
DO ^IBAMTV
QUIT
+45 ;
+46 ; - if IVM is sending a 'Delete' transmission, cancel previous charges
+47 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
+48 ;
+49 ; Quit if the most current Means Test was not altered.
+50 SET IBMT=$SELECT(DGMTA="":DGMTP,1:DGMTA)
+51 SET X=$$LST^DGMTU(DFN)
IF X
IF $PIECE(X,"^",2)>+IBMT
GOTO END
+52 ;
+53 ; Quit if an added or deleted test is a Required test.
+54 IF (DGMTA=""!(DGMTP=""))
IF $PIECE(IBMT,"^",3)=1
GOTO END
+55 ;
+56 ; Determine the billable status before and after the transaction.
+57 DO NOW^%DTC
SET IBCATCA=$$BIL^DGMTUB(DFN,%)
+58 SET IBCATCP=$SELECT(DGMTP="":$$ADD,DGMTA="":$$CK^DGMTUB(DGMTP),1:$$EDIT)
+59 ;
+60 ; Generate a bulletin if the patient's billing status has changed.
+61 IF (IBCATCP&('IBCATCA))!('IBCATCP&(IBCATCA))
Begin DoDot:1
+62 SET IBEFDT=$SELECT($PIECE(IBMT,"^",7):+$PIECE(IBMT,"^",7),1:+IBMT)
+63 ; hasn't been billed since going c->a
IF IBCATCP
IF 'IBCATCA
IF '$$CHG^IBAMTEDU(IBEFDT)
QUIT
+64 ; hasn't been treated since going a->c
IF 'IBCATCP
IF IBCATCA
IF '$$EP^IBAMTEDU(IBEFDT)
QUIT
+65 ; create bulletin
DO MT^IBAMTBU2
End DoDot:1
+66 ;
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)
