1 | IVM2078P ;ALB/EJG - Patch Post-Install functions IVM*2*78;04/07/2003
|
---|
2 | ;;2.0;INCOME VERIFICATION;**78**;21-OCT-94
|
---|
3 | ;
|
---|
4 | EN ;ENTRY POINT
|
---|
5 | ;
|
---|
6 | N ADDR,PORT,STATION,TCPDATA,AN,RLLN,SLLN,STOP,VER,DA,FILE,RET,ERROR
|
---|
7 | ;
|
---|
8 | ; Get site's Station #
|
---|
9 | S STATION=$P($$SITE^VASITE,"^",3)
|
---|
10 | ;
|
---|
11 | S STOP=0
|
---|
12 | D CLEANUP ;Cleanup message placed with wrong LL
|
---|
13 | Q:$$SETLL16(STATION,.RLLN,.SLLN)
|
---|
14 | D PROTOCOL(STATION,RLLN,SLLN,.AN)
|
---|
15 | Q
|
---|
16 | ;
|
---|
17 | SETLL16(STATION,RLLN,SLLN) ;
|
---|
18 | ;INPUT STATION = Station #
|
---|
19 | ; RLLN = Receiving Logical Link Name
|
---|
20 | ; SLLN = Sending Logical Link Name
|
---|
21 | ;
|
---|
22 | ;OUTPUT 0 : Success, 1 : Error
|
---|
23 | ;
|
---|
24 | ;PURPOSE Create the Receiving and Sending Logical Link.
|
---|
25 | ;
|
---|
26 | N ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
|
---|
27 | ;
|
---|
28 | ; Sending Logical Link
|
---|
29 | S SLLN="LLEDBOUT"
|
---|
30 | S PORT=33001 ;e*Gate Port#
|
---|
31 | S ADDR="10.224.132.101" ;e*Gate production
|
---|
32 | S RET=$$LL16(SLLN,ADDR,PORT,1)
|
---|
33 | I +RET<0 D ERROR(RET,"Edb Send Link:"_SLLN) Q 1
|
---|
34 | ;
|
---|
35 | RLL ; Receiving Logical Link
|
---|
36 | S RLLN="LLEDBIN"
|
---|
37 | S ADDR=""
|
---|
38 | S PORT="" ;all stations production
|
---|
39 | S RET=$$LL16(RLLN,ADDR,PORT,0)
|
---|
40 | I +RET<0 D ERROR(RET,"Edb Receive Link:"_RLLN) Q 1
|
---|
41 | LL16EXIT Q STOP
|
---|
42 | ;
|
---|
43 | ;
|
---|
44 | PROTOCOL(STATION,RLLN,SLLN,AN) ;
|
---|
45 | ;INPUT STATION = Station #
|
---|
46 | ; RLLN = Receiving Logical Link Name
|
---|
47 | ; SLLN = Sending Logical Link Name
|
---|
48 | ; AN = Array containing the Application Names
|
---|
49 | ;
|
---|
50 | ;OUTPUT None
|
---|
51 | ;
|
---|
52 | ;PURPOSE Update the protocols (Subscriber and Event Driver) for the
|
---|
53 | ; Edb/e*Gate TCP/IP interfaces
|
---|
54 | ;
|
---|
55 | N RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM,DISABTXT
|
---|
56 | S DISABTXT=""
|
---|
57 | F NAM="EAS EDB ORU-Z06 SERVER","EAS EDB ORU-Z09 SERVER" D
|
---|
58 | . S RESULT=$$EDP(NAM,DISABTXT)
|
---|
59 | . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
|
---|
60 | Q
|
---|
61 | ;
|
---|
62 | ERROR(ERRMSG,SUBJ) ;
|
---|
63 | ;INPUT ERRMSG = Error Message text
|
---|
64 | ; SUBJ = Subject of the Message
|
---|
65 | ;
|
---|
66 | ;OUTPUT none
|
---|
67 | ;
|
---|
68 | ;PURPOSE Display an error message to the user. Set the
|
---|
69 | ; variable STOP=1 which will stop the routine
|
---|
70 | ; from continuing to run after an error is found.
|
---|
71 | ;
|
---|
72 | N TXT
|
---|
73 | S STOP=1
|
---|
74 | S TXT=$P(ERRMSG,"^",2)
|
---|
75 | W !,"===================================================="
|
---|
76 | W !,"= ERROR ="
|
---|
77 | W !,"===================================================="
|
---|
78 | W !,"When creating "_SUBJ
|
---|
79 | W !,"===================================================="
|
---|
80 | W !,"**ERROR MSG: ",TXT
|
---|
81 | Q
|
---|
82 | ;
|
---|
83 | ;Update Functions
|
---|
84 | ;
|
---|
85 | LL16(LLNAME,TCPADDR,TCPPORT,AUTO) ;
|
---|
86 | ;INPUT LLNAME = Logical Link Name (ex. "LLEDBOUT")
|
---|
87 | ; TCPADDR = TCP/IP Address
|
---|
88 | ; TCPPORT = TCP/IP Port #
|
---|
89 | ; AUTO = AUTOSTART
|
---|
90 | ; 0 - DISABLED
|
---|
91 | ; 1 - ENABLED
|
---|
92 | ;
|
---|
93 | ;OUTPUT IEN of entry (#870) Success
|
---|
94 | ; -1^Error Message Error
|
---|
95 | ;
|
---|
96 | ;PURPOSE Update a Logical Link for TCP/IP transmissions.
|
---|
97 | ;
|
---|
98 | N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
|
---|
99 | S FILE=870
|
---|
100 | ; If already exists then skip
|
---|
101 | ;
|
---|
102 | S IEN870=$O(^HLCS(870,"B",LLNAME,0)) ;IEN TO UPDATE
|
---|
103 | I 'IEN870 D Q RETURN ;IEN NOT FOUND - RETURN ERROR
|
---|
104 | . S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
|
---|
105 | . S RETURN=-1_"^"_ERROR
|
---|
106 | ;
|
---|
107 | ; set v1.6 field values
|
---|
108 | S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
|
---|
109 | S DATA(400.02)=TCPPORT ;TCP/IP PORT
|
---|
110 | S DATA(4.5)=AUTO ;AUTOSTART
|
---|
111 | ;
|
---|
112 | S RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
|
---|
113 | S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
|
---|
114 | ;
|
---|
115 | Q RETURN
|
---|
116 | ;
|
---|
117 | EDP(PNAME,DTXT) ;
|
---|
118 | ;INPUT PNAME = Protocol Name
|
---|
119 | ; DTXT = Disable Text
|
---|
120 | ;
|
---|
121 | ;OUTPUT IEN entry (#101) of Event Driver Protocol Success
|
---|
122 | ; -1^Error Message Error
|
---|
123 | ;
|
---|
124 | ;PURPOSE Activate the Event Driver Protocol
|
---|
125 | ;
|
---|
126 | N DATA,FILE,DGENDA,RETURN,ERROR,DA,IEN101
|
---|
127 | S FILE=101
|
---|
128 | ; If already exists then skip
|
---|
129 | ;
|
---|
130 | S IEN101=$O(^ORD(101,"B",PNAME,0))
|
---|
131 | I 'IEN101 D Q RETURN ;IEN NOT FOUND - RETURN ERROR
|
---|
132 | . S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED"
|
---|
133 | . S RETURN=-1_"^"_ERROR
|
---|
134 | ;
|
---|
135 | S DATA(2)=DTXT ;DISABLE TEXT
|
---|
136 | S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
|
---|
137 | I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR G EDPEXIT
|
---|
138 | ;
|
---|
139 | EDPEXIT Q RETURN
|
---|
140 | ;
|
---|
141 | ;Clean up those message that have been placed into the EDB outbound
|
---|
142 | ; logical link - LLEDBOUT erroneously. Delete them out of LLEDBOUT
|
---|
143 | ; queue and place into general outbound queue.
|
---|
144 | ;
|
---|
145 | CLEANUP N IEN870,VISN,M,IEN,QIEN,SLLN
|
---|
146 | S IEN870=$O(^HLCS(870,"B","LLEDBOUT",0))
|
---|
147 | I 'IEN870 Q
|
---|
148 | I '$D(^HLMA("AC","O",IEN870)) Q ;Nothing in queue
|
---|
149 | W !,"Requeue Z09 messages"
|
---|
150 | S IEN=0
|
---|
151 | F S IEN=$O(^HLMA("AC","O",IEN870,IEN)) Q:'IEN D
|
---|
152 | . W !?2,"Requeued Record# ",IEN
|
---|
153 | . L +^HLMA(IEN):0 Q:'$T
|
---|
154 | . D REQUEUE(IEN)
|
---|
155 | . L -^HLMA(IEN)
|
---|
156 | W !,"Requeue of records completed.",!
|
---|
157 | Q
|
---|
158 | ;
|
---|
159 | ;Requeue the transaction into the IVM Billing Transmission (#301.61)
|
---|
160 | ; file
|
---|
161 | ;
|
---|
162 | REQUEUE(IEN773) N DFN,HLTCP,IEN30161,IEN772,PFLG,REC,SEG,SEQ,SID
|
---|
163 | S IEN772=+$P($G(^HLMA(IEN773,0)),"^")
|
---|
164 | S (PFLG,SEQ)=0
|
---|
165 | F S SEQ=$O(^HL(772,IEN772,"IN",SEQ)) Q:'SEQ D
|
---|
166 | .I $P(^HL(772,IEN772,"IN",SEQ,0),"^")="PID" D
|
---|
167 | ..S REC=$G(^HL(772,IEN772,"IN",SEQ,0))
|
---|
168 | ..S DFN=+$P($P(REC,"^",4),"~")
|
---|
169 | ..S PFLG=1
|
---|
170 | .I PFLG,$P(^HL(772,IEN772,"IN",SEQ,0),"^")="FT1" D
|
---|
171 | ..S REC=$G(^HL(772,IEN772,"IN",SEQ,0))
|
---|
172 | ..S SID=$P(REC,"^",8)
|
---|
173 | ..S IEN30161=$O(^IVM(301.61,"B",SID,0))
|
---|
174 | ..S ^IVM(301.61,"ATR",DFN,IEN30161)="" ;Requeue for IVM Billing
|
---|
175 | I 'PFLG Q ;PID Segment not found
|
---|
176 | S HLTCP=1
|
---|
177 | D STATUS^HLTF0(IEN773,3,,,1) ;Set 773 transaction to COMPLETE
|
---|
178 | Q
|
---|