EAS1071B ;ALB/PJH - EAS*1*71; ; 22 Jan 2014 12:46 PM
;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,96**;15-MAR-01;Build 18
Q
;
EN(ARR) ;ENTRY POINT
;
N DA,DIK,LINE,LCT,NAM,PREFIX,RESULT
;
S ARR="HEC messaging NOT disabled"
;
; Get site's Station #
S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" "
;
I $$SOR^EAS1071C(PREFIX,PREFIX) D Q
.S ARR="Unable to disable messaging, HEC is SOR"
;
;Remove HEC client subscriber protocols from shared servers. Only quit processing if not EAS1096P
F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D I '$G(EAS1096P) Q:STOP
.S NAM=PREFIX_$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 ERROR(RETURN,"Event Driver:"_NAM)
.;If this is a SUBSCRIBER remove from SERVER
.I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE(SIEN101,NAM)
;
;Add disable text to HEC to ESR servers
F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D
.S NAM=PREFIX_$P(LINE,";",3)
.;Insert disable text
.S RESULT=$$EDP(NAM,"Disable VistA to HEC Messaging")
.I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
;
S:'STOP ARR="HEC messaging disabled"
Q
;
EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
;
N DATA,FILE,DGENDA,RETURN,ERROR,DA
S FILE=101
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
;
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 ;VistA to HEC clients on shared Event Drivers
;;ORU-Z07
;;ORU-Z09
;;ORF-Z07
;;END
;;NOTE THAT THESE ARE HANDLED BY QRY^EAS1071A
;;QRY-Z10
;;QRY-Z11
;;END
;
PROTDAT1 ;HEC to Vista Event Drivers to disable
;;ORU-Z04 SERVER H
;;ORU-Z04 SERVER V
;;ORU-Z05 SERVER
;;ORU-Z10 SERVER
;;ORU-Z11 SERVER
;;ORF-Z10 SERVER
;;ORF-Z11 SERVER
;;QRY-Z07 SERVER
;;MFN-ZEG SERVER
;;END
;
RESET(ARR) ;Enable or Attach HEC protocols
; Do not perform Reset for EAS1096P Project
I $G(EAS1096P) Q
;
N DA,DIK,ERROR,IEN101,LINE,LCT,NAM,PREFIX,SIEN101,SNAM,STOP
;
S ARR="HEC messaging NOT re enabled"
;
; Get site's Station #
S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" ",STOP=0
;
;Enable to VistA to HEC Legacy servers
F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D
.S NAM=PREFIX_$P(LINE,";",3)
.;Remove disable text
.S RESULT=$$EDP(NAM,"")
.I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
;
;
;Add HEC client protocols to shared servers
F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D
.S FILE=101
.;Server protocol
.S NAM=PREFIX_$P(LINE,";",3)_" SERVER"
.I NAM["Z04" S NAM=NAM_" V"
.S IEN101=$O(^ORD(101,"B",NAM,0))
.; Fix Error reporting
.I 'IEN101 D Q ;RETURN
..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
..S RETURN=-1_"^"_ERROR
..D ERROR(RETURN,"Server:"_NAM)
.;
.;Client protocol (subscriber)
.S SNAM=PREFIX_$P(LINE,";",3)_" CLIENT"
.I SNAM["Z04" S SNAM=SNAM_" V"
.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 ERROR(RETURN,"Subscriber:"_SNAM)
.;Skip if already present
.I $D(^ORD(101,IEN101,775,"B",SIEN101)) D Q
..D WARN(NAM,SNAM)
.;Add subscriber to event driver
.S RETURN=$$SUBSCR(IEN101,SIEN101)
.I +RETURN<0 D ERROR(RETURN,"driver with Subscriber:"_SNAM) Q
;
S:'STOP ARR="HEC messaging re enabled"
Q
;
;
ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
N ARR
;
S STOP=1
;
S ARR(1)="===================================================="
S ARR(2)="= ERROR ="
S ARR(3)="===================================================="
S ARR(4)="When updating "_SUBJ
S ARR(5)="===================================================="
S ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
;
;Display result of RPC and any warnings or errors for EAS1096P only
I $G(EAS1096P) D BMES^XPDUTL(.ARR)
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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1071B 5117 printed Nov 22, 2024@17:03:01 Page 2
EAS1071B ;ALB/PJH - EAS*1*71; ; 22 Jan 2014 12:46 PM
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,96**;15-MAR-01;Build 18
+2 QUIT
+3 ;
EN(ARR) ;ENTRY POINT
+1 ;
+2 NEW DA,DIK,LINE,LCT,NAM,PREFIX,RESULT
+3 ;
+4 SET ARR="HEC messaging NOT disabled"
+5 ;
+6 ; Get site's Station #
+7 SET PREFIX="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" "
+8 ;
+9 IF $$SOR^EAS1071C(PREFIX,PREFIX)
Begin DoDot:1
+10 SET ARR="Unable to disable messaging, HEC is SOR"
End DoDot:1
QUIT
+11 ;
+12 ;Remove HEC client subscriber protocols from shared servers. Only quit processing if not EAS1096P
+13 FOR LCT=1:1
SET LINE=$TEXT(PROTDAT+LCT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+14 SET NAM=PREFIX_$PIECE(LINE,";",3)_" CLIENT"
+15 SET SIEN101=$ORDER(^ORD(101,"B",NAM,0))
+16 IF +SIEN101=0
Begin DoDot:2
+17 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+18 SET RETURN=-1_"^"_ERROR
+19 DO ERROR(RETURN,"Event Driver:"_NAM)
End DoDot:2
QUIT
+20 ;If this is a SUBSCRIBER remove from SERVER
+21 IF $ORDER(^ORD(101,"AB",SIEN101,0))
DO REMOVE(SIEN101,NAM)
End DoDot:1
IF '$GET(EAS1096P)
if STOP
QUIT
+22 ;
+23 ;Add disable text to HEC to ESR servers
+24 FOR LCT=1:1
SET LINE=$TEXT(PROTDAT1+LCT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+25 SET NAM=PREFIX_$PIECE(LINE,";",3)
+26 ;Insert disable text
+27 SET RESULT=$$EDP(NAM,"Disable VistA to HEC Messaging")
+28 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:1
+29 ;
+30 if 'STOP
SET ARR="HEC messaging disabled"
+31 QUIT
+32 ;
EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
+1 ;
+2 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA
+3 SET FILE=101
+4 SET IEN101=$ORDER(^ORD(101,"B",PNAME,0))
+5 IF 'IEN101
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 SET DATA(2)=DTXT
+10 SET RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
+11 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+12 ;
+13 QUIT RETURN
+14 ;
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 ;VistA to HEC clients on shared Event Drivers
+1 ;;ORU-Z07
+2 ;;ORU-Z09
+3 ;;ORF-Z07
+4 ;;END
+5 ;;NOTE THAT THESE ARE HANDLED BY QRY^EAS1071A
+6 ;;QRY-Z10
+7 ;;QRY-Z11
+8 ;;END
+9 ;
PROTDAT1 ;HEC to Vista Event Drivers to disable
+1 ;;ORU-Z04 SERVER H
+2 ;;ORU-Z04 SERVER V
+3 ;;ORU-Z05 SERVER
+4 ;;ORU-Z10 SERVER
+5 ;;ORU-Z11 SERVER
+6 ;;ORF-Z10 SERVER
+7 ;;ORF-Z11 SERVER
+8 ;;QRY-Z07 SERVER
+9 ;;MFN-ZEG SERVER
+10 ;;END
+11 ;
RESET(ARR) ;Enable or Attach HEC protocols
+1 ; Do not perform Reset for EAS1096P Project
+2 IF $GET(EAS1096P)
QUIT
+3 ;
+4 NEW DA,DIK,ERROR,IEN101,LINE,LCT,NAM,PREFIX,SIEN101,SNAM,STOP
+5 ;
+6 SET ARR="HEC messaging NOT re enabled"
+7 ;
+8 ; Get site's Station #
+9 SET PREFIX="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" "
SET STOP=0
+10 ;
+11 ;Enable to VistA to HEC Legacy servers
+12 FOR LCT=1:1
SET LINE=$TEXT(PROTDAT1+LCT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+13 SET NAM=PREFIX_$PIECE(LINE,";",3)
+14 ;Remove disable text
+15 SET RESULT=$$EDP(NAM,"")
+16 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:1
+17 ;
+18 ;
+19 ;Add HEC client protocols to shared servers
+20 FOR LCT=1:1
SET LINE=$TEXT(PROTDAT+LCT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+21 SET FILE=101
+22 ;Server protocol
+23 SET NAM=PREFIX_$PIECE(LINE,";",3)_" SERVER"
+24 IF NAM["Z04"
SET NAM=NAM_" V"
+25 SET IEN101=$ORDER(^ORD(101,"B",NAM,0))
+26 ; Fix Error reporting
+27 ;RETURN
IF 'IEN101
Begin DoDot:2
+28 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+29 SET RETURN=-1_"^"_ERROR
+30 DO ERROR(RETURN,"Server:"_NAM)
End DoDot:2
QUIT
+31 ;
+32 ;Client protocol (subscriber)
+33 SET SNAM=PREFIX_$PIECE(LINE,";",3)_" CLIENT"
+34 IF SNAM["Z04"
SET SNAM=SNAM_" V"
+35 SET SIEN101=$ORDER(^ORD(101,"B",SNAM,0))
+36 IF +SIEN101=0
Begin DoDot:2
+37 SET ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
+38 SET RETURN=-1_"^"_ERROR
+39 DO ERROR(RETURN,"Subscriber:"_SNAM)
End DoDot:2
QUIT
+40 ;Skip if already present
+41 IF $DATA(^ORD(101,IEN101,775,"B",SIEN101))
Begin DoDot:2
+42 DO WARN(NAM,SNAM)
End DoDot:2
QUIT
+43 ;Add subscriber to event driver
+44 SET RETURN=$$SUBSCR(IEN101,SIEN101)
+45 IF +RETURN<0
DO ERROR(RETURN,"driver with Subscriber:"_SNAM)
QUIT
End DoDot:1
+46 ;
+47 if 'STOP
SET ARR="HEC messaging re enabled"
+48 QUIT
+49 ;
+50 ;
ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
+1 NEW ARR
+2 ;
+3 SET STOP=1
+4 ;
+5 SET ARR(1)="===================================================="
+6 SET ARR(2)="= ERROR ="
+7 SET ARR(3)="===================================================="
+8 SET ARR(4)="When updating "_SUBJ
+9 SET ARR(5)="===================================================="
+10 SET ARR(5)="**ERROR MSG: "_$PIECE(ERRMSG,"^",2)
+11 ;
+12 ;Display result of RPC and any warnings or errors for EAS1096P only
+13 IF $GET(EAS1096P)
DO BMES^XPDUTL(.ARR)
+14 QUIT
+15 ;
WARN(EDP,SP) ;Display Warning Message
+1 NEW ARR
+2 ;
+3 SET ARR(1)="===================================================="
+4 SET ARR(2)="= WARNING ="
+5 SET ARR(3)="===================================================="
+6 SET ARR(4)="When updating "_EDP
+7 SET ARR(5)="===================================================="
+8 SET ARR(5)="**"_SP_" is already defined**"
+9 ;
+10 QUIT
+11 ;
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
