IVM2077P ;ALB/EJG - Patch Post-Install functions IVM*2*77;03/11/2003; 9/20/01 4:16pm
;;2.0;INCOME VERIFICATION;**77**;21-OCT-94
;
EN ;ENTRY POINT
;
N ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR
;
; Get site's Station #
S STATION=$P($$SITE^VASITE,"^",3)
;
S STOP=0
Q:$$SETLL16(STATION,.RLLN,.SLLN)
D PROTOCOL(STATION,RLLN,SLLN,.AN)
Q
;
SETLL16(STATION,RLLN,SLLN) ;
;INPUT STATION = Station #
; RLLN = Receiving Logical Link Name
; SLLN = Sending Logical Link Name
;
;OUTPUT 0 : Success, 1 : Error
;
;PURPOSE Create the Receiving and Sending Logical Link.
;
N ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
;
S PORT=33001 ;e*Gate Port#
;
; Sending Logical Link
S SLLN="LLEDBOUT"
;S ADDR="127.0.0.1" ;e*Gate development
S ADDR="127.0.0.1" ;e*Gate production
S RET=$$LL16(SLLN,ADDR,PORT)
I +RET<0 D ERROR(RET,"Edb Send Link:"_SLLN) Q 1
;
RLL ; Receiving Logical Link
S RLLN="LLEDBIN"
S ADDR=""
S PORT=5000 ;all stations production
S RET=$$LL16(RLLN,ADDR,PORT)
I +RET<0 D ERROR(RET,"Edb Receive Link:"_RLLN) Q 1
LL16EXIT Q STOP
;
;
PROTOCOL(STATION,RLLN,SLLN,AN) ;
;INPUT STATION = Station #
; RLLN = Receiving Logical Link Name
; SLLN = Sending Logical Link Name
; AN = Array containing the Application Names
;
;OUTPUT None
;
;PURPOSE Update the protocols (Subscriber and Event Driver) for the
; Edb/e*Gate TCP/IP interfaces
;
N RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM
S DISABTXT=""
F NAM="EAS EDB ORU-Z06 SERVER","EAS EDB ORU-Z09 SERVER" D
. S RESULT=$$EDP(NAM,DISABTXT)
. I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
Q
;
ERROR(ERRMSG,SUBJ) ;
;INPUT ERRMSG = Error Message text
; SUBJ = Subject of the Message
;
;OUTPUT none
;
;PURPOSE Display an error message to the user. Set the
; variable STOP=1 which will stop the routine
; from continuing to run after an error is found.
;
N TXT
S STOP=1
S TXT=$P(ERRMSG,"^",2)
W !,"===================================================="
W !,"= ERROR ="
W !,"===================================================="
W !,"When creating "_SUBJ
W !,"===================================================="
W !,"**ERROR MSG: ",TXT
Q
;
;Update Functions
;
LL16(LLNAME,TCPADDR,TCPPORT) ;
;INPUT LLNAME = Logical Link Name (ex. "LLEDBOUT")
; TCPADDR = TCP/IP Address
; TCPPORT = TCP/IP Port #
;
;OUTPUT IEN of entry (#870) Success
; -1^Error Message Error
;
;PURPOSE Update a Logical Link for TCP/IP transmissions.
;
N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
S FILE=870
; If already exists then skip
;
S IEN870=$O(^HLCS(870,"B",LLNAME,0)) ;IEN TO UPDATE
I 'IEN870 D Q RETURN ;IEN NOT FOUND - RETURN ERROR
. S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
. S RETURN=-1_"^"_ERROR
;
; set v1.6 field values
S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
S DATA(400.02)=TCPPORT ;TCP/IP PORT
;
S RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
;
Q RETURN
;
EDP(PNAME,DTXT) ;
;INPUT PNAME = Protocol Name
; DTXT = Disable Text
;
;OUTPUT IEN entry (#101) of Event Driver Protocol Success
; -1^Error Message Error
;
;PURPOSE Activate the Event Driver Protocol
;
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 ;IEN NOT FOUND - RETURN ERROR
. S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
. S RETURN=-1_"^"_ERROR
;
S DATA(2)=DTXT ;DISABLE TEXT
S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
;
EDPEXIT Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM2077P 4072 printed Dec 13, 2024@02:00:36 Page 2
IVM2077P ;ALB/EJG - Patch Post-Install functions IVM*2*77;03/11/2003; 9/20/01 4:16pm
+1 ;;2.0;INCOME VERIFICATION;**77**;21-OCT-94
+2 ;
EN ;ENTRY POINT
+1 ;
+2 NEW ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR
+3 ;
+4 ; Get site's Station #
+5 SET STATION=$PIECE($$SITE^VASITE,"^",3)
+6 ;
+7 SET STOP=0
+8 if $$SETLL16(STATION,.RLLN,.SLLN)
QUIT
+9 DO PROTOCOL(STATION,RLLN,SLLN,.AN)
+10 QUIT
+11 ;
SETLL16(STATION,RLLN,SLLN) ;
+1 ;INPUT STATION = Station #
+2 ; RLLN = Receiving Logical Link Name
+3 ; SLLN = Sending Logical Link Name
+4 ;
+5 ;OUTPUT 0 : Success, 1 : Error
+6 ;
+7 ;PURPOSE Create the Receiving and Sending Logical Link.
+8 ;
+9 NEW ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
+10 ;
+11 ;e*Gate Port#
SET PORT=33001
+12 ;
+13 ; Sending Logical Link
+14 SET SLLN="LLEDBOUT"
+15 ;S ADDR="127.0.0.1" ;e*Gate development
+16 ;e*Gate production
SET ADDR="127.0.0.1"
+17 SET RET=$$LL16(SLLN,ADDR,PORT)
+18 IF +RET<0
DO ERROR(RET,"Edb Send Link:"_SLLN)
QUIT 1
+19 ;
RLL ; Receiving Logical Link
+1 SET RLLN="LLEDBIN"
+2 SET ADDR=""
+3 ;all stations production
SET PORT=5000
+4 SET RET=$$LL16(RLLN,ADDR,PORT)
+5 IF +RET<0
DO ERROR(RET,"Edb Receive Link:"_RLLN)
QUIT 1
LL16EXIT QUIT STOP
+1 ;
+2 ;
PROTOCOL(STATION,RLLN,SLLN,AN) ;
+1 ;INPUT STATION = Station #
+2 ; RLLN = Receiving Logical Link Name
+3 ; SLLN = Sending Logical Link Name
+4 ; AN = Array containing the Application Names
+5 ;
+6 ;OUTPUT None
+7 ;
+8 ;PURPOSE Update the protocols (Subscriber and Event Driver) for the
+9 ; Edb/e*Gate TCP/IP interfaces
+10 ;
+11 NEW RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM
+12 SET DISABTXT=""
+13 FOR NAM="EAS EDB ORU-Z06 SERVER","EAS EDB ORU-Z09 SERVER"
Begin DoDot:1
+14 SET RESULT=$$EDP(NAM,DISABTXT)
+15 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:1
+16 QUIT
+17 ;
ERROR(ERRMSG,SUBJ) ;
+1 ;INPUT ERRMSG = Error Message text
+2 ; SUBJ = Subject of the Message
+3 ;
+4 ;OUTPUT none
+5 ;
+6 ;PURPOSE Display an error message to the user. Set the
+7 ; variable STOP=1 which will stop the routine
+8 ; from continuing to run after an error is found.
+9 ;
+10 NEW TXT
+11 SET STOP=1
+12 SET TXT=$PIECE(ERRMSG,"^",2)
+13 WRITE !,"===================================================="
+14 WRITE !,"= ERROR ="
+15 WRITE !,"===================================================="
+16 WRITE !,"When creating "_SUBJ
+17 WRITE !,"===================================================="
+18 WRITE !,"**ERROR MSG: ",TXT
+19 QUIT
+20 ;
+21 ;Update Functions
+22 ;
LL16(LLNAME,TCPADDR,TCPPORT) ;
+1 ;INPUT LLNAME = Logical Link Name (ex. "LLEDBOUT")
+2 ; TCPADDR = TCP/IP Address
+3 ; TCPPORT = TCP/IP Port #
+4 ;
+5 ;OUTPUT IEN of entry (#870) Success
+6 ; -1^Error Message Error
+7 ;
+8 ;PURPOSE Update a Logical Link for TCP/IP transmissions.
+9 ;
+10 NEW FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
+11 SET FILE=870
+12 ; If already exists then skip
+13 ;
+14 ;IEN TO UPDATE
SET IEN870=$ORDER(^HLCS(870,"B",LLNAME,0))
+15 ;IEN NOT FOUND - RETURN ERROR
IF 'IEN870
Begin DoDot:1
+16 SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
+17 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+18 ;
+19 ; set v1.6 field values
+20 ;TCP/IP ADDRESS
SET DATA(400.01)=TCPADDR
+21 ;TCP/IP PORT
SET DATA(400.02)=TCPPORT
+22 ;
+23 SET RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
+24 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+25 ;
+26 QUIT RETURN
+27 ;
EDP(PNAME,DTXT) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; DTXT = Disable Text
+3 ;
+4 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
+5 ; -1^Error Message Error
+6 ;
+7 ;PURPOSE Activate the Event Driver Protocol
+8 ;
+9 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA
+10 SET FILE=101
+11 ; If already exists then skip
+12 ;
+13 SET IEN101=$ORDER(^ORD(101,"B",PNAME,0))
+14 ;IEN NOT FOUND - RETURN ERROR
IF 'IEN101
Begin DoDot:1
+15 SET ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
+16 SET RETURN=-1_"^"_ERROR
End DoDot:1
QUIT RETURN
+17 ;
+18 ;DISABLE TEXT
SET DATA(2)=DTXT
+19 SET RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
+20 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
GOTO EDPEXIT
+21 ;
EDPEXIT QUIT RETURN
+1 ;
