source: FOIAVistA/tag/r/PATIENT_DATA_EXCHANGE-VAQ/VAQDBIP7.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1VAQDBIP7 ;ALB/JRP - CONTINUATION FOR VAQDBIP4: 3/17/2004
2 ;;1.5;PATIENT DATA EXCHANGE;**13,42**;NOV 17, 1993
3INSURE ;INSURANCE EXTRACTION (ALL NON-EXPIRED)
4 ; DECLARATIONS DONE IN VAQDBIP4
5 ;GET LIST OF FIELDS TO EXTRACT
6 S TMP=$T(INSURE+1^VAQDBII1)
7 S FLDS(1)=$TR($P(TMP,";",4),",",";")
8 S TMP=$T(INSURE+2^VAQDBII1)
9 S FLDS(2)=$TR($P(TMP,";",4),",",";")
10 S TMP=$T(INSURE+3^VAQDBII1)
11 S FLDS(3)=$TR($P(TMP,";",4),",",";")
12 ;ENCRYPT PATIENT NAME (ID FOR INSURANCE COMPANY & GROUP PLAN)
13 S STRING=$P($$PATINFO^VAQUTL1(DFN),U,1)
14 S ENCSTR=STRING
15 I $$NCRPFLD^VAQUTL2(2,.01) X ENCRYPT
16 S NAME=ENCSTR
17 N VAQINS
18 ;DETERMINE IF COVERED BY HEALTH INSURANCE & ENCRYPT
19 ;S TMP=$$INSUR^IBBAPI(DFN,DT,"R",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18") ; Get all active (not expired) insurance, reimbursable or not
20 S TMP=$$INSUR^IBBAPI(DFN,"","ARB",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18") ; Get all insurance, expired or not, reimbursable or not
21 S STRING=$S(TMP:"YES",1:"NO")
22 S ENCSTR=STRING
23 I $$NCRPFLD^VAQUTL2(2,.3192) X ENCRYPT
24 ;GET SEQUENCE NUMBER & STORE INFO
25 S SEQ=$$GETSEQ^VAQDBIP(ARRAY,2,.3192)
26 S @ARRAY@("ID",2,.3192,SEQ)=NAME
27 S @ARRAY@("VALUE",2,.3192,SEQ)=ENCSTR
28 ;EXTRACT DATA
29 K ^UTILITY("DIQ1",$J)
30 S TMP=0
31 F S TMP=$O(VAQINS("IBBAPI","INSUR",TMP)) Q:'TMP D
32 .;EXTRACT INSURANCE INFO
33 .;Prior to patch *42, we took the info directly from file 2.
34 .;Now we get it from the IB API call.
35 .;PATIENT (#2) file
36 .;INSURANCE TYPE (#2.312) Subfile API field equivalent
37 .;------------------------------------------ --------------------
38 .;.01 INSURANCE TYPE (ptr to file 36) 1 insurance company name
39 .;.18 GROUP PLAN (ptr to file 355.3) --
40 .;1 SUBSCRIBER ID 14 subscriber ID
41 .;2 *GROUP NUMBER --
42 .;3 INSURANCE EXPIRATION DATE 11 expiration date
43 .;6 WHOSE INSURANCE (v=vet;s=spouse;o=other)12 subscriber relationship
44 .;7 *RENEWAL DATE --
45 .;8 EFFECTIVE DATE OF POLICY 10 effective date
46 .;16 PT. RELATIONSHIP TO INSURED 12 subscriber relationship
47 .;17 NAME OF INSURED 13 subscriber name
48 .S ^UTILITY("DIQ1",$J,2.312,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
49 .S ^UTILITY("DIQ1",$J,2.312,TMP,1,"E")=VAQINS("IBBAPI","INSUR",TMP,14)
50 .S ^UTILITY("DIQ1",$J,2.312,TMP,3,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,11))
51 .I VAQINS("IBBAPI","INSUR",TMP,12)[U S ^UTILITY("DIQ1",$J,2.312,TMP,6,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,12),U,2)
52 .E S ^UTILITY("DIQ1",$J,2.312,TMP,6,"E")=VAQINS("IBBAPI","INSUR",TMP,12)
53 .S ^UTILITY("DIQ1",$J,2.312,TMP,8,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,10))
54 .S ^UTILITY("DIQ1",$J,2.312,TMP,16,"E")=^UTILITY("DIQ1",$J,2.312,TMP,6,"E")
55 .S ^UTILITY("DIQ1",$J,2.312,TMP,17,"E")=VAQINS("IBBAPI","INSUR",TMP,13)
56 .;EXTRACT INFO ABOUT INSURANCE COMPANY
57 .;Prior to patch *42, we took the info directly from file 36.
58 .;Now we get it from the IB API call.
59 .;INSURANCE COMPANY (#36) file API field equivalent
60 .;------------------------------------------ --------------------
61 .;.01 NAME 1 insurance company name
62 .;.111 STREET ADDRESS [LINE 1] 2 street address
63 .;.112 STREET ADDRESS [LINE 2] -
64 .;.113 STREET ADDRESS [LINE 3] -
65 .;.114 CITY 3 city
66 .;.115 STATE 4 state
67 .;.316 ZIP 5 zip
68 .;.131 PHONE NUMBER 6 phone number
69 .S ^UTILITY("DIQ1",$J,36,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
70 .S ^UTILITY("DIQ1",$J,36,TMP,.111,"E")=VAQINS("IBBAPI","INSUR",TMP,2)
71 .S ^UTILITY("DIQ1",$J,36,TMP,.114,"E")=VAQINS("IBBAPI","INSUR",TMP,3)
72 .S ^UTILITY("DIQ1",$J,36,TMP,.115,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,4),U,2)
73 .S ^UTILITY("DIQ1",$J,36,TMP,.316,"E")=VAQINS("IBBAPI","INSUR",TMP,5)
74 .S ^UTILITY("DIQ1",$J,36,TMP,.131,"E")=VAQINS("IBBAPI","INSUR",TMP,6)
75 .;EXTRACT INFO ABOUT GROUP PLAN
76 .;Prior to patch *42, we took the info directly from file 355.3.
77 .;Now we get it from the IB API call.
78 .;GROUP INSURANCE PLAN (#355.3) file API field equivalent
79 .;------------------------------------------ --------------------
80 .;.01 INSURANCE COMPANY (ptr to file 36) 1 insurance company name
81 .;.02 IS THIS A GROUP POLICY? (1=yes/0=no) -
82 .;.03 GROUP NAME 8 policy IEN and name
83 .;.04 GROUP NUMBER 18 policy number
84 .;.1 INDIVIDUAL POLICY PATIENT (ptr to file 2)-
85 .S ^UTILITY("DIQ1",$J,355.3,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
86 .S ^UTILITY("DIQ1",$J,355.3,TMP,.03,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,8),U,2)
87 .S ^UTILITY("DIQ1",$J,355.3,TMP,.04,"E")=VAQINS("IBBAPI","INSUR",TMP,18)
88 .;GET SEQUENCE NUMBER FOR INSURANCE
89 .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,2.312,.01)
90 .;ENCRYPT COMPANY NAME
91 .S STRING=$G(^UTILITY("DIQ1",$J,2.312,TMP,.01,"E"))
92 .S ENCSTR=STRING
93 .I $$NCRPFLD^VAQUTL2(2.312,.01) X ENCRYPT
94 .S PRIME=ENCSTR
95 .;STORE COMPANY NAME/ID
96 .S @ARRAY@("ID",2.312,.01,SEQ)=NAME
97 .S @ARRAY@("VALUE",2.312,.01,SEQ)=PRIME
98 .F X=1:1:$L(FLDS(1),";") D
99 ..S Z=$P(FLDS(1),";",X)
100 ..Q:(Z=.01)
101 ..;STORE ID (COMPANY NAME)
102 ..S @ARRAY@("ID",2.312,Z,SEQ)=PRIME
103 ..;ENCRYPT/STORE VALUE
104 ..S STRING=$G(^UTILITY("DIQ1",$J,2.312,TMP,Z,"E"))
105 ..S ENCSTR=STRING
106 ..I $$NCRPFLD^VAQUTL2(2.312,Z) X ENCRYPT
107 ..S @ARRAY@("VALUE",2.312,Z,SEQ)=ENCSTR
108 .;GET SEQUENCE NUMBER FOR COMPANY
109 .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,36,.01)
110 .;ENCRYPT COMPANY NAME
111 .S STRING=$G(^UTILITY("DIQ1",$J,36,TMP,.01,"E"))
112 .S ENCSTR=STRING
113 .I $$NCRPFLD^VAQUTL2(36,.01) X ENCRYPT
114 .S PRIME=ENCSTR
115 .;STORE COMPANY NAME/ID
116 .S @ARRAY@("ID",36,.01,SEQ)=NAME
117 .S @ARRAY@("VALUE",36,.01,SEQ)=PRIME
118 .F X=1:1:$L(FLDS(2),";") D
119 ..S Z=$P(FLDS(2),";",X)
120 ..Q:(Z=.01)
121 ..;STORE ID (COMPANY NAME)
122 ..S @ARRAY@("ID",36,Z,SEQ)=PRIME
123 ..;ENCRYPT/STORE VALUE
124 ..S STRING=$G(^UTILITY("DIQ1",$J,36,TMP,Z,"E"))
125 ..S ENCSTR=STRING
126 ..I $$NCRPFLD^VAQUTL2(36,Z) X ENCRYPT
127 ..S @ARRAY@("VALUE",36,Z,SEQ)=ENCSTR
128 .;GET SEQUENCE NUMBER FOR GROUP PLAN
129 .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,355.3,.01)
130 .;ENCRYPT PLAN NAME
131 .S STRING=$G(^UTILITY("DIQ1",$J,355.3,TMP,.01,"E"))
132 .S ENCSTR=STRING
133 .I $$NCRPFLD^VAQUTL2(355.3,.01) X ENCRYPT
134 .S PRIME=ENCSTR
135 .;STORE PLAN NAME/ID
136 .S @ARRAY@("ID",355.3,.01,SEQ)=NAME
137 .S @ARRAY@("VALUE",355.3,.01,SEQ)=PRIME
138 .F X=1:1:$L(FLDS(3),";") D
139 ..S Z=$P(FLDS(3),";",X)
140 ..Q:(Z=.01)
141 ..;STORE ID (PLAN NAME)
142 ..S @ARRAY@("ID",355.3,Z,SEQ)=PRIME
143 ..;ENCRYPT/STORE VALUE
144 ..S STRING=$G(^UTILITY("DIQ1",$J,355.3,TMP,Z,"E"))
145 ..S ENCSTR=STRING
146 ..I $$NCRPFLD^VAQUTL2(355.3,Z) X ENCRYPT
147 ..S @ARRAY@("VALUE",355.3,Z,SEQ)=ENCSTR
148 .K ^UTILITY("DIQ1",$J)
149 Q
Note: See TracBrowser for help on using the repository browser.