source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2069P.m@ 623

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1IVM2069P ;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 ;
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 Q:$$SETLL16(STATION,.RLLN,.SLLN)
13 Q:$$SETAPP(STATION,.AN)
14 D PROTOCOL(STATION,RLLN,SLLN,.AN)
15 ;
16 ;Update #301.93 with new Closure Reasons
17 ;
18CLOSREA S FILE=301.93
19 S ERROR=""
20 K DATA
21 I '$D(^IVM(301.93,"B","CONVERTED")) D Q:ERROR'=""!(+RET=0)
22 . S DATA(.01)="CONVERTED"
23 . S RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
24 . I ERROR'=""!(+RET=0) D
25 . . S RET=-1_"^"_ERROR
26 . . D ERROR(RET,"Updating #301.93")
27 I '$D(^IVM(301.93,"B","NOT CONVERTED")) D Q:ERROR'=""!(+RET=0)
28 . S DATA(.01)="NOT CONVERTED"
29 . S RET=$$ADD^DGENDBS(FILE,"",.DATA,.ERROR)
30 . I ERROR'=""!(+RET=0) D
31 . . S RET=-1_"^"_ERROR
32 . . D ERROR(RET,"Updating #301.93")
33 Q
34 ;
35SETLL16(STATION,RLLN,SLLN) ;
36 ;INPUT STATION = Station #
37 ; RLLN = Receiving Logical Link Name
38 ; SLLN = Sending Logical Link Name
39 ;
40 ;OUTPUT 0 : Success, 1 : Error
41 ;
42 ;PURPOSE Create the Receiving and Sending Logical Link.
43 ;
44 N ADDR,PORT,RECVLL,SENDLL,RET,VISN,M,IENS
45 ;
46 S PORT=7788 ;e*Gate Port#
47 ;
48 ; Sending Logical Link
49 S SLLN="LLEDBOUT"
50 S ADDR="10.224.132.101" ;e*Gate development
51 ;S ADDR="10.224.132.103" ;e*Gate production
52 S RET=$$LL16^IVM2069Q(SLLN,"TCP","NC",10,ADDR,PORT,"C","N","")
53 I +RET<0 D ERROR(RET,"Edb Send Link:"_SLLN) Q 1
54 ;
55RLL ; Receiving Logical Link
56 S RLLN="LLEDBIN"
57 S ADDR=""
58 S PORT="" ;5000 ;all stations production
59 S RET=$$LL16^IVM2069Q(RLLN,"TCP","MS",10,ADDR,PORT,"M","N","")
60 I +RET<0 D ERROR(RET,"Edb Receive Link:"_RLLN) Q 1
61LL16EXIT Q STOP
62 ;
63 ;
64SETAPP(STATION,AN) ;
65 ;INPUT STATION = Station #
66 ; AN = Array containing all the Application Names
67 ;
68 ;OUTPUT 0 : Success, 1 : Error
69 ;
70 ;PURPOSE Create the sending and receiving application definitions.
71 ;
72 N RECVAPP,SENDAPP
73 S AN("S")="EAS EDB"
74 S SENDAPP=$$APP^IVM2069Q(AN("S"),"a",STATION,"USA")
75 I +SENDAPP<0 D ERROR(SENDAPP,"Sending App:"_AN("S")) G APPEXIT
76 ;
77ANR S AN("R")="EDB eGate"
78 S RECVAPP=$$APP^IVM2069Q(AN("R"),"a",200,"USA")
79 I +RECVAPP<0 D ERROR(RECVAPP,"Receiving App:"_AN("R"))
80APPEXIT Q STOP
81 ;
82 ;
83PROTOCOL(STATION,RLLN,SLLN,AN) ;
84 ;INPUT STATION = Station #
85 ; RLLN = Receiving Logical Link Name
86 ; SLLN = Sending Logical Link Name
87 ; AN = Array containing the Application Names
88 ;
89 ;OUTPUT None
90 ;
91 ;PURPOSE Using the table in line label PROTDAT create the
92 ; protocols (Subscriber and Event Driver) for the
93 ; Edb/e*Gate TCP/IP interfaces
94 ;
95 N RESULT,SIEN,DUZ,V,N,N1,LNCNT,LINE,PROTRET,NAM
96 ;S N1="VAMC "_STATION,V="2.3.1"
97 S N1="",V="2.3.1"
98 ;
99 S LNCNT=1
100 F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
101 . K D,RESULT
102 . F N=3:1 Q:$P(LINE,";",N)="LEND" S D(N)=$$V($P(LINE,";",N))
103 . S NAM=D(3)_D(4)_D(5)
104 . D:NAM["CLIENT"
105 . . S SIEN=$$SP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10))
106 . . I +SIEN<0 D ERROR(SIEN,"Subscriber:"_NAM)
107 . D:NAM["SERVER"
108 . . N TMPNAM,ITEMTXT
109 . . S TMPNAM=D(6)_D(7)_$P(NAM,"SERVER ",2)
110 . . S ITEMTXT=$$GETIT(TMPNAM)
111 . . S RESULT=$$EDP^IVM2069Q(NAM,D(6),D(7),D(8),D(9),D(10),D(11),D(12),ITEMTXT)
112 . . I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
113 . S LNCNT=LNCNT+1
114 K D
115 Q
116 ;
117ERROR(ERRMSG,SUBJ) ;
118 ;INPUT ERRMSG = Error Message text
119 ; SUBJ = Subject of the Message
120 ;
121 ;OUTPUT none
122 ;
123 ;PURPOSE Display an error message to the user. Set the
124 ; variable STOP=1 which will stop the routine
125 ; from continuing to run after an error is found.
126 ;
127 N TXT
128 S STOP=1
129 S TXT=$P(ERRMSG,"^",2)
130 W !,"===================================================="
131 W !,"= ERROR ="
132 W !,"===================================================="
133 W !,"When creating "_SUBJ
134 W !,"===================================================="
135 W !,"**ERROR MSG: ",TXT
136 Q
137 ;
138V(VALUE) ;FUNCTION: If variable then pass back value of it.
139 ;
140 I $E(VALUE)="@" Q @($E(VALUE,2,$L(VALUE)))
141 Q VALUE
142 ;
143GETIT(N) ;FUNCTION: Given Message Type and Event Type return the
144 ; Transmission Description.
145 Q:N="ORUZ06" "IVM Case Status/Unsolicited HEC/Edb to VAMC"
146 Q:N="ORUZ09" "IVM BILLING/COLLECTION/Unsolicited VAMC to HEC/Edb"
147 Q ""
148 ;
149PROTDAT ;;VAMC SIDE PROTOCOLS
150 ;;@N1;;EAS EDB ORU-Z06 CLIENT;@SLLN;@AN("S");ACK;;D ORU^EASPREC2;LEND
151 ;;@N1;;EAS EDB ORU-Z06 SERVER;ORU;Z06;@V;@AN("R");;@SIEN;Edb-to-Site Messaging Inactive;LEND
152 ;;@N1;;EAS EDB ORU-Z09 CLIENT;@SLLN;@AN("R");ACK;;;LEND
153 ;;@N1;;EAS EDB ORU-Z09 SERVER;ORU;Z09;@V;@AN("S");D ACK^IVMPREC1;@SIEN;Site-to-Edb Messaging Inactive;LEND
154 ;;END
155 ;
Note: See TracBrowser for help on using the repository browser.