EAS1111P ;ALB/PJH,BDB - Post-Install ;03/07/2013 5:00pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**111**;07-MAR-13;Build 59
;
;Install EAS ESR protocols for Z06
; protocols are installed enabled and use LLESROUT
;
;Follow up patch will add disable text to
; EAS EDB servers and clients
;
EN ;Post Install entry point
N AN,SLLN,STATION
; Get site's Station #
S STATION=$P($$SITE^VASITE,"^",3),SLLN="LLESROUT"
S AN("S")="ESR",AN("R")="VAMC "_STATION
D PROTOCOL(STATION,SLLN,.AN)
Q
;
PROTOCOL(STATION,SLLN,AN) ;
;INPUT STATION = Station #
; SLLN = Sending Logical Link Name
; AN = Array containing the Application Names
;
;OUTPUT None
;
;PURPOSE Using the table in line label PROTDAT create the
; protocols (Subscriber and Event Driver) for the
; ESR TCP/IP interfaces
;
N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM,STOP
;
;ON COMPLETION INCLUDE STATION IN PROTOCOL NAME
S N1="EAS ESR "_STATION_" ",V="2.3.1"
;
S LNCNT=1,STOP=0
F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
. N D,DTXT,RESULT
. S DTXT=""
. F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
. S NAM=D(3)_D(4)_D(5)
. D:NAM["CLIENT"
. . S SIEN=$$SP(NAM,D(6),D(7),D(8),D(9),D(10),D(11))
. . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
. D:NAM["SERVER"
. . N TMPNAM,ITEMTXT
. . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
. . S ITEMTXT=$$GETIT(TMPNAM)
. . S RESULT=$$EDP(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
. . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
. S LNCNT=LNCNT+1
;
D BMES^XPDUTL("ESR Z06 Protocols installed with enabled status")
Q
;
ERROR(ERRMSG,SUBJ) ;Display error message and set STOP=1
;
N ARR
S STOP=1
S ARR(1)="===================================================="
S ARR(2)="= ERROR ="
S ARR(3)="===================================================="
S ARR(4)="When creating "_SUBJ
S ARR(5)="===================================================="
S ARR(6)="**ERROR MSG: "_$P(ERRMSG,"^",2)
;
D BMES^XPDUTL(.ARR)
;
Q
;
V(VALUE) ;FUNCTION: If variable then pass back value of it.
;
I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
Q VALUE
;
GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
; Transmission Description.
Q:N="ORUZ06" "MEANS TEST CONVERTED/REVERSED/Unsolicited ESR to VAMC"
Q ""
;
PROTDAT ;;VAMC SIDE PROTOCOLS
;;@N1;;ORU-Z06 CLIENT;@SLLN;@AN("R");ACK;;D ORU^EASPREC3;@DTXT;LEND
;;@N1;;ORU-Z06 SERVER;ORU;Z06;@V;@AN("S");;@SIEN;@DTXT;LEND
;;END
;
SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN,DTXT) ;
;INPUT PNAME = Protocol Name
; LL = Logical Link Name (ex. "LL VAMC 500")
; RECVAPP = Receiving Application Name (ex. "VAMC 500")
; RMSGTYP = Response Message Type (ex. "ACK")
; REVTTYP = Response Event Type. Usually empty, used more
; in response to a Query with an ORF message.
; MSGPRTN = Message Processing Routine - Routine to parse
; regular transmission of data - MUMPS format
; (ex. "D ^IVMBORU")
; DTXT = Disable Text
;
;OUTPUT IEN entry (#101) for Subscriber Protocol Success
; -1^Error Message
;
;PURPOSE Create a Subscriber Protocol
;
N DATA,FILE,RETURN,ERROR,DA,DGENDA
S FILE=101
; If already exists then skip
;
S RETURN=+$O(^ORD(101,"B",PNAME,0)) I +$G(RETURN)>0 Q RETURN
;
S DATA(.01)=PNAME ;PROTOCOL NAME
S DATA(2)="" ;DISABLE TEXT
S DATA(4)="S" ;PROTOCOL TYPE
S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
S DATA(773.1)=1 ;SEND FACILITY REQUIRED
S DATA(773.2)=1 ;RECV FACILITY REQUIRED
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
Q RETURN
;
EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
;INPUT PNAME = Protocol Name
; MTYP = Message Type Name (ex. "ORU")
; ETYP = Event Type Name (ex. "Z06")
; VER = HL7 Version # (ex. 2.3.1)
; SENDAPP = Sending Application Name (ex. "VAMC 290")
; ACKPRTN = Acknowledgement Processing Routine -
; Routine to parse an ACK transmission -
; MUMPs format (ex. "D ^IVMBACK")
; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
; DTXT = Disable Text
; ITEMTXT = Item Text
;
;OUTPUT IEN entry (#101) of Event Driver Protocol Success
; -1^Error Message Error
;
;PURPOSE Create an Event Driver Protocol and the Sub-File to
; contain pointers to the Subscriber Protocol file
;
N DATA,FILE,DGENDA,RETURN,ERROR,DA
S FILE=101
; If already exists then skip
;
S RETURN=+$O(^ORD(101,"B",PNAME,0)) I +$G(RETURN)>0 Q RETURN
;
S DATA(.01)=PNAME ;PROTOCOL NAME
S DATA(1)=ITEMTXT ;ITEM TEXT
S DATA(2)="" ;DISABLE TEXT
S DATA(4)="E" ;PROTOCOL TYPE
S DATA(5)=+$G(DUZ) ;CREATOR
S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
S DGENDA(1)=RETURN
;
; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
S FILE=101.0775
K DATA
S DATA(.01)=SUBIEN
S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
;
EDPEXIT Q RETURN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1111P 5721 printed Dec 13, 2024@01:53:04 Page 2
EAS1111P ;ALB/PJH,BDB - Post-Install ;03/07/2013 5:00pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**111**;07-MAR-13;Build 59
+2 ;
+3 ;Install EAS ESR protocols for Z06
+4 ; protocols are installed enabled and use LLESROUT
+5 ;
+6 ;Follow up patch will add disable text to
+7 ; EAS EDB servers and clients
+8 ;
EN ;Post Install entry point
+1 NEW AN,SLLN,STATION
+2 ; Get site's Station #
+3 SET STATION=$PIECE($$SITE^VASITE,"^",3)
SET SLLN="LLESROUT"
+4 SET AN("S")="ESR"
SET AN("R")="VAMC "_STATION
+5 DO PROTOCOL(STATION,SLLN,.AN)
+6 QUIT
+7 ;
PROTOCOL(STATION,SLLN,AN) ;
+1 ;INPUT STATION = Station #
+2 ; SLLN = Sending Logical Link Name
+3 ; AN = Array containing the Application Names
+4 ;
+5 ;OUTPUT None
+6 ;
+7 ;PURPOSE Using the table in line label PROTDAT create the
+8 ; protocols (Subscriber and Event Driver) for the
+9 ; ESR TCP/IP interfaces
+10 ;
+11 NEW RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM,STOP
+12 ;
+13 ;ON COMPLETION INCLUDE STATION IN PROTOCOL NAME
+14 SET N1="EAS ESR "_STATION_" "
SET V="2.3.1"
+15 ;
+16 SET LNCNT=1
SET STOP=0
+17 FOR
SET LINE=$TEXT(PROTDAT+LNCNT)
if $PIECE(LINE,";",3)="END"
QUIT
Begin DoDot:1
+18 NEW D,DTXT,RESULT
+19 SET DTXT=""
+20 FOR N=3:1
if $PIECE(LINE,";",N)="LEND"
QUIT
SET D(N)=$$V($PIECE(LINE,";",N))
+21 SET NAM=D(3)_D(4)_D(5)
+22 if NAM["CLIENT"
Begin DoDot:2
+23 SET SIEN=$$SP(NAM,D(6),D(7),D(8),D(9),D(10),D(11))
+24 IF +SIEN<0
DO ERROR(SIEN,"Subscriber:"_NAM)
End DoDot:2
+25 if NAM["SERVER"
Begin DoDot:2
+26 NEW TMPNAM,ITEMTXT
+27 SET TMPNAM=D(6)_D(7)_$PIECE(NAM,"SERVER ",2)
+28 SET ITEMTXT=$$GETIT(TMPNAM)
+29 SET RESULT=$$EDP(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
+30 IF +RESULT<0
DO ERROR(RESULT,"Event Driver:"_NAM)
End DoDot:2
+31 SET LNCNT=LNCNT+1
End DoDot:1
if STOP
QUIT
+32 ;
+33 DO BMES^XPDUTL("ESR Z06 Protocols installed with enabled status")
+34 QUIT
+35 ;
ERROR(ERRMSG,SUBJ) ;Display error message and set STOP=1
+1 ;
+2 NEW ARR
+3 SET STOP=1
+4 SET ARR(1)="===================================================="
+5 SET ARR(2)="= ERROR ="
+6 SET ARR(3)="===================================================="
+7 SET ARR(4)="When creating "_SUBJ
+8 SET ARR(5)="===================================================="
+9 SET ARR(6)="**ERROR MSG: "_$PIECE(ERRMSG,"^",2)
+10 ;
+11 DO BMES^XPDUTL(.ARR)
+12 ;
+13 QUIT
+14 ;
V(VALUE) ;FUNCTION: If variable then pass back value of it.
+1 ;
+2 IF $EXTRACT(VALUE)="@"
QUIT @($EXTRACT(VALUE,2,$LENGTH(VALUE)))
+3 QUIT VALUE
+4 ;
GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
+1 ; Transmission Description.
+2 if N="ORUZ06"
QUIT "MEANS TEST CONVERTED/REVERSED/Unsolicited ESR to VAMC"
+3 QUIT ""
+4 ;
PROTDAT ;;VAMC SIDE PROTOCOLS
+1 ;;@N1;;ORU-Z06 CLIENT;@SLLN;@AN("R");ACK;;D ORU^EASPREC3;@DTXT;LEND
+2 ;;@N1;;ORU-Z06 SERVER;ORU;Z06;@V;@AN("S");;@SIEN;@DTXT;LEND
+3 ;;END
+4 ;
SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN,DTXT) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; LL = Logical Link Name (ex. "LL VAMC 500")
+3 ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
+4 ; RMSGTYP = Response Message Type (ex. "ACK")
+5 ; REVTTYP = Response Event Type. Usually empty, used more
+6 ; in response to a Query with an ORF message.
+7 ; MSGPRTN = Message Processing Routine - Routine to parse
+8 ; regular transmission of data - MUMPS format
+9 ; (ex. "D ^IVMBORU")
+10 ; DTXT = Disable Text
+11 ;
+12 ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
+13 ; -1^Error Message
+14 ;
+15 ;PURPOSE Create a Subscriber Protocol
+16 ;
+17 NEW DATA,FILE,RETURN,ERROR,DA,DGENDA
+18 SET FILE=101
+19 ; If already exists then skip
+20 ;
+21 SET RETURN=+$ORDER(^ORD(101,"B",PNAME,0))
IF +$GET(RETURN)>0
QUIT RETURN
+22 ;
+23 ;PROTOCOL NAME
SET DATA(.01)=PNAME
+24 ;DISABLE TEXT
SET DATA(2)=""
+25 ;PROTOCOL TYPE
SET DATA(4)="S"
+26 ;RESPONSE MSG TYPE
SET DATA(770.11)=$ORDER(^HL(771.2,"B",RMSGTYP,0))
+27 ;RECEIVING APP
SET DATA(770.2)=$ORDER(^HL(771,"B",RECVAPP,0))
+28 ;EVENT TYPE
if REVTTYP]""
SET DATA(770.4)=$ORDER(^HL(779.001,"B",REVTTYP,0))
+29 ;LOGICAL LINK
SET DATA(770.7)=$ORDER(^HLCS(870,"B",LL,0))
+30 ;MSG PROCESSING RTN
SET DATA(771)=MSGPRTN
+31 ;SEND FACILITY REQUIRED
SET DATA(773.1)=1
+32 ;RECV FACILITY REQUIRED
SET DATA(773.2)=1
+33 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+34 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+35 QUIT RETURN
+36 ;
EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
+1 ;INPUT PNAME = Protocol Name
+2 ; MTYP = Message Type Name (ex. "ORU")
+3 ; ETYP = Event Type Name (ex. "Z06")
+4 ; VER = HL7 Version # (ex. 2.3.1)
+5 ; SENDAPP = Sending Application Name (ex. "VAMC 290")
+6 ; ACKPRTN = Acknowledgement Processing Routine -
+7 ; Routine to parse an ACK transmission -
+8 ; MUMPs format (ex. "D ^IVMBACK")
+9 ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
+10 ; DTXT = Disable Text
+11 ; ITEMTXT = Item Text
+12 ;
+13 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
+14 ; -1^Error Message Error
+15 ;
+16 ;PURPOSE Create an Event Driver Protocol and the Sub-File to
+17 ; contain pointers to the Subscriber Protocol file
+18 ;
+19 NEW DATA,FILE,DGENDA,RETURN,ERROR,DA
+20 SET FILE=101
+21 ; If already exists then skip
+22 ;
+23 SET RETURN=+$ORDER(^ORD(101,"B",PNAME,0))
IF +$GET(RETURN)>0
QUIT RETURN
+24 ;
+25 ;PROTOCOL NAME
SET DATA(.01)=PNAME
+26 ;ITEM TEXT
SET DATA(1)=ITEMTXT
+27 ;DISABLE TEXT
SET DATA(2)=""
+28 ;PROTOCOL TYPE
SET DATA(4)="E"
+29 ;CREATOR
SET DATA(5)=+$GET(DUZ)
+30 ;SENDING APP
SET DATA(770.1)=$ORDER(^HL(771,"B",SENDAPP,0))
+31 ;MSG TYPE
SET DATA(770.3)=$ORDER(^HL(771.2,"B",MTYP,0))
+32 ;EVENT TYPE
SET DATA(770.4)=$ORDER(^HL(779.001,"B",ETYP,0))
+33 ;ACCEPT ACK CODE
SET DATA(770.8)=$ORDER(^HL(779.003,"B","AL",0))
+34 ;APPLICATION ACK TYPE
SET DATA(770.9)=$ORDER(^HL(779.003,"B","AL",0))
+35 ;VERSION ID
SET DATA(770.95)=$ORDER(^HL(771.5,"B",VER,0))
+36 ;ACK PROCESSING RTN
SET DATA(772)=ACKPRTN
+37 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
+38 IF ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
GOTO EDPEXIT
+39 SET DGENDA(1)=RETURN
+40 ;
+41 ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
+42 SET FILE=101.0775
+43 KILL DATA
+44 SET DATA(.01)=SUBIEN
+45 SET RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+46 if ERROR'=""!(+RETURN=0)
SET RETURN=-1_"^"_ERROR
+47 ;
EDPEXIT QUIT RETURN
+1 ;
