source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071P.m@ 923

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1EAS1071P ;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 ;
5EN ;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 ;
18SETLL16(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
26LL16EXIT Q STOP
27 ;
28 ;
29SETAPP(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 ;
42ANR 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"))
45APPEXIT Q STOP
46 ;
47 ;
48PROTOCOL(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 ;
81ERROR(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 ;
96V(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 ;
101GETIT(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 ;
114PROTDAT ;;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 ;
140RESET ;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 ;
168REMOVE(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
Note: See TracBrowser for help on using the repository browser.