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

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

initial load of WorldVistAEHR
File size: 3.7 KB
RevLine 
[613]1IBCNSD ;ALB/NLR - BENEFITS USED BY DATE EDIT ; 9-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCNS BENEFITS USED BY DATE
6 K VALMQUIT,VALMEVL,XQORS,^TMP("XQORS",$J),DIC,%DT,IBYR
7 S IBCHANGE="OKAY"
8 D EN^VALM("IBCNS BENEFITS USED BY DATE")
9ENQ Q
10 ;
11INIT ;
12 K VALMQUIT
13 S VALMCNT=0,VALMBG=1
14 I '$G(IBCDFN) S IBCDFN=$P($G(IBPPOL),"^",4)
15 I $G(IBYR)'?7N K IBYR
16 I '$G(IBCPOL) D GETPOL^IBCNSA Q:$D(VALMQUIT)
17 I '$G(IBYR) D GETYR2^IBCNSA Q:$D(VALMQUIT)
18 S IBCBU=$$BU^IBCNSU1(DFN,IBCPOL,IBYR,IBCDFN,"")
19 I '$G(IBCBU) S VALMQUIT="" Q
20 S IBCBUD=$G(^IBA(355.5,+IBCBU,0))
21 S IBCGN=$$GRP^IBCNS(IBCPOL)
22 S IBPAT=1
23 K ^TMP("IBCNSD",$J)
24 D BLD
25 Q
26BLD ;
27 S VALMCNT=28
28 F I=1:1:30 D BLANK(.I)
29 S IBCBUD=$G(^IBA(355.5,+IBCBU,0))
30 S IBCBUD1=$G(^IBA(355.5,+IBCBU,1))
31 D POL,OPT,INPT,USERINF,ADDCOM
32 Q
33POL ; --Policy information region
34 N START,OFFSET
35 S START=1,OFFSET=3
36 D SET^IBCNSP(START,OFFSET+5," Policy Information ",IORVON,IORVOFF)
37 ;D SET^IBCNSP(START+1,OFFSET+12," Group: "_IBCGN)
38 ;D SET^IBCNSP(START+2,OFFSET+10," Patient: "_$P($G(^DPT($P(IBCBUD,U,2),0)),U,1))
39 S Y=$P(IBCBUD,U,3)
40 D D^DIQ
41 S IBYE=Y
42 ;D SET^IBCNSP(START+3,OFFSET+13," Year: "_IBYE)
43 D SET^IBCNSP(START+1,OFFSET+8," Deduct. Met?: "_$$YN^IBCNSM($P(IBCBUD,U,4)))
44 ;D SET^IBCNSP(START+1,OFFSET+5," Deduct. Met?: "_$S($P($G(IBCBUD),U,8)=1:"YES",$P($G(IBCBUD),U,4)=0:"NO",1:""))
45 D SET^IBCNSP(START+2,OFFSET+4," Amt. of Ded. Met: "_$P(IBCBUD,U,5))
46 D SET^IBCNSP(START+3,OFFSET+4," Pre-exist. Cond.: "_$P(IBCBUD,U,15))
47 D SET^IBCNSP(START+4,OFFSET+1," Coord. of Ben. Data: "_$P(IBCBUD,U,16))
48 Q
49USERINF ;
50 S IBDUZ=$P(IBCBUD1,U,2)
51 N START,OFFSET
52 S START=15,OFFSET=2
53 D SET^IBCNSP(START,OFFSET+3," User Information ",IORVON,IORVOFF)
54 D SET^IBCNSP(START+1,OFFSET+6,"Entered By: "_$P($G(^VA(200,+IBDUZ,0)),U))
55 D SET^IBCNSP(START+2,OFFSET+6,"Entered On: "_$$DAT1^IBOUTL($P(IBCBUD1,U,1)))
56 S IBDUZ=$P(IBCBUD1,U,6)
57 D SET^IBCNSP(START+3,OFFSET+1,"Last Updated By: "_$P($G(^VA(200,+IBDUZ,0)),U))
58 D SET^IBCNSP(START+4,OFFSET+1,"Last Updated On: "_$$DAT1^IBOUTL($P(IBCBUD1,U,5)))
59 Q
60 ;
61CONTACT ; -- Insurance Contact Information
62 Q
63 ;
64OPT ;
65 N START,OFFSET
66 S START=1,OFFSET=42
67 D SET^IBCNSP(START,OFFSET+7," Outpatient Deductibles ",IORVON,IORVOFF)
68 D SET^IBCNSP(START+1,OFFSET+13,"Deduct. Met?: "_$S($P($G(IBCBUD),U,8)=1:"YES",$P($G(IBCBUD),U,8)=0:"NO",1:""))
69 D SET^IBCNSP(START+2,OFFSET+9,"Amt. of Ded. Met: "_$P(IBCBUD,U,9))
70 D SET^IBCNSP(START+3,OFFSET+6,"MH Ded. (Opt.) Met?: "_$S($P($G(IBCBUD),U,13)=1:"YES",$P($G(IBCBUD),U,13)=0:"NO",1:""))
71 D SET^IBCNSP(START+4,OFFSET+6,"Amt. of MH Ded. Met: "_$P(IBCBUD,U,14))
72 D SET^IBCNSP(START+5,OFFSET+4,"Amt. Lifet. Max. Used: "_$P(IBCBUD,U,10))
73 D SET^IBCNSP(START+6,OFFSET+1,"Amt. MH Lifet. Max. Used: "_$P(IBCBUD,U,20))
74 Q
75INPT ;
76 N START,OFFSET
77 S START=8,OFFSET=5
78 D SET^IBCNSP(START,OFFSET+3," Inpatient Deductibles ",IORVON,IORVOFF)
79 D SET^IBCNSP(START+1,OFFSET+7,"Deduct. Met?: "_$S($P($G(IBCBUD),U,6)=1:"YES",$P($G(IBCBUD),U,6)=0:"NO",1:""))
80 D SET^IBCNSP(START+2,OFFSET+3,"Amt. of Ded. Met: "_$P(IBCBUD,U,7))
81 D SET^IBCNSP(START+3,OFFSET-1,"MH Ded. (Inpt.) Met?: "_$S($P($G(IBCBUD),U,11)=1:"YES",$P($G(IBCBUD),U,11)=0:"NO",1:""))
82 D SET^IBCNSP(START+4,OFFSET,"Amt. of MH Ded. Met: "_$P(IBCBUD,U,12))
83 D SET^IBCNSP(START+5,OFFSET-1,"Amt. Lifet. Max Used: "_$P(IBCBUD,U,19))
84 D SET^IBCNSP(START+6,OFFSET-4,"Amt. MH Lifet. Max Used: "_$P(IBCBUD,U,18))
85 Q
86ADDCOM ;
87 N START,OFFSET
88 S START=22,OFFSET=7
89 D SET^IBCNSP(START,OFFSET," Comments ",IORVON,IORVOFF)
90 D SET^IBCNSP(START+1,OFFSET+3,""_$P(IBCBUD1,U,8))
91 Q
92 ;
93EXIT ;
94 ;
95 K VALMQUIT,IBCHANGE,IBCAB,IBCABC,IBCABD,IBYR,IBCBU,IBCBUD,IBCBUD1,IBCGN
96 D CLEAN^VALM10
97 Q
98BLANK(LINE) ;
99 D SET^VALM10(.LINE,$J("",80))
100 Q
Note: See TracBrowser for help on using the repository browser.