EAS1071A ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:01pm
 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
 ;
 ;PROTOCOL FILE access through DBIA 3173
 ;
TAG(RETURN,MODE) ; Called from EAS ESR MESSAGING RPC (triggered from HEC)
 
STOP
 
STOP=0
 
;Enable ESR
 
MODE=1 EN1(.RETURND:STOP RESET(.RETURNQ
 
;Set ESR as system of record
 
MODE=2 QRY(.RETURN,"ESR"D:STOP QRY(.RETURN,"HEC"Q
 
;Remove HEC
 
MODE=3 EN^EAS1071B(.RETURND:STOP RESET^EAS1071B(.RETURN)  Q
 
;Remove ESR
 
MODE=4 RESET(.RETURND:STOP EN1(.RETURNQ
 
;Set HEC as system of record
 
MODE=5 QRY(.RETURN,"HEC"D:STOP QRY(.RETURN,"ESR"Q
 
;Enable HEC
 
MODE=6 RESET^EAS1071B(.RETURNQ
 
;
 
RETURN="-1^RPC Called with invalid MODE parameter"
 
Q
 
;
EN1(ARR) ;Enable ESR messaging
 ;
 
ADDR,PORT,STATION,TCPDATA,SLLN,VER,DA,FILE,RET,ERROR
 
;
 
S:MODE=1 ARR="ESR messaging NOT enabled"
 ;
 ; Get site's Station #
 
STATION=$P($$SITE^VASITE,"^",3)
 
;
 ;Activate EAS ESR event driver server protocols
 
PROTOCOL Q:STOP
 
;Update VAMC event driver protocols (outgoing)
 
DRIVERS(STATIONQ:STOP
 
;Set production IP address and port on Logical Links
 
SETLL16 Q:STOP
 
;
 
S:MODE=1 ARR="ESR messaging enabled"
 ;
 
Q
 
;
SETLL16 ;Update Sending Logical Link
 ;
 
ADDR,PORT,SHUTDOWN,SLLN,RET
 
;
 ;Production Install
 
I $$PROD^XUPROD D  Q:STOP
 
.PORT=8090            ;Vitria production port#
 
.ADDR=$$IPLIVE        ;ESR production (from dental package)
 
.SHUTDOWN=""          ;Shutdown LLP set to No
 
.;Abort if no IP address found for production account
 
.ADDR="" ABORT1 Q
 
;Test/development account values to null
 
E  S PORT="",ADDR="00.0.000.00",SHUTDOWN=1
 
;Update value in logical link file
 
SLLN="LLESROUT",RET=$$LL16(SLLN,ADDR,PORT,SHUTDOWN)
 
+RET<0 ABORT2(RET,"ESR Send Link:"_SLLN)
 
Q
 
;
 ;
PROTOCOL ;Remove Disable Text from EAS ESR server protocols
 ;
 
RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
 
NAM="EAS ESR"
 
F  S NAM=$O(^ORD(101,"B",NAM)) Q:NAM'["EAS ESR"  D  Q:STOP
 
Q:NAM'["SERVER"  Q:NAM["QRY-Z10"  Q:NAM["QRY-Z11"
 
RESULT=$$EDP(NAM,"")
 . 
+RESULT<0 ABORT2(RESULT,"Event Driver:"_NAM)
 
;
 
Q
 
;
DRIVERS(STATION) ;Add EAS ESR client to VAMC event driver
 ;
 
ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
 
LNCNT=1
 
F  S LINE=$T(PROTDAT+LNCNTQ:$P(LINE,";",3)="END"  D  Q:STOP
 
.NAM="VAMC "_STATION_" "_$P(LINE,";",3)_" SERVER"
 
.IEN101=$O(^ORD(101,"B",NAM,0))
 .
+IEN101=0 D  Q
 
..ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
 
..RETURN=-1_"^"_ERROR
 
..ABORT2(RETURN,"Event Driver:"_NAM)
 .
;
 
.;Client Protocol
 
.SNAM="EAS ESR "_STATION_" "_$P(LINE,";",3)_" CLIENT"
 
.SIEN101=$O(^ORD(101,"B",SNAM,0))
 .
+SIEN101=0 D  Q
 
..ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
 
..RETURN=-1_"^"_ERROR
 
..ABORT2(RETURN,"Subscriber:"_SNAM)
 .
;Skip if already present
 
.I $D(^ORD(101,IEN101,775,"B",SIEN101)) D  Q
 
..WARN(NAM,SNAM)
 ..
LNCNT=LNCNT+1
 .
;Add subscriber to event driver
 
.RETURN=$$SUBSCR(IEN101,SIEN101)
 .
+RETURN<0 ABORT2(RETURN,"driver with Subscriber:"_SNAMQ
 
.LNCNT=LNCNT+1
 
;
 
Q
 
;
WARN(EDP,SP) ;Display Warning Message
 ;
 
ARR
 
;
 
ARR(1)="===================================================="
 
ARR(2)="=                 WARNING                          ="
 
ARR(3)="===================================================="
 
ARR(4)="When updating "_EDP
 
ARR(5)="===================================================="
 
ARR(5)="**"_SP_" is already defined**"
 ;
 
Q
 
;
ABORT1 ;Warning and mail message in case of no IP address
 ;
 
STOP=1
 
ARR(1)="===================================================="
 
ARR(2)="=                 ABORTED                          ="
 
ARR(3)="===================================================="
 
ARR(4)="No IP address for VIE was found on the system"
 
ARR(5)="The IP address must be entered on the LLESROUT"
 
ARR(6)="logical link (file #870) before ESR transmissions"
 
ARR(7)="can begin"
 
Q
 
;
ABORT2(ERRMSG,SUBJ) ;Display Install Error message and set STOP
 ;
 
STOP=1
 
ARR(1)="===================================================="
 
ARR(2)="=                   ABORTED                        ="
 
ARR(3)="===================================================="
 
ARR(4)="When updating "_SUBJ
 
ARR(5)="===================================================="
 
ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
 
Q
 
;
LL16(LLNAME,TCPADDR,TCPPORT,SHUTDOWN) ;Update Logical Link Port and Address
 ;
 
FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
 
FILE=870
 
IEN870=$O(^HLCS(870,"B",LLNAME,0))
 
'IEN870 D  Q RETURN
 
ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
 
RETURN=-1_"^"_ERROR
 
;
 
DATA(400.01)=TCPADDR                    ;TCP/IP ADDRESS
 
DATA(400.02)=TCPPORT                    ;TCP/IP PORT
 
DATA(4.5)=1                             ;AUTOSTART
 
DATA(14)=SHUTDOWN                       ;SHUTDOWN LLP
 ;
 
RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
 
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
 
;
 
RETURN
 
;
EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
 ;
 
DATA,FILE,DGENDA,RETURN,ERROR,DA
 
FILE=101
 
; If already exists then skip
 
IEN101=$O(^ORD(101,"B",PNAME,0))
 
'IEN101 D  Q RETURN
 
ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
 
RETURN=-1_"^"_ERROR
 
;
 
DATA(2)=DTXT
 
RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
 
ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
 
;
 
RETURN
 
;
SUBSCR(IEN101,SIEN101) ;Add client to event driver as a subscriber
 ;
 
DATA,DGENDA,ERROR,FILE,RETURN
 
DGENDA(1)=IEN101
 
FILE=101.0775
 
DATA(.01)=SIEN101
 
RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
 
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
 
;
 
RETURN
 
;
IPLIVE() ;Get IP address for production system
 ;
 ;Search for DENTVHLAAC logical link
 
IENS=$$FIND1^DIC(870,"","X","DENTVHLAAC","","","ERR")
 
;If not found return null IP address
 
'IENS ""
 ;Otherwise return TCP/IP ADDRESS
 
Q $$GET1^DIQ(870,IENS_",",400.01)
 
;
RESET(ARR) ;Disable or Remove ESR protocols
 
DA,DIK,ERROR,IEN101,LINE,LCT,NAM
 
PREFHEC,PREFESR,SIEN101,SNAM,STOP,SITE
 
;
 
MODE=4 ARR="ESR messaging NOT disabled"
 ;
 ; Get site's Station #
 
SITE=$P($$SITE^VASITE,"^",3)
 
PREFHEC="VAMC "_SITE_" "
 
PREFESR="EAS ESR "_SITE_" "
 
STOP=0
 
;
 
I $$SOR^EAS1071C(PREFESR,PREFHECD  Q
 
.ARR="Unable to disable messaging, ESR is SOR"
 ;
 ;Disable to Vista to ESR servers
 
NAM="EAS ESR"
 
F  S NAM=$O(^ORD(101,"B",NAM)) Q:NAM'["EAS ESR"  D  Q:STOP
 
.Q:NAM'["SERVER"  Q:NAM["QRY-Z10"  Q:NAM["QRY-Z11"
 
.;Insert disable text
 
.RESULT=$$EDP(NAM,"ESR-to-Site Messaging Inactive")
 .
+RESULT<0 ABORT2(RESULT,"Event Driver:"_NAM)
 
;
 ;Remove ESR client subscriber protocols from shared servers
 
LCT=1:1 LINE=$T(PROTDAT+LCTQ:$P(LINE,";",3)="END"  D  Q:STOP
 
.NAM=PREFESR_$P(LINE,";",3)_" CLIENT"
 
.SIEN101=$O(^ORD(101,"B",NAM,0))
 .
+SIEN101=0 D  Q
 
..ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
 
..RETURN=-1_"^"_ERROR
 
..ABORT2(RETURN,"Event Driver:"_NAM)
 .
;If this is a SUBSCRIBER remove from SERVER
 
.I $O(^ORD(101,"AB",SIEN101,0)) REMOVE(SIEN101,NAM)
 
;
 ;
 
MODE=4,'STOP ARR="ESR messaging disabled"
 
Q
 
;
REMOVE(CLIENT,CNAM) ;Remove clients from server
 
DA,DIK,SERV,SNAM,SUB
 
SERV=0
 
F  S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV  D
 
.SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
 .
F  S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB  D
 
..DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," ^DIK
 
Q
 
;
PROTDAT ;
 ;;ORU-Z07
 ;;ORU-Z09
 ;;ORF-Z07
 ;;END
 ;
QRY(ARR,SYS) ;Switch system of record (moves QRY-Z10/Z11 Protocols)
 ;
 
PREFHEC,PREFESR,RESULT,SIEN,SITE,V,N,N1,LNCNT,LINE,PROTRET,NAM
 
; Get site's Station #
 
SITE=$P($$SITE^VASITE,"^",3)
 
PREFHEC="VAMC "_SITE_" "
 
PREFESR="EAS ESR "_SITE_" "
 
STOP=0,ARR="SOR unchanged"
 ;
 
ERROR,PREF,RETURN
 
;System being made SOR
 
PREF=$S(SYS="HEC":PREFHEC,1:PREFESR)
 
;Check messaging is settup for system being added
 
'$$Z07^EAS1071C(PREF,PREFHECD  Q
 
.ERROR="MESSAGING NOT ENABLED FOR "_SYS
 
.RETURN=-1_"^"_ERROR
 
.ABORT2(RETURN,SYS_" as system of record")
 .
STOP=0
 
;
 
SYS="ESR" D  Q
 
.;Disable HEC Z10/Z11 protocols
 
.UNLINK^EAS1071C(PREFHECQ:STOP
 
.;Enable ESR Z10/Z11 protocols
 
.LINK^EAS1071C Q:STOP
 
.;Return message
 
.ARR="ESR set as SOR"
 ;
 
SYS="HEC" D  Q
 
.;Disable ESR Z10/Z11 protocols
 
.UNLINK^EAS1071C(PREFESRQ:STOP
 
.;Enable HEC Z10/Z11 protocols
 
.LINK^EAS1071C Q:STOP
 
.;Return message
 
.ARR="HEC set as SOR"
 
Q