source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071C.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1EAS1071C ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:02pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
3 ;
4LINK ;Link QRY Z10/Z11 protocols to shared servers
5 N ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
6 S LNCNT=1
7 F S LINE=$T(PROTDAT1+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
8 .S NAM=PREFHEC_$P(LINE,";",3)_" SERVER"
9 .S IEN101=$O(^ORD(101,"B",NAM,0))
10 .I +IEN101=0 D Q
11 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
12 ..S RETURN=-1_"^"_ERROR
13 ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
14 .;
15 .;Client Protocol
16 .S SNAM=@("PREF"_SYS)
17 .S SNAM=SNAM_$P(LINE,";",3)_" CLIENT"
18 .S SIEN101=$O(^ORD(101,"B",SNAM,0))
19 .I +SIEN101=0 D Q
20 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
21 ..S RETURN=-1_"^"_ERROR
22 ..D ABORT2^EAS1071A(RETURN,"Subscriber:"_SNAM)
23 .;Skip if already present
24 .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D Q
25 ..D WARN^EAS1071A(NAM,SNAM)
26 ..S LNCNT=LNCNT+1
27 .;Add subscriber to event driver
28 .S RETURN=$$SUBSCR^EAS1071A(IEN101,SIEN101)
29 .I +RETURN<0 D ABORT2^EAS1071A(RETURN,"driver with Subscriber:"_SNAM) Q
30 .S LNCNT=LNCNT+1
31 Q
32 ;
33UNLINK(PREF) ;Remove Z10/Z11 client subscriber protocols from shared servers
34 F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D Q:STOP
35 .S NAM=PREF_$P(LINE,";",3)_" CLIENT"
36 .S SIEN101=$O(^ORD(101,"B",NAM,0))
37 .I +SIEN101=0 D Q
38 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
39 ..S RETURN=-1_"^"_ERROR
40 ..D ABORT2^EAS1071A(RETURN,"Event Driver:"_NAM)
41 .;If this is a SUBSCRIBER remove from SERVER
42 .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE^EAS1071A(SIEN101,NAM)
43 Q
44 ;
45PROTDAT1 ;
46 ;;QRY-Z10
47 ;;QRY-Z11
48 ;;END
49 ;
50SOR(PREF,PREFHEC) ;Check if SOR
51 N IENC,IENS,NAMC,NAMS
52 S NAMS=PREFHEC_"QRY-Z10 SERVER"
53 ;get server ien
54 S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
55 ;check subscriber protocols
56 S IENC=+$G(^ORD(101,IENS,775,1,0)) Q:'IENC 0
57 ;Check subscriber if is for this system
58 I $P($G(^ORD(101,IENC,0)),U)[PREF Q 1
59 ;
60 Q 0
61 ;
62Z07(PREF,PREFHEC) ;Check if Z07 messaging is set up
63 N IENC,IENS,FOUND,NAMC,NAMS
64 S NAMC=PREF_"ORU-Z07 CLIENT",NAMS=PREFHEC_"ORU-Z07 SERVER"
65 ;get server ien
66 S IENS=$O(^ORD(101,"B",NAMS,0)) Q:'IENS 0
67 ;check subscriber protocols
68 S IENC=0,FOUND=0
69 F S IENC=$O(^ORD(101,IENS,775,"B",IENC)) Q:'IENC D Q:FOUND
70 .;Check subscriber if is for this system
71 .S:$P($G(^ORD(101,IENC,0)),U)=NAMC FOUND=1
72 ;
73 Q FOUND
Note: See TracBrowser for help on using the repository browser.