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

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBCNSEVT ;ALB/AAS - NEW INSURANCE POLICY EVENT DRIVER ; 12-DEC-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;**6**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; -- Invokes items on the IB NEW INSURANCE EVENT protocol menu
6 ; Input =: dfn = patient file ien
7 ; ibevtp0 = insurance type zeroth node of policy
8 ; before editing
9 ; ibevtp1 = insurance type 1 node of policy
10 ; before editing
11 ; ibevtp2 = insurance type 2 node of policy
12 ; before editing
13 ; ibevta0 = insurance type zeroth node of new policy
14 ; contains effective/expiration dates
15 ; ibevta1 = insurance type 1 node of new policy
16 ; contains date added and by whom
17 ; ibevta2 = insurance type 2 node of new policy
18 ; ibcdfn = internal number of policy as in ^dpt(dfn,
19 ; .312,ibcdfn,0))
20 ; ibevtact = flag indicating whether action is add, edit
21 ; or delete
22 ;
23 ;
24 N DTOUT,DIROUT
25 ;S X=$O(^ORD(101,"B","IBCN NEW INSURANCE EVENTS",0))_";ORD(101," D EN1^XQOR:X
26 I IBEVTP0=IBEVTA0,IBEVTP1=IBEVTA1,IBEVTP2=IBEVTA2 G EVTQ
27 S X="IBCN NEW INSURANCE EVENTS",DIC=101 D EN1^XQOR
28EVTQ K X,DIC,IBEVTP0,IBEVTP1,IBEVTP2,IBEVTA0,IBEVTA1,IBEVTA2,IBEVTACT
29 Q
30 ;
31BEFORE ; -- get insurance type values before adding/editing
32 ;
33 I $G(IBNEW) S (IBEVTP0,IBEVTP1,IBEVTP2)="" G BEFQ
34 S IBEVTP0=$G(^DPT(DFN,.312,IBCDFN,0))
35 S IBEVTP1=$G(^DPT(DFN,.312,IBCDFN,1))
36 S IBEVTP2=$G(^DPT(DFN,.312,IBCDFN,2))
37BEFQ Q
38 ;
39AFTER ; -- get insurance type values after adding/editing. set action flag.
40 ; -- get exemption after change
41 ; input =: dfn = patient file ien
42 ;
43 S IBEVTA0=$G(^DPT(DFN,.312,IBCDFN,0))
44 S IBEVTA1=$G(^DPT(DFN,.312,IBCDFN,1))
45 S IBEVTA2=$G(^DPT(DFN,.312,IBCDFN,2))
46 I IBEVTP0="",IBEVTA0'="" S IBEVTACT="ADD"
47 I IBEVTP0'="",IBEVTA0'="" S IBEVTACT="EDT"
48 I IBEVTP0'="",IBEVTA0="" S IBEVTACT="DEL"
49 Q
Note: See TracBrowser for help on using the repository browser.