source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM16PR.m@ 1094

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1IVM16PR ;HEC/KSD - Patch Pre-Install rtn IVM*2*34;01.23.2001 ; 5/6/02 12:42pm
2 ;;2.0;INCOME VERIFICATION;**34**;01.23.2001
3 ;
4 Q
5 ;
6EN ;ENTRY POINT
7 ;
8 N ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR,DGENDA,IEN771,ORFIEN
9 ;
10 ; Get site's Station #
11 S STATION=$P($$SITE^VASITE,"^",3)
12 ;
13 ; Update ^HL(771) for ORF-Z06 to still be v1.5
14 S IEN771=+$O(^HL(771,"B","IVM",0))
15 D:IEN771>0
16 . S ORFIEN=+$O(^HL(771.2,"B","ORF",0)) Q:ORFIEN=0
17 . S IEN7712=+$O(^HL(771,IEN771,"MSG","B",ORFIEN,0)) Q:IEN7712=0
18 . S FILE=771.06
19 . S DGENDA(1)=IEN771,DGENDA=IEN7712
20 . K DATA
21 . S DATA(1)="ORF^IVMPRECZ"
22 . S RET=$$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
23 ;
24 ; Define ZEG segment if necessary
25 S STOP=0
26 S DA=+$O(^HL(779.001,"B","ZEG",0))
27 D:'DA
28 . S FILE=779.001
29 . K DATA
30 . S DATA(.01)="ZEG"
31 . S DATA(2)="Enrollment Threshold"
32 . S RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
33 . K DATA
34 . I ERROR'=""!(+RET=0) D ERROR(ERROR,"Creating ZEG") Q
35 . S DGENDA(1)=RET
36 . S VER=2.1
37 . S DA=+$O(^HL(779.001,DGENDA(1),1,"B",VER,0))
38 . D:'DA
39 . . K DATA
40 . . S DATA(.01)=+$O(^HL(771.5,"B",VER,0))
41 . . I DATA(.01)'>0 D ERROR("Version "_VER_" invalid","Creating ZEG") Q
42 . . S FILE=779.0101
43 . . S RET=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
44 . . K DATA
45 . . I ERROR'=""!(+RET=0) D ERROR(ERROR,"Creating ZEG") Q
46 ;
47 Q:STOP
48 Q:$$SETLL16(STATION,.RLLN,.SLLN)
49 Q:$$SETAPP(STATION,.AN)
50 D PROTOCOL(STATION,RLLN,SLLN,.AN)
51 Q
52 ;
53SETLL16(STATION,RLLN,SLLN) ;
54 ;INPUT STATION = Station #
55 ; RLLN = Receiving Logical Link Name
56 ; SLLN = Sending Logical Link Name
57 ;
58 ;OUTPUT 0 : Success, 1 : Error
59 ;
60 ;PURPOSE Create the Receiving and Sending Logical Link.
61 ;
62 N ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
63 ;
64 ; Get Site's VISN
65 S VISN="",M=0
66 F S M=$O(^DIC(4,STATION,7,M)) Q:M="" D Q:VISN'=""
67 . S IENS=M_","_STATION
68 . Q:$$GET1^DIQ(4.014,IENS,.01)'="VISN"
69 . S VISN=$P($$GET1^DIQ(4.014,IENS,1)," ",2)
70 S:VISN="" VISN=23
71 S PORT=6000+VISN ;HEC production/quality assurance
72 ;
73 ; Sending Logical Link
74 S SLLN="LL"_VISN_"VISN"
75 ;S ADDR="10.4.221.116" ;HEC development
76 S ADDR="10.4.221.103" ;HEC production
77 S RET=$$LL16^IVM16PF(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
78 I +RET<0 D ERROR(RET,"v1.6 Send Link:"_SLLN) Q 1
79 ;
80RLL ; Receiving Logical Link
81 S RLLN="LL"_STATION_"VAMC"
82 S ADDR=""
83 S PORT=5000 ;all stations production
84 S RET=$$LL16^IVM16PF(RLLN,"TCP","MS",10,ADDR,PORT,"M","N","")
85 I +RET<0 D ERROR(RET,"v1.6 Receive Link:"_RLLN) Q 1
86LL16EXIT Q STOP
87 ;
88 ;
89SETAPP(STATION,AN) ;
90 ;INPUT STATION = Station #
91 ; AN = Array containing all the Application Names
92 ;
93 ;OUTPUT 0 : Success, 1 : Error
94 ;
95 ;PURPOSE Create the sending and receiving application definitions.
96 ; IVM and IVM CENTER needed for 1.5 usage should
97 ; already be defined.
98 ;
99 N RECVAPP,SENDAPP
100 S AN("S")="VAMC "_STATION
101 S SENDAPP=$$APP^IVM16PF(AN("S"),"a",STATION,"USA")
102 I +SENDAPP<0 D ERROR(SENDAPP,"Sending App:"_AN("S")) G APPEXIT
103 ;
104ANR S AN("R")="HEC "_STATION
105 S RECVAPP=$$APP^IVM16PF(AN("R"),"a",724,"USA")
106 I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
107APPEXIT Q STOP
108 ;
109 ;
110PROTOCOL(STATION,RLLN,SLLN,AN) ;
111 ;INPUT STATION = Station #
112 ; RLLN = Receiving Logical Link Name
113 ; SLLN = Sending Logical Link Name
114 ; AN = Array containing the Application Names
115 ;
116 ;OUTPUT None
117 ;
118 ;PURPOSE Using the table in line label PROTDAT create the
119 ; protocols (Subscriber and Event Driver) for the
120 ; v1.6 TCP/IP interfaces
121 ;
122 N RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET
123 S N1="VAMC "_STATION,V=2.1
124 ;
125 S LNCNT=1
126 F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
127 . K D,RESULT
128 . F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
129 . S NAM=D(3)_D(4)_D(5)
130 . D:NAM["CLIENT"
131 . . S SIEN=$$SP^IVM16PF(NAM,D(6),D(7),D(8),D(9),D(10))
132 . . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
133 . D:NAM["SERVER"
134 . . N TMPNAM,ITEMTXT
135 . . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
136 . . S ITEMTXT=$$GETIT(TMPNAM)
137 . . S RESULT=$$EDP^IVM16PF(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
138 . . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
139 . S LNCNT=LNCNT+1
140 K D
141 Q
142 ;
143ERROR(ERRMSG,SUBJ) ;
144 ;INPUT ERRMSG = Error Message text
145 ; SUBJ = Subject of the Message
146 ;
147 ;OUTPUT none
148 ;
149 ;PURPOSE Display an error message to the user. Set the
150 ; variable STOP=1 which will stop the routine
151 ; from continuing to run after an error is found.
152 ;
153 N TXT
154 S STOP=1
155 S TXT=$P(ERRMSG,"^",2)
156 W !,"===================================================="
157 W !,"= ERROR ="
158 W !,"===================================================="
159 W !,"When creating "_SUBJ
160 W !,"===================================================="
161 W !,"**ERROR MSG: ",TXT
162 Q
163 ;
164V(VALUE) ;FUNCTION: If variable then pass back value of it.
165 ;
166 I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
167 Q VALUE
168 ;
169GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
170 ; Transmission Description.
171 Q:N="ORUZ04H" "INSURANCE/Unsolicited HEC to VAMC"
172 Q:N="ORUZ04V" "INSURANCE/Unsolicited VAMC to HEC"
173 Q:N="ORUZ05" "DEMOGRAPHIC DATA/Unsolicited HEC to VAMC"
174 Q:N="ORUZ06" "DELETE MEANS TEST/Unsolicited HEC to VAMC"
175 Q:N="ORUZ07" "FULL DATA/Unsolicited VAMC to HEC"
176 Q:N="QRYZ07" "IVM INDIVIDUAL QUERY FULL DATA/Query HEC to VAMC"
177 Q:N="ORFZ07" "IVM INDIVIDUAL ACK/REPLY FULL DATA/Reply HEC to VAMC"
178 Q:N="ORUZ09" "IVM BILLING/COLLECTION/Unsolicited VAMC to HEC"
179 Q:N="ORUZ10" "INCOME TEST DATA/Unsolicited HEC to VAMC"
180 Q:N="QRYZ10" "FINANCIAL QUERY/Query VAMC to HEC"
181 Q:N="ORFZ10" "FINANCIAL QUERY/Reply HEC to VAMC"
182 Q:N="ORUZ11" "ENROLLMENT/ELIGIBILITY DATA/Unsolicited HEC to VAMC"
183 Q:N="QRYZ11" "ENROLLMENT/ELIGIBILITY QUERY/Query VAMC to HEC"
184 Q:N="ORFZ11" "ENROLLMENT/ELIGIBILITY QUERY/Reply HEC to VAMC"
185 Q:N="MFNZEG" "ENROLLMENT GROUP THRESHOLD/Unsolicited HEC to VAMC"
186 Q ""
187 ;
188PROTDAT ;;VAMC SIDE PROTOCOLS
189 ;;@N1;; ORU-Z04 CLIENT H;@SLLN;@AN("S");ACK;;D ORU^IVMPREC2;LEND
190 ;;@N1;; ORU-Z04 SERVER H;ORU;Z04;@V;@AN("R");D ACK^IVMPREC1;@SIEN;;LEND
191 ;;@N1;; ORU-Z04 CLIENT V;@SLLN;@AN("R");ACK;;D ORU^IVMPREC2;LEND
192 ;;@N1;; ORU-Z04 SERVER V;ORU;Z04;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
193 ;;@N1;; ORU-Z05 CLIENT;@SLLN;@AN("S");ACK;;D ORU^IVMPREC2;LEND
194 ;;@N1;; ORU-Z05 SERVER;ORU;Z05;@V;@AN("R");;@SIEN;;LEND
195 ;;@N1;; ORU-Z06 CLIENT;@SLLN;@AN("S");ACK;;D ORU^IVMPREC2;LEND
196 ;;@N1;; ORU-Z06 SERVER;ORU;Z06;@V;@AN("R");;@SIEN;;LEND
197 ;;@N1;; ORU-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
198 ;;@N1;; ORU-Z07 SERVER;ORU;Z07;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
199 ;;@N1;; QRY-Z07 CLIENT;@SLLN;@AN("S");ORF;Z07;D QRY^IVMPREC;LEND
200 ;;@N1;; QRY-Z07 SERVER;QRY;Z07;@V;@AN("R");;@SIEN;;LEND
201 ;;@N1;; ORF-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
202 ;;@N1;; ORF-Z07 SERVER;ORF;Z07;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
203 ;;@N1;; ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
204 ;;@N1;; ORU-Z09 SERVER;ORU;Z09;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
205 ;;@N1;; ORU-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORU^IVMPREC2;LEND
206 ;;@N1;; ORU-Z10 SERVER;ORU;Z10;@V;@AN("R");;@SIEN;;LEND
207 ;;@N1;; QRY-Z10 CLIENT;@SLLN;@AN("R");ORF;Z10;;LEND
208 ;;@N1;; QRY-Z10 SERVER;QRY;Z10;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
209 ;;@N1;; ORF-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORF^IVMCM;LEND
210 ;;@N1;; ORF-Z10 SERVER;ORF;Z10;@V;@AN("R");;@SIEN;;LEND
211 ;;@N1;; ORU-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORU^IVMPREC2;LEND
212 ;;@N1;; ORU-Z11 SERVER;ORU;Z11;@V;@AN("R");;@SIEN;;LEND
213 ;;@N1;; QRY-Z11 CLIENT;@SLLN;@AN("R");ORF;Z11;;LEND
214 ;;@N1;; QRY-Z11 SERVER;QRY;Z11;@V;@AN("S");D ACK^IVMPREC1;@SIEN;;LEND
215 ;;@N1;; ORF-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORF^IVMCM;LEND
216 ;;@N1;; ORF-Z11 SERVER;ORF;Z11;@V;@AN("R");;@SIEN;;LEND
217 ;;@N1;; MFN-ZEG CLIENT;@SLLN;@AN("S");MFK;ZEG;D MFN^DGENEGT2;LEND
218 ;;@N1;; MFN-ZEG SERVER;MFN;ZEG;@V;@AN("R");;@SIEN;;LEND
219 ;;END
220 ;
Note: See TracBrowser for help on using the repository browser.