close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2078P.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2078P.m@ 1464

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
1IVM2078P ;ALB/EJG - Patch Post-Install functions IVM*2*78;04/07/2003
2 ;;2.0;INCOME VERIFICATION;**78**;21-OCT-94
3 ;
4EN ;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 ;
17SETLL16(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 ;
35RLL ; 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
41LL16EXIT Q STOP
42 ;
43 ;
44PROTOCOL(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 ;
62ERROR(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 ;
85LL16(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 ;
117EDP(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 ;
139EDPEXIT 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 ;
145CLEANUP 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 ;
162REQUEUE(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
Note: See TracBrowser for help on using the repository browser.