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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1071A 8723 printed Dec 13, 2024@01:52:50 Page 2
EAS1071A ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:01pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
+2 ;
+3 ;PROTOCOL FILE access through DBIA 3173
+4 ;
TAG(RETURN,MODE) ; Called from EAS ESR MESSAGING RPC (triggered from HEC)
+1 NEW STOP
+2 SET STOP=0
+3 ;Enable ESR
+4 IF MODE=1
DO EN1(.RETURN)
if STOP
DO RESET(.RETURN)
QUIT
+5 ;Set ESR as system of record
+6 IF MODE=2
DO QRY(.RETURN,"ESR")
if STOP
DO QRY(.RETURN,"HEC")
QUIT
+7 ;Remove HEC
+8 IF MODE=3
DO EN^EAS1071B(.RETURN)
if STOP
DO RESET^EAS1071B(.RETURN)
QUIT
+9 ;Remove ESR
+10 IF MODE=4
DO RESET(.RETURN)
if STOP
DO EN1(.RETURN)
QUIT
+11 ;Set HEC as system of record
+12 IF MODE=5
DO QRY(.RETURN,"HEC")
if STOP
DO QRY(.RETURN,"ESR")
QUIT
+13 ;Enable HEC
+14 IF MODE=6
DO RESET^EAS1071B(.RETURN)
QUIT
+15 ;
+16 SET RETURN="-1^RPC Called with invalid MODE parameter"
+17 QUIT
+18 ;
EN1(ARR) ;Enable ESR messaging
+1 ;
+2 NEW ADDR,PORT,STATION,TCPDATA,SLLN,VER,DA,FILE,RET,ERROR
+3 ;
+4 if MODE=1
SET ARR="ESR messaging NOT enabled"
+5 ;
+6 ; Get site's Station #
+7 SET STATION=$PIECE($$SITE^VASITE,"^",3)
+8 ;
+9 ;Activate EAS ESR event driver server protocols
+10 DO PROTOCOL
if STOP
QUIT
+11 ;Update VAMC event driver protocols (outgoing)
+12 DO DRIVERS(STATION)
if STOP
QUIT
+13 ;Set production IP address and port on Logical Links
+14 DO SETLL16
if STOP
QUIT
+15 ;
+16 if MODE=1
SET ARR="ESR messaging enabled"
+17 ;
+18 QUIT
+19 ;
SETLL16 ;Update Sending Logical Link
+1 ;
+2 NEW ADDR,PORT,SHUTDOWN,SLLN,RET
+3 ;
+4 ;Production Install
+5 IF $$PROD^XUPROD
Begin DoDot:1
+6 ;Vitria production port#
SET PORT=8090
+7 ;ESR production (from dental package)
SET ADDR=$$IPLIVE
+8 ;Shutdown LLP set to No
SET SHUTDOWN=""
+9 ;Abort if no IP address found for production account
+10 IF ADDR=""
DO ABORT1
QUIT
End DoDot:1
if STOP
QUIT
+11 ;Test/development account values to null
+12 IF '$TEST
SET PORT=""
SET ADDR="00.0.000.00"
SET SHUTDOWN=1
+13 ;Update value in logical link file
+14 SET SLLN="LLESROUT"
SET RET=$$LL16(SLLN,ADDR,PORT,SHUTDOWN)
+15 IF +RET<0
DO ABORT2(RET,"ESR Send Link:"_SLLN)
+16 QUIT
+17 ;
+18 ;
PROTOCOL ;Remove Disable Text from EAS ESR server protocols
+1 ;
+2 NEW RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
+3 SET NAM="EAS ESR"
+4 FOR
SET NAM=$ORDER(^ORD(101,"B",NAM))
if NAM'["EAS ESR"
QUIT
Begin DoDot:1
+5 if NAM'["SERVER"
QUIT
if NAM["QRY-Z10"
QUIT
if NAM["QRY-Z11"
QUIT
+6 SET RESULT=$$EDP(NAM,"")
+7 IF +RESULT<0
DO ABORT2(RESULT,"Event Driver:"_NAM)
End DoDot:1
if STOP
QUIT
+8 ;
+9 QUIT
+10 ;
DRIVERS(STATION) ;Add EAS ESR client to VAMC event driver
+1 ;
+2 NEW ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
+3 SET LNCNT=1
+4 FOR
SET LINE=$TEXT(PROTDAT+LNCNT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+5 SET NAM="VAMC "_STATION_" "_$PIECE(LINE,";",3)_" SERVER"
+6 SET IEN101=$ORDER(^ORD(101,"B",NAM,0))
+7 IF +IEN101=0
Begin DoDot:2
+8 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+9 SET RETURN=-1_"^"_ERROR
+10 DO ABORT2(RETURN,"Event Driver:"_NAM)
End DoDot:2
QUIT
+11 ;
+12 ;Client Protocol
+13 SET SNAM="EAS ESR "_STATION_" "_$PIECE(LINE,";",3)_" CLIENT"
+14 SET SIEN101=$ORDER(^ORD(101,"B",SNAM,0))
+15 IF +SIEN101=0
Begin DoDot:2
+16 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+17 SET RETURN=-1_"^"_ERROR
+18 DO ABORT2(RETURN,"Subscriber:"_SNAM)
End DoDot:2
QUIT
+19 ;Skip if already present
+20 IF $DATA(^ORD(101,IEN101,775,"B",SIEN101))
Begin DoDot:2
+21 DO WARN(NAM,SNAM)
+22 SET LNCNT=LNCNT+1
End DoDot:2
QUIT
+23 ;Add subscriber to event driver
+24 SET RETURN=$$SUBSCR(IEN101,SIEN101)
+25 IF +RETURN<0
DO ABORT2(RETURN,"driver with Subscriber:"_SNAM)
QUIT
+26 SET LNCNT=LNCNT+1
End DoDot:1
if STOP
QUIT
+27 ;
+28 QUIT
+29 ;
WARN(EDP,SP) ;Display Warning Message
+1 ;
+2 NEW ARR
+3 ;
+4 SET ARR(1)="===================================================="
+5 SET ARR(2)="= WARNING ="
+6 SET ARR(3)="===================================================="
+7 SET ARR(4)="When updating "_EDP
+8 SET ARR(5)="===================================================="
+9 SET ARR(5)="**"_SP_" is already defined**"
+10 ;
+11 QUIT
+12 ;
ABORT1 ;Warning and mail message in case of no IP address
+1 ;
+2 SET STOP=1
+3 SET ARR(1)="===================================================="
+4 SET ARR(2)="= ABORTED ="
+5 SET ARR(3)="===================================================="
+6 SET ARR(4)="No IP address for VIE was found on the system"
+7 SET ARR(5)="The IP address must be entered on the LLESROUT"
+8 SET ARR(6)="logical link (file #870) before ESR transmissions"
+9 SET ARR(7)="can begin"
+10 QUIT
+11 ;
ABORT2(ERRMSG,SUBJ) ;Display Install Error message and set STOP
+1 ;
+2 SET STOP=1
+3 SET ARR(1)="===================================================="
+4 SET ARR(2)="= ABORTED ="
+5 SET ARR(3)="===================================================="
+6 SET ARR(4)="When updating "_SUBJ
+7 SET ARR(5)="===================================================="
+8 SET ARR(5)="**ERROR MSG: "_$PIECE(ERRMSG,"^",2)
+9 QUIT
+10 ;
LL16(LLNAME,TCPADDR,TCPPORT,SHUTDOWN) ;Update Logical Link Port and Address
+1 ;
+2 NEW FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
+3 SET FILE=870
+4 SET IEN870=$ORDER(^HLCS(870,"B",LLNAME,0))
+5 IF 'IEN870
Begin DoDot:1
+6 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+7 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+8 ;
+9 ;TCP/IP ADDRESS
SET DATA(400.01)=TCPADDR
+10 ;TCP/IP PORT
SET DATA(400.02)=TCPPORT
+11 ;AUTOSTART
SET DATA(4.5)=1
+12 ;SHUTDOWN LLP
SET DATA(14)=SHUTDOWN
+13 ;
+14 SET RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
+15 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+16 ;
+17 QUIT RETURN
+18 ;
EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
+1 ;
+2 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA
+3 SET FILE=101
+4 ; If already exists then skip
+5 SET IEN101=$ORDER(^ORD(101,"B",PNAME,0))
+6 IF 'IEN101
Begin DoDot:1
+7 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+8 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+9 ;
+10 SET DATA(2)=DTXT
+11 SET RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
+12 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+13 ;
+14 QUIT RETURN
+15 ;
SUBSCR(IEN101,SIEN101) ;Add client to event driver as a subscriber
+1 ;
+2 NEW DATA,DGENDA,ERROR,FILE,RETURN
+3 SET DGENDA(1)=IEN101
+4 SET FILE=101.0775
+5 SET DATA(.01)=SIEN101
+6 SET RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+7 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+8 ;
+9 QUIT RETURN
+10 ;
IPLIVE() ;Get IP address for production system
+1 ;
+2 ;Search for DENTVHLAAC logical link
+3 SET IENS=$$FIND1^DIC(870,"","X","DENTVHLAAC","","","ERR")
+4 ;If not found return null IP address
+5 IF 'IENS
QUIT ""
+6 ;Otherwise return TCP/IP ADDRESS
+7 QUIT $$GET1^DIQ(870,IENS_",",400.01)
+8 ;
RESET(ARR) ;Disable or Remove ESR protocols
+1 NEW DA,DIK,ERROR,IEN101,LINE,LCT,NAM
+2 NEW PREFHEC,PREFESR,SIEN101,SNAM,STOP,SITE
+3 ;
+4 IF MODE=4
SET ARR="ESR messaging NOT disabled"
+5 ;
+6 ; Get site's Station #
+7 SET SITE=$PIECE($$SITE^VASITE,"^",3)
+8 SET PREFHEC="VAMC "_SITE_" "
+9 SET PREFESR="EAS ESR "_SITE_" "
+10 SET STOP=0
+11 ;
+12 IF $$SOR^EAS1071C(PREFESR,PREFHEC)
Begin DoDot:1
+13 SET ARR="Unable to disable messaging, ESR is SOR"
End DoDot:1
QUIT
+14 ;
+15 ;Disable to Vista to ESR servers
+16 SET NAM="EAS ESR"
+17 FOR
SET NAM=$ORDER(^ORD(101,"B",NAM))
if NAM'["EAS ESR"
QUIT
Begin DoDot:1
+18 if NAM'["SERVER"
QUIT
if NAM["QRY-Z10"
QUIT
if NAM["QRY-Z11"
QUIT
+19 ;Insert disable text
+20 SET RESULT=$$EDP(NAM,"ESR-to-Site Messaging Inactive")
+21 IF +RESULT<0
DO ABORT2(RESULT,"Event Driver:"_NAM)
End DoDot:1
if STOP
QUIT
+22 ;
+23 ;Remove ESR client subscriber protocols from shared servers
+24 FOR LCT=1:1
SET LINE=$TEXT(PROTDAT+LCT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+25 SET NAM=PREFESR_$PIECE(LINE,";",3)_" CLIENT"
+26 SET SIEN101=$ORDER(^ORD(101,"B",NAM,0))
+27 IF +SIEN101=0
Begin DoDot:2
+28 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+29 SET RETURN=-1_"^"_ERROR
+30 DO ABORT2(RETURN,"Event Driver:"_NAM)
End DoDot:2
QUIT
+31 ;If this is a SUBSCRIBER remove from SERVER
+32 IF $ORDER(^ORD(101,"AB",SIEN101,0))
DO REMOVE(SIEN101,NAM)
End DoDot:1
if STOP
QUIT
+33 ;
+34 ;
+35 IF MODE=4
IF 'STOP
SET ARR="ESR messaging disabled"
+36 QUIT
+37 ;
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
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
PROTDAT ;
+1 ;;ORU-Z07
+2 ;;ORU-Z09
+3 ;;ORF-Z07
+4 ;;END
+5 ;
QRY(ARR,SYS) ;Switch system of record (moves QRY-Z10/Z11 Protocols)
+1 ;
+2 NEW PREFHEC,PREFESR,RESULT,SIEN,SITE,V,N,N1,LNCNT,LINE,PROTRET,NAM
+3 ; Get site's Station #
+4 SET SITE=$PIECE($$SITE^VASITE,"^",3)
+5 SET PREFHEC="VAMC "_SITE_" "
+6 SET PREFESR="EAS ESR "_SITE_" "
+7 SET STOP=0
SET ARR="SOR unchanged"
+8 ;
+9 NEW ERROR,PREF,RETURN
+10 ;System being made SOR
+11 SET PREF=$SELECT(SYS="HEC":PREFHEC,1:PREFESR)
+12 ;Check messaging is settup for system being added
+13 IF '$$Z07^EAS1071C(PREF,PREFHEC)
Begin DoDot:1
+14 SET ERROR="MESSAGING NOT ENABLED FOR "_SYS
+15 SET RETURN=-1_"^"_ERROR
+16 DO ABORT2(RETURN,SYS_" as system of record")
+17 SET STOP=0
End DoDot:1
QUIT
+18 ;
+19 IF SYS="ESR"
Begin DoDot:1
+20 ;Disable HEC Z10/Z11 protocols
+21 DO UNLINK^EAS1071C(PREFHEC)
if STOP
QUIT
+22 ;Enable ESR Z10/Z11 protocols
+23 DO LINK^EAS1071C
if STOP
QUIT
+24 ;Return message
+25 SET ARR="ESR set as SOR"
End DoDot:1
QUIT
+26 ;
+27 IF SYS="HEC"
Begin DoDot:1
+28 ;Disable ESR Z10/Z11 protocols
+29 DO UNLINK^EAS1071C(PREFESR)
if STOP
QUIT
+30 ;Enable HEC Z10/Z11 protocols
+31 DO LINK^EAS1071C
if STOP
QUIT
+32 ;Return message
+33 SET ARR="HEC set as SOR"
End DoDot:1
QUIT
+34 QUIT
