source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZF5.m@ 1404

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1EASEZF5 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51**;Mar 15, 2001
3 ;
4IBINS(EASAPP,EASDFN) ;setup for call to IB API
5 ;
6 N DATANM,X,IBDATA,OK,PARTA,PARTB,LSTNM,FRSTNM
7 ;file Medicare data
8 K IBDATA
9 S DATANM="MEDICARE PART A EFFECTIVE DATE" S PARTA=$$GET(DATANM)
10 S IBDATA("M","PART A")=PARTA
11 S DATANM="MEDICARE PART B EFFECTIVE DATE" S PARTB=$$GET(DATANM)
12 S IBDATA("M","PART B")=PARTB
13 I (PARTA'="")!(PARTB'="") D
14 .S IBDATA("M","DFN")=EASDFN
15 .S IBDATA("M","SOURCE")=1
16 .S DATANM="MEDICARE CLAIM NUMBER" S X=$$GET(DATANM)
17 .S IBDATA("M","HICN")=X
18 .S DATANM="SIGNEE ON MEDICARE CARD" S X=$$GET(DATANM)
19 .S IBDATA("M","NAME")=X
20 .S OK=$$BUFF^IBCNBES1(.IBDATA)
21 ;
22 ;applicant health insurance
23 K IBDATA
24 S DATANM="APPLICANT INSURANCE COMPANY" S X=$$GET(DATANM)
25 I X'="" D
26 .S IBDATA(1,20.01)=X
27 .S DATANM="APPLICANT INSURANCE GROUP CODE" S X=$$GET(DATANM)
28 .S IBDATA(1,40.03)=X
29 .S DATANM="APPLICANT INSURANCE POLICY HOLDER" S X=$$GET(DATANM)
30 .S IBDATA(1,60.07)=X
31 .S IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
32 .S X=IBDATA(1,60.05) S IBDATA(1,60.06)=$S(X="v":"01",X="s":"02",1:"09")
33 .S DATANM="APPLICANT INSURANCE POLICY NUMBER" S X=$$GET(DATANM)
34 .S IBDATA(1,60.04)=X
35 .S DATANM="APPLICANT INSURANCE ADDRESS" S X=$$GET(DATANM)
36 .S IBDATA(1,21.01)=X
37 .S DATANM="APPLICANT INSURANCE CITY" S X=$$GET(DATANM)
38 .S IBDATA(1,21.04)=X
39 .S DATANM="APPLICANT INSURANCE STATE" S X=$$GET(DATANM)
40 .S IBDATA(1,21.05)=X
41 .S DATANM="APPLICANT INSURANCE ZIP" S X=$$GET(DATANM)
42 .S IBDATA(1,21.06)=X
43 .S X=$$INSPH^EASEZT2(EASAPP,"APPLICANT",1)
44 .S IBDATA(1,20.02)=X
45 .S IBDATA(1,.03)=1
46 .S IBDATA(1,60.01)=EASDFN
47 .S OK=$$BUFF^IBCNBES1(.IBDATA)
48 ;applicant additional health insurance
49 K IBDATA
50 F MM=1:1 S DATANM="OTHER(N) INSURANCE COMPANY" S X=$$GET(DATANM,MM) Q:(X="") D
51 .S IBDATA(1,20.01)=X
52 .S DATANM="OTHER(N) INSURANCE GROUP CODE" S X=$$GET(DATANM,MM)
53 .S IBDATA(1,40.03)=X
54 .S DATANM="OTHER(N) INSURANCE POLICY HOLDER" S X=$$GET(DATANM,MM)
55 .S IBDATA(1,60.07)=X
56 .S IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
57 .S X=IBDATA(1,60.05) S IBDATA(1,60.06)=$S(X="v":"01",X="s":"02",1:"09")
58 .S DATANM="OTHER(N) INSURANCE POLICY NUMBER" S X=$$GET(DATANM,MM)
59 .S IBDATA(1,60.04)=X
60 .S DATANM="OTHER(N) INSURANCE ADDRESS" S X=$$GET(DATANM,MM)
61 .S IBDATA(1,21.01)=X
62 .S DATANM="OTHER(N) INSURANCE CITY" S X=$$GET(DATANM,MM)
63 .S IBDATA(1,21.04)=X
64 .S DATANM="OTHER(N) INSURANCE STATE" S X=$$GET(DATANM,MM)
65 .S IBDATA(1,21.05)=X
66 .S DATANM="OTHER(N) INSURANCE ZIP" S X=$$GET(DATANM,MM)
67 .S IBDATA(1,21.06)=X
68 .S X=$$INSPH^EASEZT2(EASAPP,"OTHER(N)",MM)
69 .S IBDATA(1,20.02)=X
70 .S IBDATA(1,.03)=1
71 .S IBDATA(1,60.01)=EASDFN
72 .S OK=$$BUFF^IBCNBES1(.IBDATA)
73 ;
74 ;spouse health insurance
75 ;retain for backward compatibility
76 K IBDATA
77 S DATANM="SPOUSE INSURANCE COMPANY" S X=$$GET(DATANM)
78 I X'="" D
79 .S IBDATA(2,20.01)=X
80 .S DATANM="SPOUSE INSURANCE GROUP CODE" S X=$$GET(DATANM)
81 .S IBDATA(2,40.03)=X
82 .S DATANM="SPOUSE INSURANCE POLICY HOLDER" S X=$$GET(DATANM)
83 .S IBDATA(2,60.07)=X
84 .S DATANM="SPOUSE INSURANCE POLICY NUMBER" S X=$$GET(DATANM)
85 .S IBDATA(2,60.04)=X
86 .S IBDATA(2,60.05)="s"
87 .S IBDATA(2,.03)=1
88 .S IBDATA(2,60.06)="02"
89 .S IBDATA(2,60.01)=EASDFN
90 .S OK=$$BUFF^IBCNBES1(.IBDATA)
91 ;
92 ;update field #.3192 in file #2 for Reg. screen 5
93 S X=$P($G(^DPT(EASDFN,.31)),U,11) I ((X="")!(X="U")) S $P(^DPT(EASDFN,.31),U,11)="N"
94 Q
95 ;
96GET(DATANM,MM) ;get 1010EZ data as needed by IB
97 ;
98 N KEY,XDATA
99 I '$G(MM) S MM=1
100 S KEY=+$$KEY711^EASEZU1(DATANM)
101 S XDATA=$P($$DATA712^EASEZU1(EASAPP,KEY,MM),U,1)
102 I DATANM["DATE",XDATA'="" D
103 .S X=XDATA D ^%DT S XDATA=$P(Y,".",1)
104 S XDATA=$$UC^EASEZT1(XDATA)
105 Q XDATA
106 ;
107INSREL(INSNM) ;
108 N FRSTNM,LSTNM
109 I INSNM="" Q ""
110 S DATANM="APPLICANT LAST NAME" S LSTNM=$$GET(DATANM)
111 S DATANM="APPLICANT FIRST NAME" S FRSTNM=$$GET(DATANM)
112 I INSNM[LSTNM,INSNM[FRSTNM Q "v"
113 S DATANM="SPOUSE LAST NAME" S LSTNM=$$GET(DATANM)
114 S DATANM="SPOUSE FIRST NAME" S FRSTNM=$$GET(DATANM)
115 I INSNM[LSTNM,INSNM[FRSTNM Q "s"
116 Q "o"
Note: See TracBrowser for help on using the repository browser.