EAS1096P ;ALB/PJH - Utility to disable HEC legacy protocols; ; 7/2/09 4:36pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**96**; 15-MAR-01;Build 18
Q
;
;This routine is the post install for patch EAS*1*96
;
;The routine calls the EAS1071A routine to remove HEC Legacy
;subscriber protocols used for dual messaging of outbound Z07
;and also to insert disable text into all HEC Legacy server
;protocols
;
;
EN ;Entry Point
N PNAME,RESULT,RTN,STATION,STOP,EAS1096P
;
D BMES^XPDUTL("Post Install Running")
;
;Reset QRY protocols
S STATION=$P($$SITE^VASITE,"^",3),STOP=0,RTN="D ORF^EASCM"
;
;Update Z10 server
S PNAME="VAMC "_STATION_" QRY-Z10 SERVER"
S RESULT=$$EDP(PNAME,RTN)
D:+RESULT<0 ERROR(RESULT,PNAME)
;
;Update Z11 server
S PNAME="VAMC "_STATION_" QRY-Z11 SERVER"
S RESULT=$$EDP(PNAME,RTN)
D:+RESULT<0 ERROR(RESULT,PNAME)
;
;Abort if unable to update QRY protocols correctly - Removed to allow for sites that may not have all interfaces
;I STOP D BMES^XPDUTL("Post Install Unable to Complete") Q
;
; To prevent Reset and Quitting from Loop if any protocols missing
S EAS1096P=1
;
;Disable HECL protocols
D TAG^EAS1071A(.RESULT,3)
;Display result of RPC and any warnings or errors - Removed as errors are printed in EAS1071B
;D BMES^XPDUTL(.RESULT)
;Completed OK
D BMES^XPDUTL("Post Install Completed")
;
Q
;
EDP(PNAME,RTN) ;Update response routine on QRY Z10/Z11 server Protocols
;
N DA,DATA,DGENDA,ERROR,FILE,IEN101,RETURN
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,RETURN(1)=PNAME
;
S DATA(772)=RTN
S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR,RETURN(1)=PNAME
;
Q RETURN
;
ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
N ARR
;
S STOP=1
S ARR(1)="===================================================="
S ARR(2)="= WARNING ="
S ARR(3)="===================================================="
S ARR(4)="When updating "_SUBJ
S ARR(5)="===================================================="
S ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
;
D BMES^XPDUTL(.ARR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1096P 2327 printed Apr 09, 2024@20:59:30 Page 2
EAS1096P ;ALB/PJH - Utility to disable HEC legacy protocols; ; 7/2/09 4:36pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**96**; 15-MAR-01;Build 18
+2 QUIT
+3 ;
+4 ;This routine is the post install for patch EAS*1*96
+5 ;
+6 ;The routine calls the EAS1071A routine to remove HEC Legacy
+7 ;subscriber protocols used for dual messaging of outbound Z07
+8 ;and also to insert disable text into all HEC Legacy server
+9 ;protocols
+10 ;
+11 ;
EN ;Entry Point
+1 NEW PNAME,RESULT,RTN,STATION,STOP,EAS1096P
+2 ;
+3 DO BMES^XPDUTL("Post Install Running")
+4 ;
+5 ;Reset QRY protocols
+6 SET STATION=$PIECE($$SITE^VASITE,"^",3)
SET STOP=0
SET RTN="D ORF^EASCM"
+7 ;
+8 ;Update Z10 server
+9 SET PNAME="VAMC "_STATION_" QRY-Z10 SERVER"
+10 SET RESULT=$$EDP(PNAME,RTN)
+11 if +RESULT<0
DO ERROR(RESULT,PNAME)
+12 ;
+13 ;Update Z11 server
+14 SET PNAME="VAMC "_STATION_" QRY-Z11 SERVER"
+15 SET RESULT=$$EDP(PNAME,RTN)
+16 if +RESULT<0
DO ERROR(RESULT,PNAME)
+17 ;
+18 ;Abort if unable to update QRY protocols correctly - Removed to allow for sites that may not have all interfaces
+19 ;I STOP D BMES^XPDUTL("Post Install Unable to Complete") Q
+20 ;
+21 ; To prevent Reset and Quitting from Loop if any protocols missing
+22 SET EAS1096P=1
+23 ;
+24 ;Disable HECL protocols
+25 DO TAG^EAS1071A(.RESULT,3)
+26 ;Display result of RPC and any warnings or errors - Removed as errors are printed in EAS1071B
+27 ;D BMES^XPDUTL(.RESULT)
+28 ;Completed OK
+29 DO BMES^XPDUTL("Post Install Completed")
+30 ;
+31 QUIT
+32 ;
EDP(PNAME,RTN) ;Update response routine on QRY Z10/Z11 server Protocols
+1 ;
+2 NEW DA,DATA,DGENDA,ERROR,FILE,IEN101,RETURN
+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
SET RETURN(1)=PNAME
End DoDot:1
QUIT RETURN
+9 ;
+10 SET DATA(772)=RTN
+11 SET RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
+12 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
SET RETURN(1)=PNAME
+13 ;
+14 QUIT RETURN
+15 ;
ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
+1 NEW ARR
+2 ;
+3 SET STOP=1
+4 SET ARR(1)="===================================================="
+5 SET ARR(2)="= WARNING ="
+6 SET ARR(3)="===================================================="
+7 SET ARR(4)="When updating "_SUBJ
+8 SET ARR(5)="===================================================="
+9 SET ARR(5)="**ERROR MSG: "_$PIECE(ERRMSG,"^",2)
+10 ;
+11 DO BMES^XPDUTL(.ARR)
+12 QUIT
