source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071Q.m@ 1713

Last change on this file since 1713 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1EAS1071Q ;ALB/PJH - Patch Post-Install functions EAS*1*71 ; 11/27/07 3:03pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
3 ;
4 Q ;Entry Points Only
5 ;
6 ;Functions are called by EAS1071P
7 ;
8LL16(LLNAME,LLPTYP,DEVTYP,QSIZE,TCPADDR,TCPPORT,TCPSTYP,PERSIST,STNODE) ;
9 ;INPUT LLNAME = Logical Link Name (ex. "LL HEC 500")
10 ; LLPTYP = LLP Type (ex. "TCP")
11 ; DEVTYP = Device Type - Systems Monitor - display ONLY
12 ; QSIZE = Queue Size
13 ; TCPADDR = TCP/IP Address
14 ; TCPPORT = TCP/IP Port #
15 ; TCPSTYP = TCP/IP Service Type
16 ; C - Client (Sender)
17 ; S - Single Listener
18 ; M - Multi Listener
19 ; PERSIST = Is connection persistent Y or N
20 ; STNODE = Startup Node - TaskMan Node to start on
21 ;
22 ;OUTPUT IEN of entry (#870) Success
23 ; -1^Error Message Error
24 ;
25 ;PURPOSE Create a Logical Link for TCP/IP transmissions.
26 ;
27 N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
28 S FILE=870
29 ; If already exists then skip
30 ;
31 Q:+$O(^HLCS(870,"B",LLNAME,0))>0 ""
32 ;
33 ; set v1.6 field values
34 S DATA(.01)=LLNAME ;LOGICAL LINK NAME
35 S DATA(2)=$O(^HLCS(869.1,"B",LLPTYP,0)) ;LLP TYPE
36 S DATA(3)=DEVTYP ;QUEUE TYPE
37 ;S DATA(4.5)=1 ;AUTOSTART
38 S DATA(21)=QSIZE ;QUEUE SIZE
39 D:TCPSTYP="C" ;IF CLIENT(SENDER)
40 . S DATA(200.02)=3 ;RE-TRANSMISSION ATTEMPTS
41 . S DATA(200.021)="R" ;EXCEED RE-TRANSMISSION
42 . S DATA(200.04)=90 ;READ TIMEOUT
43 . S DATA(200.05)=270 ;ACK TIMEOUT
44 S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
45 S DATA(400.02)=TCPPORT ;TCP/IP PORT
46 S DATA(400.03)=TCPSTYP ;TCP/IP SERVICE TYPE
47 S DATA(400.04)=PERSIST ;PERSISTENT
48 S DATA(400.06)=STNODE ;STARTUP NODE
49 S DATA(14)=1 ;SUSPENDED
50 ;
51 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
52 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
53 ;
54 Q RETURN
55 ;
56APP(ANAME,STATUS,STATION,COUNTRY) ;
57 ;INPUT ANAME = Application Name (ex. "HEC 500")
58 ; STATUS = "a"CTIVE or "i"INACTIVE
59 ; STATION = STATION # (ex. 500)
60 ; COUNTRY = COUNTRY NAME (ex. "USA")
61 ;
62 ;OUTPUT IEN of entry (#771) Success
63 ; -1^Error Message Error
64 ;
65 ;PURPOSE Create an Application
66 ;
67 N DATA,FILE,RETURN,ERROR,DA
68 S FILE=771
69 ; If already exists then skip
70 ;
71 Q:+$O(^HL(771,"B",ANAME,0))>0 ""
72 S DATA(.01)=ANAME
73 S DATA(2)=STATUS
74 S DATA(3)=STATION
75 S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
76 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
77 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
78 Q RETURN
79 ;
80SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
81 ;INPUT PNAME = Protocol Name
82 ; LL = Logical Link Name (ex. "LL VAMC 500")
83 ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
84 ; RMSGTYP = Response Message Type (ex. "ACK")
85 ; REVTTYP = Response Event Type. Usually empty, used more
86 ; in response to a Query with an ORF message.
87 ; MSGPRTN = Message Processing Routine - Routine to parse
88 ; regular transmission of data - MUMPS format
89 ; (ex. "D ^IVMBORU")
90 ;
91 ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
92 ; -1^Error Message
93 ;
94 ;PURPOSE Create a Subscriber Protocol
95 ;
96 N DATA,FILE,RETURN,ERROR,DA,DGENDA
97 S FILE=101
98 ; If already exists then skip
99 ;
100 Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
101 ;
102 S DATA(.01)=PNAME ;PROTOCOL NAME
103 S DATA(4)="S" ;PROTOCOL TYPE
104 S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
105 S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
106 S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
107 S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
108 S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
109 S DATA(773.1)=1 ;SEND FACILITY REQUIRED
110 S DATA(773.2)=1 ;RECV FACILITY REQUIRED
111 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
112 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
113 Q RETURN
114 ;
115EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
116 ;INPUT PNAME = Protocol Name
117 ; MTYP = Message Type Name (ex. "ORU")
118 ; ETYP = Event Type Name (ex. "Z09")
119 ; VER = HL7 Version # (ex. 2.3.1)
120 ; SENDAPP = Sending Application Name (ex. "VAMC 290")
121 ; ACKPRTN = Acknowledgement Processing Routine -
122 ; Routine to parse an ACK transmission -
123 ; MUMPs format (ex. "D ^IVMBACK")
124 ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
125 ; DTXT = Disable Text
126 ; ITEMTXT = Item Text
127 ;
128 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
129 ; -1^Error Message Error
130 ;
131 ;PURPOSE Create an Event Driver Protocol and the Sub-File to
132 ; contain pointers to the Subscriber Protocol file
133 ;
134 N DATA,FILE,DGENDA,RETURN,ERROR,DA
135 S FILE=101
136 ; If already exists then skip
137 ;
138 Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
139 ;
140 S DATA(.01)=PNAME ;PROTOCOL NAME
141 S DATA(1)=ITEMTXT ;ITEM TEXT
142 S DATA(2)=DTXT ;DISABLE TEXT
143 S DATA(4)="E" ;PROTOCOL TYPE
144 S DATA(5)=+$G(DUZ) ;CREATOR
145 S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
146 S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
147 S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
148 S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
149 S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
150 S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
151 S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
152 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
153 I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
154 S DGENDA(1)=RETURN
155 ;
156 ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
157 S FILE=101.0775
158 K DATA
159 S DATA(.01)=SUBIEN
160 S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
161 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
162 ;
163EDPEXIT Q RETURN
164 ;
Note: See TracBrowser for help on using the repository browser.