1 | EAS1071P ;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
|
---|
2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | EN ;ENTRY POINT
|
---|
6 | ;
|
---|
7 | N ADDR,AN,PORT,SLLN,STATION,TCPDATA,AN,STOP,VER,DA,FILE,RET,ERROR
|
---|
8 | ;
|
---|
9 | ; Get site's Station #
|
---|
10 | S STATION=$P($$SITE^VASITE,"^",3)
|
---|
11 | ;
|
---|
12 | S STOP=0
|
---|
13 | Q:$$SETLL16(.SLLN)
|
---|
14 | Q:$$SETAPP(STATION,.AN)
|
---|
15 | D PROTOCOL(STATION,SLLN,.AN)
|
---|
16 | Q
|
---|
17 | ;
|
---|
18 | SETLL16(SLLN) ;Create Logical link
|
---|
19 | N ADDR,PORT,RET,VISN,M,IENS
|
---|
20 | ;
|
---|
21 | S PORT="" ;Vitria Port#
|
---|
22 | S ADDR="" ;IP address is modified by EAS1072P
|
---|
23 | S SLLN="LLESROUT"
|
---|
24 | S RET=$$LL16^EAS1071Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
|
---|
25 | I +RET<0 D ERROR(RET,"ESR Send Link:"_SLLN) Q 1
|
---|
26 | LL16EXIT Q STOP
|
---|
27 | ;
|
---|
28 | ;
|
---|
29 | SETAPP(STATION,AN) ;
|
---|
30 | ;INPUT STATION = Station #
|
---|
31 | ; AN = Array containing all the Application Names
|
---|
32 | ;
|
---|
33 | ;OUTPUT 0 : Success, 1 : Error
|
---|
34 | ;
|
---|
35 | ;PURPOSE Create the sending and receiving application definitions.
|
---|
36 | ;
|
---|
37 | N RECVAPP,SENDAPP
|
---|
38 | S (SENDAPP,AN("S"))="VAMC "_STATION
|
---|
39 | I '$O(^HL(771,"B",SENDAPP,0)) D Q STOP
|
---|
40 | .D ERROR("^HL7 APPLICATION PARAMETER "_SENDAPP_" NOT FOUND","Client Protocols - Install aborted")
|
---|
41 | ;
|
---|
42 | ANR S AN("R")="ESR"
|
---|
43 | S RECVAPP=$$APP^EAS1071Q(AN("R"),"a","200ESR","USA")
|
---|
44 | I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
|
---|
45 | APPEXIT Q STOP
|
---|
46 | ;
|
---|
47 | ;
|
---|
48 | PROTOCOL(STATION,SLLN,AN) ;
|
---|
49 | ;INPUT STATION = Station #
|
---|
50 | ; RLLN = Receiving Logical Link Name
|
---|
51 | ; SLLN = Sending Logical Link Name
|
---|
52 | ; AN = Array containing the Application Names
|
---|
53 | ;
|
---|
54 | ;OUTPUT None
|
---|
55 | ;
|
---|
56 | ;PURPOSE Using the table in line label PROTDAT create the
|
---|
57 | ; protocols (Subscriber and Event Driver) for the
|
---|
58 | ; ESR/Vitria TCP/IP interfaces
|
---|
59 | ;
|
---|
60 | N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
|
---|
61 | S N1="EAS ESR "_STATION,V="2.3.1"
|
---|
62 | ;
|
---|
63 | S LNCNT=1
|
---|
64 | F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
|
---|
65 | . K D,RESULT
|
---|
66 | . F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
|
---|
67 | . S NAM=D(3)_D(4)_D(5)
|
---|
68 | . D:NAM["CLIENT"
|
---|
69 | . . S SIEN=$$SP^EAS1071Q(NAM,D(6),D(7),D(8),D(9),D(10))
|
---|
70 | . . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
|
---|
71 | . D:NAM["SERVER"
|
---|
72 | . . N TMPNAM,ITEMTXT
|
---|
73 | . . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
|
---|
74 | . . S ITEMTXT=$$GETIT(TMPNAM)
|
---|
75 | . . S RESULT=$$EDP^EAS1071Q(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
|
---|
76 | . . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
|
---|
77 | . S LNCNT=LNCNT+1
|
---|
78 | K D
|
---|
79 | Q
|
---|
80 | ;
|
---|
81 | ERROR(ERRMSG,SUBJ) ;Display error message and set STOP=1
|
---|
82 | ;
|
---|
83 | N ARR
|
---|
84 | S STOP=1
|
---|
85 | S ARR(1)="===================================================="
|
---|
86 | S ARR(2)="= ERROR ="
|
---|
87 | S ARR(3)="===================================================="
|
---|
88 | S ARR(4)="When creating "_SUBJ
|
---|
89 | S ARR(5)="===================================================="
|
---|
90 | S ARR(6)="**ERROR MSG: "_$P(ERRMSG,"^",2)
|
---|
91 | ;
|
---|
92 | D BMES^XPDUTL(.ARR)
|
---|
93 | ;
|
---|
94 | Q
|
---|
95 | ;
|
---|
96 | V(VALUE) ;FUNCTION: If variable then pass back value of it.
|
---|
97 | ;
|
---|
98 | I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
|
---|
99 | Q VALUE
|
---|
100 | ;
|
---|
101 | GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
|
---|
102 | ; Transmission Description.
|
---|
103 | ;
|
---|
104 | Q:N="ORUZEG" "ENROLLMENT GROUP THRESHOLD/Unsolicited ESR to VAMC"
|
---|
105 | Q:N="ORUZ04H" "INSURANCE/Unsolicited ESR to VAMC"
|
---|
106 | Q:N="ORUZ05" "DEMOGRAPHIC DATA/Unsolicited ESR to VAMC"
|
---|
107 | Q:N="ORUZ10" "INCOME TEST DATA/Unsolicited ESR to VAMC"
|
---|
108 | Q:N="ORUZ11" "ENROLLMENT/ELIGIBILITY DATA/Unsolicited ESR to VAMC"
|
---|
109 | Q:N="ORFZ10" "FINANCIAL QUERY/Reply ESR to VAMC"
|
---|
110 | Q:N="ORFZ11" "ENROLLMENT/ELIGIBILITY QUERY/Reply ESR to VAMC"
|
---|
111 | Q:N="QRYZ07" "IVM INDIVIDUAL QUERY FULL DATA/Query ESR to VAMC"
|
---|
112 | Q ""
|
---|
113 | ;
|
---|
114 | PROTDAT ;;VAMC SIDE PROTOCOLS
|
---|
115 | ;;@N1;; ORU-Z04 CLIENT H;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
|
---|
116 | ;;@N1;; ORU-Z04 SERVER H;ORU;Z04;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
117 | ;;@N1;; ORU-Z05 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
|
---|
118 | ;;@N1;; ORU-Z05 SERVER;ORU;Z05;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
119 | ;;@N1;; ORU-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
|
---|
120 | ;;@N1;; ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
|
---|
121 | ;;@N1;; ORU-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
|
---|
122 | ;;@N1;; ORU-Z10 SERVER;ORU;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
123 | ;;@N1;; ORU-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
|
---|
124 | ;;@N1;; ORU-Z11 SERVER;ORU;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
125 | ;;@N1;; ORF-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
|
---|
126 | ;;@N1;; ORF-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
|
---|
127 | ;;@N1;; ORF-Z10 SERVER;ORF;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
128 | ;;@N1;; ORF-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
|
---|
129 | ;;@N1;; ORF-Z11 SERVER;ORF;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
130 | ;;@N1;; QRY-Z07 CLIENT;@SLLN;@AN("S");ORF;Z07;D QRY^EASPREC4;LEND
|
---|
131 | ;;@N1;; QRY-Z07 SERVER;QRY;Z07;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
132 | ;;@N1;; QRY-Z10 CLIENT;@SLLN;@AN("R");ORF;Z10;;LEND
|
---|
133 | ;;@N1;; QRY-Z11 CLIENT;@SLLN;@AN("R");ORF;Z11;;LEND
|
---|
134 | ;;@N1;; MFN-ZEG CLIENT;@SLLN;@AN("S");MFK;ZEG;D MFN^EASEGT2;LEND
|
---|
135 | ;;@N1;; MFN-ZEG SERVER;MFN;ZEG;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
|
---|
136 | ;;END
|
---|
137 | ;
|
---|
138 | ;Utilities section
|
---|
139 | ;
|
---|
140 | RESET ;Delete all existing EAS ESR protocols (in the current list)
|
---|
141 | Q
|
---|
142 | N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LINE,LCT,NAM,PREFIX
|
---|
143 | ;Prompt
|
---|
144 | S DIR(0)="Y",DIR("B")="NO"
|
---|
145 | S DIR("A")="Are you really sure you wish to proceed:"
|
---|
146 | S DIR("A",1)="**WARNING**"
|
---|
147 | S DIR("A",2)=""
|
---|
148 | S DIR("A",3)="This utility will delete all ESR protocols from Vista"
|
---|
149 | S DIR("A",4)=""
|
---|
150 | D ^DIR
|
---|
151 | I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) W !!,"Aborted by user" Q
|
---|
152 | I 'Y W !!,"Aborted by user" Q
|
---|
153 | ;
|
---|
154 | W !
|
---|
155 | ; Get site's Station #
|
---|
156 | S PREFIX="EAS ESR "_$P($$SITE^VASITE,"^",3)
|
---|
157 | F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D
|
---|
158 | .S NAM=PREFIX_$P(LINE,";",5)
|
---|
159 | .S DA=$O(^ORD(101,"B",NAM,0)) I 'DA W !,NAM,?35,"NOT FOUND" Q
|
---|
160 | .;If this is a SUBSCRIBER remove from SERVER
|
---|
161 | .I $O(^ORD(101,"AB",DA,0)) D REMOVE(DA,NAM)
|
---|
162 | .;Delete the protocol
|
---|
163 | .S DIK="^ORD(101,"
|
---|
164 | .D ^DIK
|
---|
165 | .W !,NAM,?35,"DELETED"
|
---|
166 | Q
|
---|
167 | ;
|
---|
168 | REMOVE(CLIENT,CNAM) ;Remove clients from server
|
---|
169 | N DA,DIK,SERV,SNAM,SUB
|
---|
170 | S SERV=0
|
---|
171 | F S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV D
|
---|
172 | .S SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
|
---|
173 | .F S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB D
|
---|
174 | ..S DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," D ^DIK
|
---|
175 | ..W !,CNAM,?35,"REMOVED FROM : ",SNAM
|
---|
176 | Q
|
---|