source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSA2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1IBCNSA2 ;ALB/NLR - ANNUAL BENEFITS EDIT, DIE CALLS ; 28-MAY-1993
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ED(IBT) ;
6 D FULL^VALM1 W !!
7 D SAVEAB
8 L +^IBA(355.4,+IBCAB):5 I '$T D LOCKED^IBTRCD1 G EDQ
9 S DIE="^IBA(355.4,",DA=IBCAB
10 S DR=IBT
11 D ^DIE K DIE,DIC,DA,DR
12 D COMP
13 I IBDIF=1 D EDUP
14 D EXIT
15 L -^IBA(355.4,+IBCAB)
16EDQ Q
17 ;
18SAVEAB ;
19 K ^TMP($J,"IBAB")
20 S ^TMP($J,"IBAB",355.4,IBCAB,0)=$G(^IBA(355.4,IBCAB,0))
21 S ^TMP($J,"IBAB",355.4,IBCAB,1)=$G(^IBA(355.4,IBCAB,1))
22 S ^TMP($J,"IBAB",355.4,IBCAB,2)=$G(^IBA(355.4,IBCAB,2))
23 S ^TMP($J,"IBAB",355.4,IBCAB,3)=$G(^IBA(355.4,IBCAB,3))
24 S ^TMP($J,"IBAB",355.4,IBCAB,4)=$G(^IBA(355.4,IBCAB,4))
25 S ^TMP($J,"IBAB",355.4,IBCAB,5)=$G(^IBA(355.4,IBCAB,5))
26 Q
27COMP ;
28 S IBDIF=0
29 I $G(^IBA(355.4,IBCAB,0))'=^TMP($J,"IBAB",355.4,IBCAB,0) S IBDIF=1 Q
30 I $G(^IBA(355.4,IBCAB,1))'=^TMP($J,"IBAB",355.4,IBCAB,1) S IBDIF=1 Q
31 I $G(^IBA(355.4,IBCAB,2))'=^TMP($J,"IBAB",355.4,IBCAB,2) S IBDIF=1 Q
32 I $G(^IBA(355.4,IBCAB,3))'=^TMP($J,"IBAB",355.4,IBCAB,3) S IBDIF=1 Q
33 I $G(^IBA(355.4,IBCAB,4))'=^TMP($J,"IBAB",355.4,IBCAB,4) S IBDIF=1 Q
34 I $G(^IBA(355.4,IBCAB,5))'=^TMP($J,"IBAB",355.4,IBCAB,5) S IBDIF=1 Q
35 Q
36EDUP ; -- enter date and user if editing has taken place
37 S DIE="^IBA(355.4,",DA=IBCAB
38 S DR="1.05///NOW;1.06////"_DUZ
39 D ^DIE K DIE,DIC,DA,DR
40 Q
41CY ;
42 D FULL^VALM1 W !!
43 S IBYR1=IBYR K IBYR D INIT^IBCNSA
44 I $D(VALMQUIT) S IBYR=IBYR1 K VALMQUIT D EXITRP
45 I IBYR=IBYR1 D
46 .K IBYR1,VALMQUIT D EXITRP
47 E D EXIT
48 Q
49 ;
50 ;
51EXIT D HDR^IBCNSA("Annual Benefits"),BLD^IBCNSA
52EXITRP K VALMQUIT S VALMBCK="R"
53 Q
54 ;
55DATECHK ; -- called from input transform from annual benefits (355.4,.01)
56 ; make sure benefit years do not overlap
57 ; kills x if not okay
58 ;
59 Q:'$D(X)
60 N BEFORE,AFTER,MINUS,PLUS,ZZ
61 S MINUS=X-10000
62 S PLUS=X+10000
63 I '$G(IBCPOL) S IBCPOL=$P($G(^IBA(355.4,$G(DA),0)),"^",2)
64 Q:'IBCPOL
65 ;
66 ; -- find most recent entry
67 S ZZ=-$O(^IBA(355.4,"APY",IBCPOL,""))
68 I 'ZZ Q ;if not prior entires quit.
69 ;
70 ; -- if x>most recent entry
71 I X>ZZ K:X<(ZZ+10000) X Q
72 ;
73 Q:'$D(X)
74 ;
75 ; -- find policy date prior to (before or less than) x
76 S BEFORE=-$O(^IBA(355.4,"APY",+IBCPOL,-X))
77 S AFTER=-$O(^IBA(355.4,"APY",+IBCPOL,-PLUS))
78 ;
79 I 'BEFORE D Q
80 .I AFTER=X Q
81 .I AFTER,AFTER>X K X
82 .Q
83 ;
84 ; -- if it exists,not exactly one year,if within one year of prior year
85 I BEFORE D Q
86 .I BEFORE=MINUS Q
87 .I BEFORE>MINUS K X Q
88 .I X=AFTER Q
89 .I AFTER>X K X
90 .Q
91 ;
92 Q
Note: See TracBrowser for help on using the repository browser.