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

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

revised back to 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**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, 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,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)),IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61))
46 ;
47 D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE=""
48 S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30)
49 S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
50 D SET(IBLINE) S IBLINE=""
51 S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
52 S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
53 D SET(IBLINE) S IBLINE=""
54 S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
55 D SET(IBLINE) S IBLINE=""
56 S IBL="Remote Query From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
57 D SET(IBLINE) S IBLINE="" D ADDR(21,1)
58 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
59 D SET(IBLINE) S IBLINE=""
60 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=""
61 ;
62 D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE=""
63 S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3)
64 S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
65 D SET(IBLINE) S IBLINE=""
66 S IBL="Group Name: ",IBY=$P(IB40,U,2) S IBLINE=$$SETL("",IBY,IBL,16,20)
67 S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
68 D SET(IBLINE) S IBLINE=""
69 S IBL="Group Number: ",IBY=$P(IB40,U,3) S IBLINE=$$SETL("",IBY,IBL,16,17)
70 S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
71 ;;Daou/EEN - Adding BIN and PCN
72 D SET(IBLINE) S IBLINE=""
73 S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10)
74 D SET(IBLINE) S IBLINE=""
75 S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20)
76 D SET(IBLINE) S IBLINE=""
77 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)
78 S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
79 D SET(IBLINE) S IBLINE=""
80 S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
81 D SET(IBLINE) S IBLINE=""
82 ;
83 D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE=""
84 S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7)
85 S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8)
86 D SET(IBLINE) S IBLINE=""
87 S IBL="Insured's Name: ",IBY=$P(IB60,U,7) S IBLINE=$$SETL("",IBY,IBL,18,30)
88 S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
89 D SET(IBLINE) S IBLINE=""
90 S IBL="Subscriber Id: ",IBY=$P(IB60,U,4) S IBLINE=$$SETL("",IBY,IBL,18,20)
91 S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
92 D SET(IBLINE) S IBLINE=""
93 S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16)
94 S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
95 D SET(IBLINE) S IBLINE=""
96 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)
97 S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
98 D SET(IBLINE) S IBLINE=""
99 I $P(IB60,U,6)'="01"!($P(IB60,U,9)'="") S IBL="Insured's SSN: ",IBY=$P(IB60,U,9) S IBLINE=$$SETL("",IBY,IBL,18,13)
100 I IBLINE'="" D SET(IBLINE) S IBLINE=""
101 ;
102 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
103 ;
104 D ADDR(61,6)
105 D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE=""
106 S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3)
107 S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
108 D SET(IBLINE) S IBLINE=""
109 S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3)
110 S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8)
111 D SET(IBLINE) S IBLINE=""
112 S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30)
113 S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
114 D SET(IBLINE) S IBLINE=""
115 S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
116 D SET(IBLINE) S IBLINE=""
117 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=""
118 ;
119NXT ;
120 D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE=""
121 S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17)
122 S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
123 D SET(IBLINE) S IBLINE=""
124 S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40)
125 S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
126 D SET(IBLINE) S IBLINE=""
127 ;
128 ; esg - 6/25/02 SDD 5.1.2 - modifications to Expand Entry for IIV
129 ; move source down one line, eIIV trace # to the left column and add
130 ; eIIV processed date to the right column
131 ;
132 S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace #
133 S IBL="eIIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M"))
134 S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
135 D SET(IBLINE) S IBLINE=""
136 S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3))
137 S IBLINE=$$SETL("",IBY,IBL,18,17)
138 D SET(IBLINE) S IBLINE=""
139 ;
140 ; Call another routine for continuation of list build
141 D BLD^IBCNBLE1
142 ;
143BLDQ Q
144 ;
145 ;
146SETL(LINE,DATA,LABEL,COL,LNG) ;
147 S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
148 Q LINE
149 ;
150SET(LINE,SPEC) ;
151 S VALMCNT=VALMCNT+1
152 S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE
153 I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
154 Q
155 ;
156DATE(X) ;
157 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
158 Q Y
159 ;
160YN(X) ;
161 N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"")
162 Q Y
163 ;
164ADDR(NODE,FLD) ; format address for output
165 N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)=""
166 S IB0=$G(^IBA(355.33,IBBUFDA,NODE))
167 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)
168 S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"")
169 S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP
170 S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST
171 ;
172 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
173 . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1
174 . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY
175 Q
176 ;
177TRACE(IBLINE,IBBUFDA) ; Add the eIIV Trace Number to the display
178 NEW RESP,TRACENUM,IBL,IBY
179 I '$G(IBBUFDA) G TRACEX
180 S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien
181 S TRACENUM=""
182 I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9) ; trace# field
183 S IBL="eIIV Trace #: ",IBY=TRACENUM ; field label/data
184 S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it
185TRACEX ;
186 Q IBLINE
187 ;
Note: See TracBrowser for help on using the repository browser.