- 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 Jan 18, 2025@02:55:48 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"