EAS1071P	;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
	;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
	Q
	;
EN	;ENTRY POINT
	;
	N ADDR,AN,PORT,SLLN,STATION,TCPDATA,AN,STOP,VER,DA,FILE,RET,ERROR
	;
	; Get site's Station #
	S STATION=$P($$SITE^VASITE,"^",3)
	;
	S STOP=0
	Q:$$SETLL16(.SLLN)
	Q:$$SETAPP(STATION,.AN)
	D PROTOCOL(STATION,SLLN,.AN)
	Q
	;
SETLL16(SLLN)	;Create Logical link
	N ADDR,PORT,RET,VISN,M,IENS
	;
	S PORT=""           ;Vitria Port#
	S ADDR=""           ;IP address is modified by EAS1072P
	S SLLN="LLESROUT"
	S RET=$$LL16^EAS1071Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
	I +RET<0 D ERROR(RET,"ESR Send Link:"_SLLN) Q 1
LL16EXIT	Q STOP
	;
	;
SETAPP(STATION,AN)	;
	;INPUT    STATION = Station #
	;         AN      = Array containing all the Application Names
	;
	;OUTPUT   0 : Success, 1 : Error
	;
	;PURPOSE  Create the sending and receiving application definitions.
	;
	N RECVAPP,SENDAPP
	S (SENDAPP,AN("S"))="VAMC "_STATION
	I '$O(^HL(771,"B",SENDAPP,0)) D  Q STOP
	.D ERROR("^HL7 APPLICATION PARAMETER "_SENDAPP_" NOT FOUND","Client Protocols - Install aborted")
	;
ANR	S AN("R")="ESR"
	S RECVAPP=$$APP^EAS1071Q(AN("R"),"a","200ESR","USA")
	I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
APPEXIT	Q STOP
	;
	;
PROTOCOL(STATION,SLLN,AN)	;
	;INPUT    STATION = Station #
	;         RLLN    = Receiving Logical Link Name
	;         SLLN    = Sending Logical Link Name
	;         AN      = Array containing the Application Names
	;
	;OUTPUT   None
	;
	;PURPOSE  Using the table in line label PROTDAT create the
	;         protocols (Subscriber and Event Driver) for the
	;         ESR/Vitria TCP/IP interfaces
	;
	N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
	S N1="EAS ESR "_STATION,V="2.3.1"
	;
	S LNCNT=1
	F  S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END"  D  Q:STOP
	. K D,RESULT
	. F N=3:1 Q:$P(LINE,";",N)="LEND"  S D(N)=$$V($P(LINE,";",N))
	. S NAM=D(3)_D(4)_D(5)
	. D:NAM["CLIENT"
	. . S SIEN=$$SP^EAS1071Q(NAM,D(6),D(7),D(8),D(9),D(10))
	. . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
	. D:NAM["SERVER"
	. . N TMPNAM,ITEMTXT
	. . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
	. . S ITEMTXT=$$GETIT(TMPNAM)
	. . S RESULT=$$EDP^EAS1071Q(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
	. . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
	. S LNCNT=LNCNT+1
	K D
	Q
	;
ERROR(ERRMSG,SUBJ)	;Display error message and set STOP=1
	;
	N ARR
	S STOP=1
	S ARR(1)="===================================================="
	S ARR(2)="=                   ERROR                          ="
	S ARR(3)="===================================================="
	S ARR(4)="When creating "_SUBJ
	S ARR(5)="===================================================="
	S ARR(6)="**ERROR MSG: "_$P(ERRMSG,"^",2)
	;
	D BMES^XPDUTL(.ARR)
	;
	Q
	;
V(VALUE)	;FUNCTION: If variable then pass back value of it.
	;
	I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
	Q VALUE
	;
GETIT(N)	;FUNCTION: Given Message Type and Event Type return the
	;          Transmission Description.
	;
	Q:N="ORUZEG" "ENROLLMENT GROUP THRESHOLD/Unsolicited ESR to VAMC"
	Q:N="ORUZ04H" "INSURANCE/Unsolicited ESR to VAMC"
	Q:N="ORUZ05" "DEMOGRAPHIC DATA/Unsolicited ESR to VAMC"
	Q:N="ORUZ10" "INCOME TEST DATA/Unsolicited ESR to VAMC"
	Q:N="ORUZ11" "ENROLLMENT/ELIGIBILITY DATA/Unsolicited ESR to VAMC"
	Q:N="ORFZ10" "FINANCIAL QUERY/Reply ESR to VAMC"
	Q:N="ORFZ11" "ENROLLMENT/ELIGIBILITY QUERY/Reply ESR to VAMC"
	Q:N="QRYZ07" "IVM INDIVIDUAL QUERY FULL DATA/Query ESR to VAMC"
	Q ""
	;
PROTDAT	;;VAMC SIDE PROTOCOLS
	;;@N1;; ORU-Z04 CLIENT H;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
	;;@N1;; ORU-Z04 SERVER H;ORU;Z04;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; ORU-Z05 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
	;;@N1;; ORU-Z05 SERVER;ORU;Z05;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; ORU-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
	;;@N1;; ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
	;;@N1;; ORU-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
	;;@N1;; ORU-Z10 SERVER;ORU;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; ORU-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC3;LEND
	;;@N1;; ORU-Z11 SERVER;ORU;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; ORF-Z07 CLIENT;@SLLN;@AN("R");ACK;;;LEND
	;;@N1;; ORF-Z10 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
	;;@N1;; ORF-Z10 SERVER;ORF;Z10;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; ORF-Z11 CLIENT;@SLLN;@AN("S");ACK;;D ORF^EASCM;LEND
	;;@N1;; ORF-Z11 SERVER;ORF;Z11;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; QRY-Z07 CLIENT;@SLLN;@AN("S");ORF;Z07;D QRY^EASPREC4;LEND
	;;@N1;; QRY-Z07 SERVER;QRY;Z07;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;@N1;; QRY-Z10 CLIENT;@SLLN;@AN("R");ORF;Z10;;LEND
	;;@N1;; QRY-Z11 CLIENT;@SLLN;@AN("R");ORF;Z11;;LEND
	;;@N1;; MFN-ZEG CLIENT;@SLLN;@AN("S");MFK;ZEG;D MFN^EASEGT2;LEND
	;;@N1;; MFN-ZEG SERVER;MFN;ZEG;@V;@AN("R");;@SIEN;ESR-to-Site Messaging Inactive;LEND
	;;END
	;
	;Utilities section
	;
RESET	;Delete all existing EAS ESR protocols (in the current list)
	Q
	N DA,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LINE,LCT,NAM,PREFIX
	;Prompt
	S DIR(0)="Y",DIR("B")="NO"
	S DIR("A")="Are you really sure you wish to proceed:"
	S DIR("A",1)="**WARNING**"
	S DIR("A",2)=""
	S DIR("A",3)="This utility will delete all ESR protocols from Vista"
	S DIR("A",4)=""
	D ^DIR
	I $D(DIROUT)!$D(DIRUT)!$D(DTOUT)!$D(DUOUT) W !!,"Aborted by user" Q
	I 'Y W !!,"Aborted by user" Q
	;
	W !
	; Get site's Station #
	S PREFIX="EAS ESR "_$P($$SITE^VASITE,"^",3)
	F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END"  D
	.S NAM=PREFIX_$P(LINE,";",5)
	.S DA=$O(^ORD(101,"B",NAM,0)) I 'DA W !,NAM,?35,"NOT FOUND" Q
	.;If this is a SUBSCRIBER remove from SERVER
	.I $O(^ORD(101,"AB",DA,0)) D REMOVE(DA,NAM)
	.;Delete the protocol
	.S DIK="^ORD(101,"
	.D ^DIK
	.W !,NAM,?35,"DELETED"
	Q
	;
REMOVE(CLIENT,CNAM)	;Remove clients from server
	N DA,DIK,SERV,SNAM,SUB
	S SERV=0
	F  S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV  D
	.S SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
	.F  S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB  D
	..S DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," D ^DIK
	..W !,CNAM,?35,"REMOVED FROM : ",SNAM
	Q