source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2069Q.m@ 1791

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

initial load of FOIAVistA 6/30/08 version

File size: 6.1 KB
Line 
1IVM2069Q ;ALB/EJG - Patch Post-Install functions IVM*2*69;11/27/2002; 9/20/01 4:16pm
2 ;;2.0;INCOME VERIFICATION;**69**;21-OCT-94
3 ;
4 Q ;Entry Points Only
5 ;
6 ;Functions are called by IVM2069P
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 ;
50 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
51 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
52 ;
53 Q RETURN
54 ;
55APP(ANAME,STATUS,STATION,COUNTRY) ;
56 ;INPUT ANAME = Application Name (ex. "HEC 500")
57 ; STATUS = "a"CTIVE or "i"INACTIVE
58 ; STATION = STATION # (ex. 500)
59 ; COUNTRY = COUNTRY NAME (ex. "USA")
60 ;
61 ;OUTPUT IEN of entry (#771) Success
62 ; -1^Error Message Error
63 ;
64 ;PURPOSE Create an Application
65 ;
66 N DATA,FILE,RETURN,ERROR,DA
67 S FILE=771
68 ; If already exists then skip
69 ;
70 Q:+$O(^HL(771,"B",ANAME,0))>0 ""
71 S DATA(.01)=ANAME
72 S DATA(2)=STATUS
73 S DATA(3)=STATION
74 S DATA(7)=$O(^HL(779.004,"B",COUNTRY,0))
75 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
76 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
77 Q RETURN
78 ;
79SP(PNAME,LL,RECVAPP,RMSGTYP,REVTTYP,MSGPRTN) ;
80 ;INPUT PNAME = Protocol Name
81 ; LL = Logical Link Name (ex. "LL VAMC 500")
82 ; RECVAPP = Receiving Application Name (ex. "VAMC 500")
83 ; RMSGTYP = Response Message Type (ex. "ACK")
84 ; REVTTYP = Response Event Type. Usually empty, used more
85 ; in response to a Query with an ORF message.
86 ; MSGPRTN = Message Processing Routine - Routine to parse
87 ; regular transmission of data - MUMPS format
88 ; (ex. "D ^IVMBORU")
89 ;
90 ;OUTPUT IEN entry (#101) for Subscriber Protocol Success
91 ; -1^Error Message
92 ;
93 ;PURPOSE Create a Subscriber Protocol
94 ;
95 N DATA,FILE,RETURN,ERROR,DA,DGENDA
96 S FILE=101
97 ; If already exists then skip
98 ;
99 Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
100 S DATA(.01)=PNAME ;PROTOCOL NAME
101 S DATA(4)="S" ;PROTOCOL TYPE
102 S DATA(770.11)=$O(^HL(771.2,"B",RMSGTYP,0)) ;RESPONSE MSG TYPE
103 S DATA(770.2)=$O(^HL(771,"B",RECVAPP,0)) ;RECEIVING APP
104 S:REVTTYP]"" DATA(770.4)=$O(^HL(779.001,"B",REVTTYP,0)) ;EVENT TYPE
105 S DATA(770.7)=$O(^HLCS(870,"B",LL,0)) ;LOGICAL LINK
106 S DATA(771)=MSGPRTN ;MSG PROCESSING RTN
107 S DATA(773.1)=1 ;SEND FACILITY REQUIRED
108 S DATA(773.2)=1 ;RECV FACILITY REQUIRED
109 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
110 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
111 Q RETURN
112 ;
113EDP(PNAME,MTYP,ETYP,VER,SENDAPP,ACKPRTN,SUBIEN,DTXT,ITEMTXT) ;
114 ;INPUT PNAME = Protocol Name
115 ; MTYP = Message Type Name (ex. "ORU")
116 ; ETYP = Event Type Name (ex. "Z09")
117 ; VER = HL7 Version # (ex. 2.3.1)
118 ; SENDAPP = Sending Application Name (ex. "VAMC 290")
119 ; ACKPRTN = Acknowledgement Processing Routine -
120 ; Routine to parse an ACK transmission -
121 ; MUMPs format (ex. "D ^IVMBACK")
122 ; SUBIEN = IEN of Subscriber Protocol in ^ORD(101)
123 ; DTXT = Disable Text
124 ; ITEMTXT = Item Text
125 ;
126 ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
127 ; -1^Error Message Error
128 ;
129 ;PURPOSE Create an Event Driver Protocol and the Sub-File to
130 ; contain pointers to the Subscriber Protocol file
131 ;
132 N DATA,FILE,DGENDA,RETURN,ERROR,DA
133 S FILE=101
134 ; If already exists then skip
135 ;
136 Q:+$O(^ORD(101,"B",PNAME,0))>0 ""
137 S DATA(.01)=PNAME ;PROTOCOL NAME
138 S DATA(1)=ITEMTXT ;ITEM TEXT
139 S DATA(2)=DTXT ;DISABLE TEXT
140 S DATA(4)="E" ;PROTOCOL TYPE
141 S DATA(5)=+$G(DUZ) ;CREATOR
142 S DATA(770.1)=$O(^HL(771,"B",SENDAPP,0)) ;SENDING APP
143 S DATA(770.3)=$O(^HL(771.2,"B",MTYP,0)) ;MSG TYPE
144 S DATA(770.4)=$O(^HL(779.001,"B",ETYP,0)) ;EVENT TYPE
145 S DATA(770.8)=$O(^HL(779.003,"B","AL",0)) ;ACCEPT ACK CODE
146 S DATA(770.9)=$O(^HL(779.003,"B","AL",0)) ;APPLICATION ACK TYPE
147 S DATA(770.95)=$O(^HL(771.5,"B",VER,0)) ;VERSION ID
148 S DATA(772)=ACKPRTN ;ACK PROCESSING RTN
149 S RETURN=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
150 I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
151 S DGENDA(1)=RETURN
152 ;
153 ; ADD SUBSCRIBER SUB-FILE TO EVENT DRIVER PROTOCOL
154 S FILE=101.0775
155 K DATA
156 S DATA(.01)=SUBIEN
157 S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
158 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
159 ;
160EDPEXIT Q RETURN
161 ;
Note: See TracBrowser for help on using the repository browser.