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