- 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 Jan 18, 2025@02:54:20 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 ;