- EAS1071Q ;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
- ;
- Q ;Entry Points Only
- ;
- ;Functions are called by EAS1071P
- ;
- LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
- ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
- ; LLPTYP = LLP Type (ex. "TCP")
- ; DEVTYP = Device Type - Systems Monitor - display ONLY
- ; QSIZE = Queue Size
- ; TCPADDR = TCP/IP Address
- ; TCPPORT = TCP/IP Port #
- ; TCPSTYP = TCP/IP Service Type
- ; C - Client (Sender)
- ; S - Single Listener
- ; M - Multi Listener
- ; PERSIST = Is connection persistent Y or N
- ; STNODE = Startup Node - TaskMan Node to start on
- ;
- ;OUTPUT IEN of entry (#870) Success
- ; -1^Error Message Error
- ;
- ;PURPOSE Create a Logical Link for TCP/IP transmissions.
- ;
- N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
- S FILE=870
- ; If already exists then skip
- ;
- Q:+$O(^HLCS(870,"B",LLNAME,0))>0 ""
- ;
- ; set v1.6 field values
- S DATA(.01)=LLNAME ;LOGICAL LINK NAME
- S DATA(2)=$O(^HLCS(869.1,"B",LLPTYP,0)) ;LLP TYPE
- S DATA(3)=DEVTYP ;QUEUE TYPE
- ;S DATA(4.5)=1 ;AUTOSTART
- S DATA(21)=QSIZE ;QUEUE SIZE
- D:TCPSTYP="C" ;IF CLIENT(SENDER)
- . S DATA(200.02)=3 ;RE-TRANSMISSION ATTEMPTS
- . S DATA(200.021)="R" ;EXCEED RE-TRANSMISSION
- . S DATA(200.04)=90 ;READ TIMEOUT
- . S DATA(200.05)=270 ;ACK TIMEOUT
- S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
- S DATA(400.02)=TCPPORT ;TCP/IP PORT
- S DATA(400.03)=TCPSTYP ;TCP/IP SERVICE TYPE
- S DATA(400.04)=PERSIST ;PERSISTENT
- S DATA(400.06)=STNODE ;STARTUP NODE
- S DATA(14)=1 ;SUSPENDED
- ;
- S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
- S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
- ;
- Q RETURN
- ;
- APP(ANAME,STATUS,STATION,COUNTRY) ;
- ;INPUT ANAME = Application Name (ex. "HEC 500")
- ; STATUS = "a"CTIVE or "i"INACTIVE
- ; STATION = STATION # (ex. 500)
- ; COUNTRY = COUNTRY NAME (ex. "USA")
- ;
- ;OUTPUT IEN of entry (#771) Success
- ; -1^Error Message Error
- ;
- ;PURPOSE Create an Application
- ;
- N DATA,FILE,RETURN,ERROR,DA
- S FILE=771
- ; If already exists then skip
- ;
- Q:+$O(^HL(771,"B",ANAME,0))>0 ""
- S DATA(.01)=ANAME
- S DATA(2)=STATUS
- S DATA(3)=STATION
- S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
- S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
- S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
- Q RETURN
- ;
- SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
- ;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")
- ;
- ;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
- ;
- Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
- ;
- S DATA(.01)=PNAME ;PROTOCOL NAME
- 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. "Z09")
- ; 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
- ;
- Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
- ;
- S DATA(.01)=PNAME ;PROTOCOL NAME
- S DATA(1)=ITEMTXT ;ITEM TEXT
- S DATA(2)=DTXT ;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[HEAS1071Q 6520 printed Feb 18, 2025@23:19:19 Page 2
- EAS1071Q ;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
- +2 ;
- +3 ;Entry Points Only
- QUIT
- +4 ;
- +5 ;Functions are called by EAS1071P
- +6 ;
- LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
- +1 ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
- +2 ; LLPTYP = LLP Type (ex. "TCP")
- +3 ; DEVTYP = Device Type - Systems Monitor - display ONLY
- +4 ; QSIZE = Queue Size
- +5 ; TCPADDR = TCP/IP Address
- +6 ; TCPPORT = TCP/IP Port #
- +7 ; TCPSTYP = TCP/IP Service Type
- +8 ; C - Client (Sender)
- +9 ; S - Single Listener
- +10 ; M - Multi Listener
- +11 ; PERSIST = Is connection persistent Y or N
- +12 ; STNODE = Startup Node - TaskMan Node to start on
- +13 ;
- +14 ;OUTPUT IEN of entry (#870) Success
- +15 ; -1^Error Message Error
- +16 ;
- +17 ;PURPOSE Create a Logical Link for TCP/IP transmissions.
- +18 ;
- +19 NEW FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
- +20 SET FILE=870
- +21 ; If already exists then skip
- +22 ;
- +23 if +$ORDER(^HLCS(870,"B",LLNAME,0))>0
- QUIT ""
- +24 ;
- +25 ; set v1.6 field values
- +26 ;LOGICAL LINK NAME
- SET DATA(.01)=LLNAME
- +27 ;LLP TYPE
- SET DATA(2)=$ORDER(^HLCS(869.1,"B",LLPTYP,0))
- +28 ;QUEUE TYPE
- SET DATA(3)=DEVTYP
- +29 ;S DATA(4.5)=1 ;AUTOSTART
- +30 ;QUEUE SIZE
- SET DATA(21)=QSIZE
- +31 ;IF CLIENT(SENDER)
- if TCPSTYP="C"
- Begin DoDot:1
- +32 ;RE-TRANSMISSION ATTEMPTS
- SET DATA(200.02)=3
- +33 ;EXCEED RE-TRANSMISSION
- SET DATA(200.021)="R"
- +34 ;READ TIMEOUT
- SET DATA(200.04)=90
- +35 ;ACK TIMEOUT
- SET DATA(200.05)=270
- End DoDot:1
- +36 ;TCP/IP ADDRESS
- SET DATA(400.01)=TCPADDR
- +37 ;TCP/IP PORT
- SET DATA(400.02)=TCPPORT
- +38 ;TCP/IP SERVICE TYPE
- SET DATA(400.03)=TCPSTYP
- +39 ;PERSISTENT
- SET DATA(400.04)=PERSIST
- +40 ;STARTUP NODE
- SET DATA(400.06)=STNODE
- +41 ;SUSPENDED
- SET DATA(14)=1
- +42 ;
- +43 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
- +44 if ERROR'=""!(+RETURN=0)
- SET RETURN=-1_"^"_ERROR
- +45 ;
- +46 QUIT RETURN
- +47 ;
- APP(ANAME,STATUS,STATION,COUNTRY) ;
- +1 ;INPUT ANAME = Application Name (ex. "HEC 500")
- +2 ; STATUS = "a"CTIVE or "i"INACTIVE
- +3 ; STATION = STATION # (ex. 500)
- +4 ; COUNTRY = COUNTRY NAME (ex. "USA")
- +5 ;
- +6 ;OUTPUT IEN of entry (#771) Success
- +7 ; -1^Error Message Error
- +8 ;
- +9 ;PURPOSE Create an Application
- +10 ;
- +11 NEW DATA,FILE,RETURN,ERROR,DA
- +12 SET FILE=771
- +13 ; If already exists then skip
- +14 ;
- +15 if +$ORDER(^HL(771,"B",ANAME,0))>0
- QUIT ""
- +16 SET DATA(.01)=ANAME
- +17 SET DATA(2)=STATUS
- +18 SET DATA(3)=STATION
- +19 SET DATA(7)=$ORDER(^HL(779.004,"B",COUNTRY,0))
- +20 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
- +21 if ERROR'=""!(+RETURN=0)
- SET RETURN=-1_"^"_ERROR
- +22 QUIT RETURN
- +23 ;
- SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
- +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 ;
- +11 ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
- +12 ; -1^Error Message
- +13 ;
- +14 ;PURPOSE Create a Subscriber Protocol
- +15 ;
- +16 NEW DATA,FILE,RETURN,ERROR,DA,DGENDA
- +17 SET FILE=101
- +18 ; If already exists then skip
- +19 ;
- +20 if +$ORDER(^ORD(101,"B",PNAME,0))>0
- QUIT ""
- +21 ;
- +22 ;PROTOCOL NAME
- SET DATA(.01)=PNAME
- +23 ;PROTOCOL TYPE
- SET DATA(4)="S"
- +24 ;RESPONSE MSG TYPE
- SET DATA(770.11)=$ORDER(^HL(771.2,"B",RMSGTYP,0))
- +25 ;RECEIVING APP
- SET DATA(770.2)=$ORDER(^HL(771,"B",RECVAPP,0))
- +26 ;EVENT TYPE
- if REVTTYP]""
- SET DATA(770.4)=$ORDER(^HL(779.001,"B",REVTTYP,0))
- +27 ;LOGICAL LINK
- SET DATA(770.7)=$ORDER(^HLCS(870,"B",LL,0))
- +28 ;MSG PROCESSING RTN
- SET DATA(771)=MSGPRTN
- +29 ;SEND FACILITY REQUIRED
- SET DATA(773.1)=1
- +30 ;RECV FACILITY REQUIRED
- SET DATA(773.2)=1
- +31 SET RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
- +32 if ERROR'=""!(+RETURN=0)
- SET RETURN=-1_"^"_ERROR
- +33 QUIT RETURN
- +34 ;
- 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. "Z09")
- +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 if +$ORDER(^ORD(101,"B",PNAME,0))>0
- QUIT ""
- +24 ;
- +25 ;PROTOCOL NAME
- SET DATA(.01)=PNAME
- +26 ;ITEM TEXT
- SET DATA(1)=ITEMTXT
- +27 ;DISABLE TEXT
- SET DATA(2)=DTXT
- +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 ;