source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTED.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1IBAMTED ;ALB/CPM,GN,PHH,EG - MEANS TEST EVENT DRIVER INTERFACE ; 11/30/05 1:48pm
2 ;;2.0;INTEGRATED BILLING;**15,255,269,321,312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;IB*2*269 add IVM converted RX Copay Test update calls to a new API.
6 ;
7 ; -- do medication copayment exemption processing
8 ;
9 ;Z06 processing for RX Copay then Quit
10 I $D(EASZ06),DGMTYPT=2 D ^IBAMTED2 G END ;IB*2*269
11 ;Original Non-Z06 Copay processing
12 I '$D(EASZ06) D
13 . ;this routine is called from the DG namespace and IB namespace
14 . ;when coming in from the DG namespace, variable DGMTD and DGMTDT is
15 . ;used to define the means test test. When coming in
16 . ;from the IB namespace, variable IBDT OR IVMMTDT is used
17 . I '$D(IBDT) N IBDT
18 . S IBDT=$S($D(IBDT):IBDT,$D(IVMMTDT):IVMMTDT,$D(DGMTDT):DGMTDT,$D(DGMTD):DGMTD,1:0)
19 . I $P($G(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),0)),"^",23)=2 Q
20 . I $G(^DGMT(408.31,+$$LST^DGMTCOU1(DFN,IBDT,2),"C",1,0))["Z06 MT via Edb" Q
21 . D ^IBAMTED1
22 . Q
23 ;
24 ; -- end medication copayment exemption processing
25 ;
26 Q:+$$SWSTAT^IBBAPI() ;IB*2.0*312
27 ;
28 ; Quit if supported variables are unavailable.
29 Q:'$D(DFN)!('$D(DGMTA))!('$D(DGMTP))!('$D(DUZ))!('$D(DGMTINF))!('$D(DGMTACT))
30 ;
31 ;***
32 ;S XRTL=$ZU(0),XRTN="IBAMTED-1" D T0^%ZOSV ;start rt clock
33 ;
34 ; -- quit if copay exemption test
35 I $P(DGMTA,"^",19)=2!($P(DGMTP,"^",19)=2) G END
36 ;
37 ; Quit if test is a Category change resulting from a deleted test.
38 I DGMTA]"",DGMTP]"",+DGMTA'=+DGMTP G END ; on-line deletion
39 I DGMTA]"",DGMTP]"",DGMTACT="DEL" G END ; IVM 'delete' transmission
40 ;
41 ; Process Means Tests uploaded by IVM.
42 I DGMTACT="UPL"!(DGMTACT="DUP") D G END
43 .;
44 .; - if IVM is uploading a verified test, create new MT charges
45 .I $P(DGMTP,"^",23)<2,$P(DGMTA,"^",23)>1,'$$CK^DGMTUB(DGMTP),$$CK^DGMTUB(DGMTA) D ^IBAMTV Q
46 .;
47 .; - if IVM is sending a 'Delete' transmission, cancel previous charges
48 .I $P(DGMTP,"^",23)>1,$P(DGMTA,"^",23)<2,$$CK^DGMTUB(DGMTP),'$$CK^DGMTUB(DGMTA) D CANC^IBAMTV
49 ;
50 ; Quit if the most current Means Test was not altered.
51 S IBMT=$S(DGMTA="":DGMTP,1:DGMTA)
52 S X=$$LST^DGMTU(DFN) I X,$P(X,"^",2)>+IBMT G END
53 ;
54 ; Quit if an added or deleted test is a Required test.
55 I (DGMTA=""!(DGMTP="")),$P(IBMT,"^",3)=1 G END
56 ;
57 ; Determine the billable status before and after the transaction.
58 D NOW^%DTC S IBCATCA=$$BIL^DGMTUB(DFN,%)
59 S IBCATCP=$S(DGMTP="":$$ADD,DGMTA="":$$CK^DGMTUB(DGMTP),1:$$EDIT)
60 ;
61 ; Generate a bulletin if the patient's billing status has changed.
62 I (IBCATCP&('IBCATCA))!('IBCATCP&(IBCATCA)) D
63 .S IBEFDT=$S($P(IBMT,"^",7):+$P(IBMT,"^",7),1:+IBMT)
64 .I IBCATCP,'IBCATCA,'$$CHG^IBAMTEDU(IBEFDT) Q ; hasn't been billed since going c->a
65 .I 'IBCATCP,IBCATCA,'$$EP^IBAMTEDU(IBEFDT) Q ; hasn't been treated since going a->c
66 .D MT^IBAMTBU2 ; create bulletin
67 ;
68END K IBARR,IBCANCEL,IBCATCA,IBCATCP,IBDIQ,IBDUZ,IBEFDT,IBMT,IBI,IBC,IBPT,IBT
69 K DIC,DIQ,DR,DA,VA,VAERR,VAEL,X,X1,X2,XMDUZ,XMTEXT,XMY,XMSUB
70 ;***
71 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBAMTED" D T1^%ZOSV ;stop rt clock
72 Q
73 ;
74 ;
75ADD() ; Determine the billable status before adding a Means Test.
76 S X1=$S($P(DGMTA,"^",3)=3:+DGMTA,1:+$P(DGMTA,"^",7)\1),X2=-1 D C^%DTC
77 Q $$BIL^DGMTUB(DFN,X)
78 ;
79 ;
80EDIT() ; Determine the billable status before editing a Means Test.
81 I $P(DGMTP,"^",3)'=1 Q $$CK^DGMTUB(DGMTP)
82 S X1=+DGMTP,X2=-1 D C^%DTC Q $$BIL^DGMTUB(DFN,X)
Note: See TracBrowser for help on using the repository browser.