1 | IVM16PR ;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 | ;
|
---|
6 | EN ;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 | ;
|
---|
53 | SETLL16(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 | ;
|
---|
80 | RLL ; 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
|
---|
86 | LL16EXIT Q STOP
|
---|
87 | ;
|
---|
88 | ;
|
---|
89 | SETAPP(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 | ;
|
---|
104 | ANR 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"))
|
---|
107 | APPEXIT Q STOP
|
---|
108 | ;
|
---|
109 | ;
|
---|
110 | PROTOCOL(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 | ;
|
---|
143 | ERROR(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 | ;
|
---|
164 | V(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 | ;
|
---|
169 | GETIT(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 | ;
|
---|
188 | PROTDAT ;;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 | ;
|
---|