EASEZF5 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
;;1.0;ENROLLMENT APPLICATION SYSTEM;**51**;Mar 15, 2001
;
IBINS(EASAPP,EASDFN) ;setup for call to IB API
;
N DATANM,X,IBDATA,OK,PARTA,PARTB,LSTNM,FRSTNM
;file Medicare data
K IBDATA
S DATANM="MEDICARE PART A EFFECTIVE DATE" S PARTA=$$GET(DATANM)
S IBDATA("M","PART A")=PARTA
S DATANM="MEDICARE PART B EFFECTIVE DATE" S PARTB=$$GET(DATANM)
S IBDATA("M","PART B")=PARTB
I (PARTA'="")!(PARTB'="") D
.S IBDATA("M","DFN")=EASDFN
.S IBDATA("M","SOURCE")=1
.S DATANM="MEDICARE CLAIM NUMBER" S X=$$GET(DATANM)
.S IBDATA("M","HICN")=X
.S DATANM="SIGNEE ON MEDICARE CARD" S X=$$GET(DATANM)
.S IBDATA("M","NAME")=X
.S OK=$$BUFF^IBCNBES1(.IBDATA)
;
;applicant health insurance
K IBDATA
S DATANM="APPLICANT INSURANCE COMPANY" S X=$$GET(DATANM)
I X'="" D
.S IBDATA(1,20.01)=X
.S DATANM="APPLICANT INSURANCE GROUP CODE" S X=$$GET(DATANM)
.S IBDATA(1,40.03)=X
.S DATANM="APPLICANT INSURANCE POLICY HOLDER" S X=$$GET(DATANM)
.S IBDATA(1,60.07)=X
.S IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
.S X=IBDATA(1,60.05) S IBDATA(1,60.06)=$S(X="v":"01",X="s":"02",1:"09")
.S DATANM="APPLICANT INSURANCE POLICY NUMBER" S X=$$GET(DATANM)
.S IBDATA(1,60.04)=X
.S DATANM="APPLICANT INSURANCE ADDRESS" S X=$$GET(DATANM)
.S IBDATA(1,21.01)=X
.S DATANM="APPLICANT INSURANCE CITY" S X=$$GET(DATANM)
.S IBDATA(1,21.04)=X
.S DATANM="APPLICANT INSURANCE STATE" S X=$$GET(DATANM)
.S IBDATA(1,21.05)=X
.S DATANM="APPLICANT INSURANCE ZIP" S X=$$GET(DATANM)
.S IBDATA(1,21.06)=X
.S X=$$INSPH^EASEZT2(EASAPP,"APPLICANT",1)
.S IBDATA(1,20.02)=X
.S IBDATA(1,.03)=1
.S IBDATA(1,60.01)=EASDFN
.S OK=$$BUFF^IBCNBES1(.IBDATA)
;applicant additional health insurance
K IBDATA
F MM=1:1 S DATANM="OTHER(N) INSURANCE COMPANY" S X=$$GET(DATANM,MM) Q:(X="") D
.S IBDATA(1,20.01)=X
.S DATANM="OTHER(N) INSURANCE GROUP CODE" S X=$$GET(DATANM,MM)
.S IBDATA(1,40.03)=X
.S DATANM="OTHER(N) INSURANCE POLICY HOLDER" S X=$$GET(DATANM,MM)
.S IBDATA(1,60.07)=X
.S IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
.S X=IBDATA(1,60.05) S IBDATA(1,60.06)=$S(X="v":"01",X="s":"02",1:"09")
.S DATANM="OTHER(N) INSURANCE POLICY NUMBER" S X=$$GET(DATANM,MM)
.S IBDATA(1,60.04)=X
.S DATANM="OTHER(N) INSURANCE ADDRESS" S X=$$GET(DATANM,MM)
.S IBDATA(1,21.01)=X
.S DATANM="OTHER(N) INSURANCE CITY" S X=$$GET(DATANM,MM)
.S IBDATA(1,21.04)=X
.S DATANM="OTHER(N) INSURANCE STATE" S X=$$GET(DATANM,MM)
.S IBDATA(1,21.05)=X
.S DATANM="OTHER(N) INSURANCE ZIP" S X=$$GET(DATANM,MM)
.S IBDATA(1,21.06)=X
.S X=$$INSPH^EASEZT2(EASAPP,"OTHER(N)",MM)
.S IBDATA(1,20.02)=X
.S IBDATA(1,.03)=1
.S IBDATA(1,60.01)=EASDFN
.S OK=$$BUFF^IBCNBES1(.IBDATA)
;
;spouse health insurance
;retain for backward compatibility
K IBDATA
S DATANM="SPOUSE INSURANCE COMPANY" S X=$$GET(DATANM)
I X'="" D
.S IBDATA(2,20.01)=X
.S DATANM="SPOUSE INSURANCE GROUP CODE" S X=$$GET(DATANM)
.S IBDATA(2,40.03)=X
.S DATANM="SPOUSE INSURANCE POLICY HOLDER" S X=$$GET(DATANM)
.S IBDATA(2,60.07)=X
.S DATANM="SPOUSE INSURANCE POLICY NUMBER" S X=$$GET(DATANM)
.S IBDATA(2,60.04)=X
.S IBDATA(2,60.05)="s"
.S IBDATA(2,.03)=1
.S IBDATA(2,60.06)="02"
.S IBDATA(2,60.01)=EASDFN
.S OK=$$BUFF^IBCNBES1(.IBDATA)
;
;update field #.3192 in file #2 for Reg. screen 5
S X=$P($G(^DPT(EASDFN,.31)),U,11) I ((X="")!(X="U")) S $P(^DPT(EASDFN,.31),U,11)="N"
Q
;
GET(DATANM,MM) ;get 1010EZ data as needed by IB
;
N KEY,XDATA
I '$G(MM) S MM=1
S KEY=+$$KEY711^EASEZU1(DATANM)
S XDATA=$P($$DATA712^EASEZU1(EASAPP,KEY,MM),U,1)
I DATANM["DATE",XDATA'="" D
.S X=XDATA D ^%DT S XDATA=$P(Y,".",1)
S XDATA=$$UC^EASEZT1(XDATA)
Q XDATA
;
INSREL(INSNM) ;
N FRSTNM,LSTNM
I INSNM="" Q ""
S DATANM="APPLICANT LAST NAME" S LSTNM=$$GET(DATANM)
S DATANM="APPLICANT FIRST NAME" S FRSTNM=$$GET(DATANM)
I INSNM[LSTNM,INSNM[FRSTNM Q "v"
S DATANM="SPOUSE LAST NAME" S LSTNM=$$GET(DATANM)
S DATANM="SPOUSE FIRST NAME" S FRSTNM=$$GET(DATANM)
I INSNM[LSTNM,INSNM[FRSTNM Q "s"
Q "o"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZF5 4116 printed Apr 09, 2024@20:59:39 Page 2
EASEZF5 ;ALB/jap - Filing 1010EZ Data to Patient Database ;10/31/00 13:07
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51**;Mar 15, 2001
+2 ;
IBINS(EASAPP,EASDFN) ;setup for call to IB API
+1 ;
+2 NEW DATANM,X,IBDATA,OK,PARTA,PARTB,LSTNM,FRSTNM
+3 ;file Medicare data
+4 KILL IBDATA
+5 SET DATANM="MEDICARE PART A EFFECTIVE DATE"
SET PARTA=$$GET(DATANM)
+6 SET IBDATA("M","PART A")=PARTA
+7 SET DATANM="MEDICARE PART B EFFECTIVE DATE"
SET PARTB=$$GET(DATANM)
+8 SET IBDATA("M","PART B")=PARTB
+9 IF (PARTA'="")!(PARTB'="")
Begin DoDot:1
+10 SET IBDATA("M","DFN")=EASDFN
+11 SET IBDATA("M","SOURCE")=1
+12 SET DATANM="MEDICARE CLAIM NUMBER"
SET X=$$GET(DATANM)
+13 SET IBDATA("M","HICN")=X
+14 SET DATANM="SIGNEE ON MEDICARE CARD"
SET X=$$GET(DATANM)
+15 SET IBDATA("M","NAME")=X
+16 SET OK=$$BUFF^IBCNBES1(.IBDATA)
End DoDot:1
+17 ;
+18 ;applicant health insurance
+19 KILL IBDATA
+20 SET DATANM="APPLICANT INSURANCE COMPANY"
SET X=$$GET(DATANM)
+21 IF X'=""
Begin DoDot:1
+22 SET IBDATA(1,20.01)=X
+23 SET DATANM="APPLICANT INSURANCE GROUP CODE"
SET X=$$GET(DATANM)
+24 SET IBDATA(1,40.03)=X
+25 SET DATANM="APPLICANT INSURANCE POLICY HOLDER"
SET X=$$GET(DATANM)
+26 SET IBDATA(1,60.07)=X
+27 SET IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
+28 SET X=IBDATA(1,60.05)
SET IBDATA(1,60.06)=$SELECT(X="v":"01",X="s":"02",1:"09")
+29 SET DATANM="APPLICANT INSURANCE POLICY NUMBER"
SET X=$$GET(DATANM)
+30 SET IBDATA(1,60.04)=X
+31 SET DATANM="APPLICANT INSURANCE ADDRESS"
SET X=$$GET(DATANM)
+32 SET IBDATA(1,21.01)=X
+33 SET DATANM="APPLICANT INSURANCE CITY"
SET X=$$GET(DATANM)
+34 SET IBDATA(1,21.04)=X
+35 SET DATANM="APPLICANT INSURANCE STATE"
SET X=$$GET(DATANM)
+36 SET IBDATA(1,21.05)=X
+37 SET DATANM="APPLICANT INSURANCE ZIP"
SET X=$$GET(DATANM)
+38 SET IBDATA(1,21.06)=X
+39 SET X=$$INSPH^EASEZT2(EASAPP,"APPLICANT",1)
+40 SET IBDATA(1,20.02)=X
+41 SET IBDATA(1,.03)=1
+42 SET IBDATA(1,60.01)=EASDFN
+43 SET OK=$$BUFF^IBCNBES1(.IBDATA)
End DoDot:1
+44 ;applicant additional health insurance
+45 KILL IBDATA
+46 FOR MM=1:1
SET DATANM="OTHER(N) INSURANCE COMPANY"
SET X=$$GET(DATANM,MM)
if (X="")
QUIT
Begin DoDot:1
+47 SET IBDATA(1,20.01)=X
+48 SET DATANM="OTHER(N) INSURANCE GROUP CODE"
SET X=$$GET(DATANM,MM)
+49 SET IBDATA(1,40.03)=X
+50 SET DATANM="OTHER(N) INSURANCE POLICY HOLDER"
SET X=$$GET(DATANM,MM)
+51 SET IBDATA(1,60.07)=X
+52 SET IBDATA(1,60.05)=$$INSREL(IBDATA(1,60.07))
+53 SET X=IBDATA(1,60.05)
SET IBDATA(1,60.06)=$SELECT(X="v":"01",X="s":"02",1:"09")
+54 SET DATANM="OTHER(N) INSURANCE POLICY NUMBER"
SET X=$$GET(DATANM,MM)
+55 SET IBDATA(1,60.04)=X
+56 SET DATANM="OTHER(N) INSURANCE ADDRESS"
SET X=$$GET(DATANM,MM)
+57 SET IBDATA(1,21.01)=X
+58 SET DATANM="OTHER(N) INSURANCE CITY"
SET X=$$GET(DATANM,MM)
+59 SET IBDATA(1,21.04)=X
+60 SET DATANM="OTHER(N) INSURANCE STATE"
SET X=$$GET(DATANM,MM)
+61 SET IBDATA(1,21.05)=X
+62 SET DATANM="OTHER(N) INSURANCE ZIP"
SET X=$$GET(DATANM,MM)
+63 SET IBDATA(1,21.06)=X
+64 SET X=$$INSPH^EASEZT2(EASAPP,"OTHER(N)",MM)
+65 SET IBDATA(1,20.02)=X
+66 SET IBDATA(1,.03)=1
+67 SET IBDATA(1,60.01)=EASDFN
+68 SET OK=$$BUFF^IBCNBES1(.IBDATA)
End DoDot:1
+69 ;
+70 ;spouse health insurance
+71 ;retain for backward compatibility
+72 KILL IBDATA
+73 SET DATANM="SPOUSE INSURANCE COMPANY"
SET X=$$GET(DATANM)
+74 IF X'=""
Begin DoDot:1
+75 SET IBDATA(2,20.01)=X
+76 SET DATANM="SPOUSE INSURANCE GROUP CODE"
SET X=$$GET(DATANM)
+77 SET IBDATA(2,40.03)=X
+78 SET DATANM="SPOUSE INSURANCE POLICY HOLDER"
SET X=$$GET(DATANM)
+79 SET IBDATA(2,60.07)=X
+80 SET DATANM="SPOUSE INSURANCE POLICY NUMBER"
SET X=$$GET(DATANM)
+81 SET IBDATA(2,60.04)=X
+82 SET IBDATA(2,60.05)="s"
+83 SET IBDATA(2,.03)=1
+84 SET IBDATA(2,60.06)="02"
+85 SET IBDATA(2,60.01)=EASDFN
+86 SET OK=$$BUFF^IBCNBES1(.IBDATA)
End DoDot:1
+87 ;
+88 ;update field #.3192 in file #2 for Reg. screen 5
+89 SET X=$PIECE($GET(^DPT(EASDFN,.31)),U,11)
IF ((X="")!(X="U"))
SET $PIECE(^DPT(EASDFN,.31),U,11)="N"
+90 QUIT
+91 ;
GET(DATANM,MM) ;get 1010EZ data as needed by IB
+1 ;
+2 NEW KEY,XDATA
+3 IF '$GET(MM)
SET MM=1
+4 SET KEY=+$$KEY711^EASEZU1(DATANM)
+5 SET XDATA=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,MM),U,1)
+6 IF DATANM["DATE"
IF XDATA'=""
Begin DoDot:1
+7 SET X=XDATA
DO ^%DT
SET XDATA=$PIECE(Y,".",1)
End DoDot:1
+8 SET XDATA=$$UC^EASEZT1(XDATA)
+9 QUIT XDATA
+10 ;
INSREL(INSNM) ;
+1 NEW FRSTNM,LSTNM
+2 IF INSNM=""
QUIT ""
+3 SET DATANM="APPLICANT LAST NAME"
SET LSTNM=$$GET(DATANM)
+4 SET DATANM="APPLICANT FIRST NAME"
SET FRSTNM=$$GET(DATANM)
+5 IF INSNM[LSTNM
IF INSNM[FRSTNM
QUIT "v"
+6 SET DATANM="SPOUSE LAST NAME"
SET LSTNM=$$GET(DATANM)
+7 SET DATANM="SPOUSE FIRST NAME"
SET FRSTNM=$$GET(DATANM)
+8 IF INSNM[LSTNM
IF INSNM[FRSTNM
QUIT "s"
+9 QUIT "o"
