source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZPVI.m@ 891

Last change on this file since 891 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1EASEZPVI ;ALB/AMA; GATHER VISTA INSURANCE DATA TO PRINT FROM DG OPTIONS ; 06 Jul 2005 1:45 PM
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**57**;Mar 15, 2001
3 ;
4 Q
5 ;
6INSUR(EASDFN) ;GET INSURANCE DATA
7 ; INPUT:
8 ; EASDFN - POINTER TO THE PATIENT FILE
9 ;
10 ;IF THEY EXIST, FIND INSURANCE COMPANY NAME(S), ADDRESS,
11 ;CITY, STATE, ZIP, PHONE, GROUP CODE(S), POLICY NUMBER(S),
12 ;NAME(S) OF INSURED, MEDICARE PART A/B, AND EFFECTIVE DATE(S)
13 ;
14 N KEY,VDATA,MULTIPLE,INDA,IENS,INSUR,INSORT,FLD,TYPE,IEN,INPTR,NAME
15 N STREET,CITY,STPTR,STATE,ZIP,PHONE,GRPCD,POLNO,INNAME,KEYNM,M,CAT
16 S KEY=+$$KEY711^EASEZU1("APPLICANT HAS INSURANCE")
17 S VDATA=$$GET^EASEZC1(EASDFN,"2^2^.3192")
18 I (VDATA=-1)!(VDATA="") S ^TMP("EZDATA",$J,KEY,1,2)="UNKNOWN"
19 I (VDATA'=-1),(VDATA'="") S ^TMP("EZDATA",$J,KEY,1,2)=VDATA
20 Q:VDATA'="YES"
21 ;
22 S MULTIPLE=0
23 S INDA=0 F S INDA=$O(^DPT(EASDFN,.312,INDA)) Q:'INDA D
24 . D GETS^DIQ(2.312,INDA_","_EASDFN,"**","IE","INSUR")
25 S IENS="" F S IENS=$O(INSUR(2.312,IENS)) Q:IENS="" D
26 . S FLD=0 F S FLD=$O(INSUR(2.312,IENS,FLD)) Q:'FLD D
27 . . F TYPE="E","I" S INSORT(2.312,+IENS,FLD,TYPE)=$G(INSUR(2.312,IENS,FLD,TYPE))
28 K INSUR
29 S IEN=0 F S IEN=$O(INSORT(2.312,IEN)) Q:'IEN D
30 . Q:'$G(INSORT(2.312,IEN,.18,"I"))
31 . S INPTR=INSORT(2.312,IEN,.18,"I")
32 . Q:$$GET1^DIQ(355.3,INPTR,.11,"I") ;INACTIVE FLAG
33 . I DT'>$G(INSORT(2.312,IEN,3,"I")) Q ;INSUR EXPIRATION DATE
34 . S NAME=$G(INSORT(2.312,IEN,.18,"E"))
35 . S STREET=$$GET1^DIQ(36,INPTR,.111),CITY=$$GET1^DIQ(36,INPTR,.114)
36 . S STPTR=$$GET1^DIQ(36,INPTR,.115,"I"),STATE=$$GET1^DIQ(5,STPTR,1)
37 . S ZIP=$$GET1^DIQ(36,INPTR,.116),PHONE=$$GET1^DIQ(36,INPTR,.131)
38 . S GRPCD=$$GET1^DIQ(355.3,INPTR,.04),POLNO=$G(INSORT(2.312,IEN,1,"E"))
39 . S INNAME=$G(INSORT(2.312,IEN,17,"E"))
40 . S MULTIPLE=MULTIPLE+1
41 . I MULTIPLE=1 S KEYNM="APPLICANT",M=1
42 . E S KEYNM="OTHER(N)",M=MULTIPLE-1
43 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE COMPANY")
44 . I NAME]"" S ^TMP("EZDATA",$J,KEY,M,2)=NAME
45 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE ADDRESS")
46 . I STREET]"" S ^TMP("EZDATA",$J,KEY,M,2)=STREET
47 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE CITY")
48 . I CITY]"" S ^TMP("EZDATA",$J,KEY,M,2)=CITY
49 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE STATE")
50 . I STATE]"" S ^TMP("EZDATA",$J,KEY,M,2)=STATE
51 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE ZIP")
52 . I ZIP]"" S ^TMP("EZDATA",$J,KEY,M,2)=ZIP
53 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE PHONE")
54 . I PHONE]"" S ^TMP("EZDATA",$J,KEY,M,2)=PHONE
55 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE GROUP CODE")
56 . I GRPCD]"" S ^TMP("EZDATA",$J,KEY,M,2)=GRPCD
57 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE POLICY HOLDER")
58 . I INNAME]"" S ^TMP("EZDATA",$J,KEY,M,2)=INNAME
59 . S KEY=+$$KEY711^EASEZU1(KEYNM_" INSURANCE POLICY NUMBER")
60 . I POLNO]"" S ^TMP("EZDATA",$J,KEY,M,2)=POLNO
61 . ;
62 . I $$GET^EASEZC1(INPTR,"355.3^355.3^.09")="MEDICARE (M)" D
63 . . S CAT=$$GET^EASEZC1(INPTR,"355.3^355.3^.14")
64 . . I (CAT'="MEDICARE PART A"),(CAT'="MEDICARE PART B") Q
65 . . S KEY=+$$KEY711^EASEZU1(CAT)
66 . . S ^TMP("EZDATA",$J,KEY,M,2)="YES"
67 . . S VDATA=$$GET^EASEZC1(EASDFN_";"_INDA,"2^2.312^8")
68 . . Q:VDATA="" Q:VDATA=-1
69 . . S KEY=+$$KEY711^EASEZU1(CAT_" EFFECTIVE DATE")
70 . . S ^TMP("EZDATA",$J,KEY,M,2)=VDATA
71 ;
72 Q
73 ;
74I408(EASDFN,MTDT,EASARRAY) ;retrieve ien(s) to files #408.12,#408.13,#408.21,#408.22
75 ; Modified from I408^EASEZI, called from V408^EASEZPV2
76 ;input EASDFN = ien to #2
77 ; MTDT = Means Test date
78 ;output EASARRAY = ien(s) to files; passed by reference
79 ; array(408,"V",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;veteran data
80 ; array(408,"S",1) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;spouse data
81 ; array(408,"C",multiple) = ien_#408.12^ien_#408.13^ien_#408.21^ien#408.22 ;child data
82 ;where ien_#408.13 = ien;global_root
83 ;
84 N Y,%F,X,%DT,MTDATE
85 N SUB1,SUB2,INCYR,DGINC,DGREL,DGINR
86 N I21,I22
87 ;
88 Q:'EASDFN
89 S Y=MTDT,%F=5,X=$$FMTE^XLFDT(Y,%F),X=+$P(X,"/",3)-1,%DT="P"
90 D ^%DT S MTDATE=Y
91 ;retrieve all associated 408 records; refer to api call for docu
92 I MTDT D ALL^DGMTU21(EASDFN,"VSC",MTDT)
93 ;massage "V" and "S" nodes for clear use in for loop below
94 S:$D(DGINC("V")) DGINC("V",1)=DGINC("V")
95 S:$D(DGINR("V")) DGINR("V",1)=DGINR("V")
96 S:$D(DGREL("V")) DGREL("V",1)=DGREL("V")
97 S:$D(DGINC("S")) DGINC("S",1)=DGINC("S")
98 S:$D(DGINR("S")) DGINR("S",1)=DGINR("S")
99 S:$D(DGREL("S")) DGREL("S",1)=DGREL("S")
100 ;
101 F SUB1="V","S","C" D
102 . Q:'$D(DGREL(SUB1))
103 . S SUB2=0
104 . F S SUB2=$O(DGREL(SUB1,SUB2)) Q:'SUB2 D
105 . . S EASARRAY(408,SUB1,SUB2)=DGREL(SUB1,SUB2)
106 . . S I21=$G(DGINC(SUB1,SUB2)) ; 408.21 ien
107 . . Q:'I21
108 . . S INCYR=$$GET1^DIQ(408.21,I21_",",.01,"I")
109 . . ;NOTE: The following two quit conditions are probably not
110 . . ; not necessary given the arrays being returned from
111 . . ; ALL^DGMTU21
112 . . Q:'MTDT
113 . . Q:(INCYR<MTDATE)
114 . . S I22=$G(DGINR(SUB1,SUB2)) ;408.22 ien
115 . . Q:$G(^DGMT(408.22,+I22,"MT"))=""
116 . . ;
117 . . ;NOTE: The following line of code is designed to throw away all
118 . . ; income/net worth figures when the dependent childs income
119 . . ; is NOT available to the patient. In the next release,
120 . . ; this will need to be changed to set EASARRAY with I21 and
121 . . ; I22 for all children and then screen the reporting of Child
122 . . ; income (not available to patient) in the report output code.
123 . . ; ASSUMING THAT THE NET WORTH IS COLLECTED WHEN IT IS NOT
124 . . ; AVAILABLE TO THE PATIENT. IF THAT IS NOT TRUE, LEAVE CODE.
125 . . ;
126 . . I SUB1="C" Q:(+$P($G(^DGMT(408.22,+I22,0)),"^",12))'=1
127 . . S EASARRAY(408,SUB1,SUB2)=EASARRAY(408,SUB1,SUB2)_U_I21_U_I22
128 Q
129 ;
Note: See TracBrowser for help on using the repository browser.