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