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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1IBCNBLE ;ALB/ARH-Ins Buffer: LM buffer entry screen ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,231,184,251,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5EN ; - main entry point for list manager display
6 N DFN
7 D EN^VALM("IBCNB INSURANCE BUFFER ENTRY")
8 Q
9 ;
10HDR ; - header code for list manager display
11 N IBX,IB0,VADM,VA,VAERR S IBX=""
12 I +$G(DFN) D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
13 S VALMHDR(1)=IBX
14 S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0))
15 S IBX=$E($P($G(^VA(200,+$P(IB0,U,2),0)),U,1),1,27)_" ("_$E($$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)),1,11)_")"
16 S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX
17 S VALMHDR(2)=IBX
18 S IBX="" I +$P(IB0,U,10) S IBX="Buffer entry verified on "_$$DATE(+$P(IB0,U,10))_" by "_$E($P($G(^VA(200,+$P(IB0,U,11),0)),U,1),1,27),IBX=$J("",40-($L(IBX)\2))_IBX
19 S VALMHDR(3)=IBX
20 Q
21 ;
22INIT ; - initialization of list manager screen, ifn of record to display required IBBUFDA
23 K ^TMP("IBCNBLE",$J)
24 I '$G(IBBUFDA) S VALMQUIT="" Q
25 S DFN=+$G(^IBA(355.33,IBBUFDA,60))
26 D BLD
27 Q
28 ;
29HELP ; - help text for list manager screen
30 D FULL^VALM1
31 W !!,"This screen displays all data in a Buffer File entry."
32 W !!,"The actions allow editing of all data and verification of coverage."
33 W !!,"It is not necessary to use the Verify Entry action, this action is optional.",!,"If the Verify Entry action is not used, the policy will be automatically flagged",!,"as verified when it is Accepted and stored in the main Insurance files."
34 D PAUSE^VALM1 S VALMBCK="R"
35 Q
36 ;
37EXIT ; - exit list manager screen
38 K ^TMP("IBCNBLE",$J)
39 D CLEAR^VALM1
40 Q
41 ;
42BLD ; display buffer entry
43 N IB0,IB20,IB40,IB60,IB61,IB62,IBL,IBLINE,ADDR,IBI,IBY
44 S VALMCNT=0
45 S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40))
46 S IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)),IB62=$G(^IBA(355.33,IBBUFDA,62))
47 ;
48 D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE=""
49 S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30)
50 S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
51 D SET(IBLINE) S IBLINE=""
52 S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
53 S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
54 D SET(IBLINE) S IBLINE=""
55 S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
56 D SET(IBLINE) S IBLINE=""
57 S IBL="Remote Query From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
58 D SET(IBLINE) S IBLINE="" D ADDR(21,1)
59 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
60 D SET(IBLINE) S IBLINE=""
61 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
62 ;
63 D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE=""
64 S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3)
65 S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
66 D SET(IBLINE) S IBLINE=""
67 S IBL="Group Name: ",IBY=$P(IB40,U,2) S IBLINE=$$SETL("",IBY,IBL,16,20)
68 S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
69 D SET(IBLINE) S IBLINE=""
70 S IBL="Group Number: ",IBY=$P(IB40,U,3) S IBLINE=$$SETL("",IBY,IBL,16,17)
71 S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
72 ;;Daou/EEN - Adding BIN and PCN
73 D SET(IBLINE) S IBLINE=""
74 S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10)
75 D SET(IBLINE) S IBLINE=""
76 S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20)
77 D SET(IBLINE) S IBLINE=""
78 S IBL="Type of Plan: ",IBY=$P($G(^IBE(355.1,+$P(IB40,U,9),0)),U,1) S IBLINE=$$SETL("",IBY,IBL,16,25)
79 S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
80 D SET(IBLINE) S IBLINE=""
81 S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
82 D SET(IBLINE) S IBLINE=""
83 ;
84 D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE=""
85 S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7)
86 S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8)
87 D SET(IBLINE) S IBLINE=""
88 S IBL="Insured's Name: ",IBY=$P(IB60,U,7) S IBLINE=$$SETL("",IBY,IBL,18,30)
89 S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
90 D SET(IBLINE) S IBLINE=""
91 S IBL="Subscriber Id: ",IBY=$P(IB60,U,4) S IBLINE=$$SETL("",IBY,IBL,18,20)
92 S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
93 D SET(IBLINE) S IBLINE=""
94 S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16)
95 S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
96 D SET(IBLINE) S IBLINE=""
97 I $P(IB60,U,6)'="01"!($P(IB60,U,8)'="") S IBL="Insured's DOB: ",IBY=$$DATE($P(IB60,U,8)) S IBLINE=$$SETL("",IBY,IBL,18,8)
98 S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
99 D SET(IBLINE) S IBLINE=""
100 I $P(IB62,U)'="" S IBL="Patient Id: ",IBY=$P(IB62,U) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
101 I IBLINE'="" D SET(IBLINE) S IBLINE=""
102 ;
103 I '$P(IB61,U,1) D SET(" ") S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,40,3) D SET(IBLINE) S IBLINE="" G NXT
104 ;
105 D ADDR(61,6)
106 D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE=""
107 S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3)
108 S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
109 D SET(IBLINE) S IBLINE=""
110 S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3)
111 S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8)
112 D SET(IBLINE) S IBLINE=""
113 S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30)
114 S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
115 D SET(IBLINE) S IBLINE=""
116 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
117 D SET(IBLINE) S IBLINE=""
118 F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) D SET(IBLINE) S IBLINE=""
119 ;
120NXT ;
121 D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE=""
122 S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17)
123 S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
124 D SET(IBLINE) S IBLINE=""
125 S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40)
126 S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
127 D SET(IBLINE) S IBLINE=""
128 ;
129 ; esg - 6/25/02 SDD 5.1.2 - modifications to Expand Entry for IIV
130 ; move source down one line, eIIV trace # to the left column and add
131 ; eIIV processed date to the right column
132 ;
133 S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace #
134 S IBL="eIIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M"))
135 S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
136 D SET(IBLINE) S IBLINE=""
137 S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3))
138 S IBLINE=$$SETL("",IBY,IBL,18,17)
139 D SET(IBLINE) S IBLINE=""
140 ;
141 ; Call another routine for continuation of list build
142 D BLD^IBCNBLE1
143 ;
144BLDQ Q
145 ;
146 ;
147SETL(LINE,DATA,LABEL,COL,LNG) ;
148 S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
149 Q LINE
150 ;
151SET(LINE,SPEC) ;
152 S VALMCNT=VALMCNT+1
153 S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE
154 I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
155 Q
156 ;
157DATE(X) ;
158 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
159 Q Y
160 ;
161YN(X) ;
162 N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"")
163 Q Y
164 ;
165ADDR(NODE,FLD) ; format address for output
166 N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)=""
167 S IB0=$G(^IBA(355.33,IBBUFDA,NODE))
168 S IBCS=$P(IB0,U,FLD+3),IBST=$P($G(^DIC(5,+$P(IB0,U,FLD+4),0)),U,2),IBZIP=$P(IB0,U,FLD+5)
169 S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"")
170 S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP
171 S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST
172 ;
173 S IBJ=1 F IBY=$P(IB0,U,FLD),$P(IB0,U,(FLD+1)),$P(IB0,U,(FLD+2)),IBCS I IBY'="" S IBX=$G(ADDR(IBJ)),IBZ=", " D
174 . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1
175 . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY
176 Q
177 ;
178TRACE(IBLINE,IBBUFDA) ; Add the eIIV Trace Number to the display
179 NEW RESP,TRACENUM,IBL,IBY
180 I '$G(IBBUFDA) G TRACEX
181 S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien
182 S TRACENUM=""
183 I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9) ; trace# field
184 S IBL="eIIV Trace #: ",IBY=TRACENUM ; field label/data
185 S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it
186TRACEX ;
187 Q IBLINE
188 ;
Note: See TracBrowser for help on using the repository browser.