source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071B.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1EAS1071B ;ALB/PJH - EAS*1*71; ; 11/27/07 3:02pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
3 Q
4 ;
5EN(ARR) ;ENTRY POINT
6 ;
7 N DA,DIK,LINE,LCT,NAM,PREFIX,RESULT
8 ;
9 S ARR="HEC messaging NOT disabled"
10 ;
11 ; Get site's Station #
12 S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" "
13 ;
14 I $$SOR^EAS1071C(PREFIX,PREFIX) D Q
15 .S ARR="Unable to disable messaging, HEC is SOR"
16 ;
17 ;Remove HEC client subscriber protocols from shared servers
18 F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D Q:STOP
19 .S NAM=PREFIX_$P(LINE,";",3)_" CLIENT"
20 .S SIEN101=$O(^ORD(101,"B",NAM,0))
21 .I +SIEN101=0 D Q
22 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
23 ..S RETURN=-1_"^"_ERROR
24 ..D ERROR(RETURN,"Event Driver:"_NAM)
25 .;If this is a SUBSCRIBER remove from SERVER
26 .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE(SIEN101,NAM)
27 ;
28 ;Add disable text to HEC to ESR servers
29 F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D
30 .S NAM=PREFIX_$P(LINE,";",3)
31 .;Insert disable text
32 .S RESULT=$$EDP(NAM,"HEC Legacy to Site Messaging Inactivated")
33 .I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
34 ;
35 S:'STOP ARR="HEC messaging disabled"
36 Q
37 ;
38EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
39 ;
40 N DATA,FILE,DGENDA,RETURN,ERROR,DA
41 S FILE=101
42 S IEN101=$O(^ORD(101,"B",PNAME,0))
43 I 'IEN101 D Q RETURN
44 . S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
45 . S RETURN=-1_"^"_ERROR
46 ;
47 S DATA(2)=DTXT
48 S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
49 I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR
50 ;
51 Q RETURN
52 ;
53REMOVE(CLIENT,CNAM) ;Remove clients from server
54 N DA,DIK,SERV,SNAM,SUB
55 S SERV=0
56 F S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV D
57 .S SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
58 .F S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB D
59 ..S DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," D ^DIK
60 Q
61 ;
62PROTDAT ;Vista to HEC clients on shared Event Drivers
63 ;;ORU-Z07
64 ;;ORU-Z09
65 ;;ORF-Z07
66 ;;END
67 ;;NOTE THAT THESE ARE HANDLED BY QRY^EAS1071A
68 ;;QRY-Z10
69 ;;QRY-Z11
70 ;;END
71 ;
72PROTDAT1 ;HEC to Vista Event Drivers to disable
73 ;;ORU-Z04 SERVER H
74 ;;ORU-Z05 SERVER
75 ;;ORU-Z10 SERVER
76 ;;ORU-Z11 SERVER
77 ;;ORF-Z10 SERVER
78 ;;ORF-Z11 SERVER
79 ;;QRY-Z07 SERVER
80 ;;MFN-ZEG SERVER
81 ;;END
82 ;
83RESET(ARR) ;Enable or Attach HEC protocols
84 N DA,DIK,ERROR,IEN101,LINE,LCT,NAM,PREFIX,SIEN101,SNAM,STOP
85 ;
86 S ARR="HEC messaging NOT re enabled"
87 ;
88 ; Get site's Station #
89 S PREFIX="VAMC "_$P($$SITE^VASITE,"^",3)_" ",STOP=0
90 ;
91 ;Enable to Vista to HEC Legacy servers
92 F LCT=1:1 S LINE=$T(PROTDAT1+LCT) Q:$P(LINE,";",3)="END" D
93 .S NAM=PREFIX_$P(LINE,";",3)
94 .;Remove disable text
95 .S RESULT=$$EDP(NAM,"")
96 .I +RESULT<0 D ERROR(RESULT,"Event Driver:"_NAM)
97 ;
98 ;
99 ;Add HEC client protocols to shared servers
100 F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D
101 .S FILE=101
102 .;Server protocol
103 .S NAM=PREFIX_$P(LINE,";",3)_" SERVER"
104 .I NAM["Z04" S NAM=NAM_" V"
105 .S IEN101=$O(^ORD(101,"B",NAM,0))
106 .I 'IEN101 D Q RETURN
107 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
108 ..S RETURN=-1_"^"_ERROR
109 .;
110 .;Client protocol (subscriber)
111 .S SNAM=PREFIX_$P(LINE,";",3)_" CLIENT"
112 .I SNAM["Z04" S SNAM=SNAM_" V"
113 .S SIEN101=$O(^ORD(101,"B",SNAM,0))
114 .I +SIEN101=0 D Q
115 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
116 ..S RETURN=-1_"^"_ERROR
117 ..D ERROR(RETURN,"Subscriber:"_SNAM)
118 .;Skip if already present
119 .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D Q
120 ..D WARN(NAM,SNAM)
121 .;Add subscriber to event driver
122 .S RETURN=$$SUBSCR(IEN101,SIEN101)
123 .I +RETURN<0 D ERROR(RETURN,"driver with Subscriber:"_SNAM) Q
124 ;
125 S:'STOP ARR="HEC messaging re enabled"
126 Q
127 ;
128 ;
129ERROR(ERRMSG,SUBJ) ;Display Install Error message and set STOP
130 ;
131 S STOP=1
132 ;
133 S ARR(1)="===================================================="
134 S ARR(2)="= ERROR ="
135 S ARR(3)="===================================================="
136 S ARR(4)="When updating "_SUBJ
137 S ARR(5)="===================================================="
138 S ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
139 ;
140 Q
141 ;
142WARN(EDP,SP) ;Display Warning Message
143 ;
144 S ARR(1)="===================================================="
145 S ARR(2)="= WARNING ="
146 S ARR(3)="===================================================="
147 S ARR(4)="When updating "_EDP
148 S ARR(5)="===================================================="
149 S ARR(5)="**"_SP_" is already defined**"
150 ;
151 Q
152 ;
153SUBSCR(IEN101,SIEN101) ;Add client to event driver as a subscriber
154 ;
155 N DATA,DGENDA,ERROR,FILE,RETURN
156 S DGENDA(1)=IEN101
157 S FILE=101.0775
158 S DATA(.01)=SIEN101
159 S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
160 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
161 ;
162 Q RETURN
Note: See TracBrowser for help on using the repository browser.