source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS1.m@ 767

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1HLCS1 ;ALB/JRP - OPTIONS FOR BACKGROUND FILERS ;10/15/98 10:44
2 ;;1.6;HEALTH LEVEL SEVEN;**19**;Oct 13, 1995
3 ;
4STARTDEF ;Entry point used by OPTION file to task default number of each filer
5 N PTRMAIN,ONENODE,DEFCNT,CURCNT,LOOP
6 ;Get entry in HL COMMUNICATION SERVER PARAMETER file (#869.3)
7 S PTRMAIN=+$O(^HLCS(869.3,0))
8 I ('PTRMAIN) D Q
9 .W $C(7)
10 .W !!,"Entry in HL COMMUNICATION SERVER PARAMETER file (#869.3) has"
11 .W !,"not been made. Entry must be made in order to start execute"
12 .W !,"this option.",!!
13 ;Get zero node of parameter file
14 S ONENODE=$G(^HLCS(869.3,PTRMAIN,1))
15 ;Get default number of incoming filers (piece 1 of node 1)
16 S DEFCNT=+$P(ONENODE,"^",1)
17 I ('DEFCNT) D
18 .;No default value found
19 .S DEFCNT=1
20 .W $C(7)
21 .W !!,"Default number of incoming servers has not been entered into"
22 .W !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3). Will use"
23 .W !,"a value of ",DEFCNT,".",!!
24 ;Get current number of incoming filers running
25 S CURCNT=$$CNTFLR^HLCSUTL2("IN")
26 I ((CURCNT>DEFCNT)!(CURCNT=DEFCNT)) D
27 .;No more incoming filers needed
28 .W $C(7)
29 .W !!,"Default number of incoming servers is set to ",DEFCNT," and"
30 .W !,CURCNT," incoming servers are currently running. No more"
31 .W !,"incoming servers will be started.",!!
32 I (CURCNT<DEFCNT) D
33 .;Start DEFCNT-CURCNT incoming filers
34 .F LOOP=1:1:(DEFCNT-CURCNT) D STARTIN
35 W !
36 ;Get default number of outgoing filers (piece 2 of node 1)
37 S DEFCNT=+$P(ONENODE,"^",2)
38 I ('DEFCNT) D
39 .;No default value found
40 .S DEFCNT=1
41 .W $C(7)
42 .W !!,"Default number of outgoing servers has not been entered into"
43 .W !,"the HL COMMUNICATION SERVER PARAMETER file (#869.3). Will use"
44 .W !,"a value of ",DEFCNT,".",!!
45 ;Get current number of outgoing filers running
46 S CURCNT=$$CNTFLR^HLCSUTL2("OUT")
47 I ((CURCNT>DEFCNT)!(CURCNT=DEFCNT)) D
48 .;No more outgoing filers needed
49 .W $C(7)
50 .W !!,"Default number of outgoing servers is set to ",DEFCNT," and"
51 .W !,CURCNT," outgoing servers are currently running. No more"
52 .W !,"outgoing servers will be started.",!!
53 I (CURCNT<DEFCNT) D
54 .;Start DEFCNT-CURCNT outgoing filers
55 .F LOOP=1:1:(DEFCNT-CURCNT) D STARTOUT
56 W !
57 Q
58STARTIN ;Entry point used by OPTION file to task an incoming filer
59 N TASKNUM
60 S TASKNUM=$$TASKFLR("IN")
61 W:(TASKNUM) !,"Incoming filer queued as task number ",TASKNUM
62 W:('TASKNUM) $C(7),!!,"Unable to queue incoming filer"
63 Q
64STARTOUT ;Entry point used by OPTION file to task an outgoing filer
65 N TASKNUM
66 S TASKNUM=$$TASKFLR("OUT")
67 W:(TASKNUM) !,"Outgoing filer queued as task number ",TASKNUM
68 W:('TASKNUM) $C(7),!!,"Unable to queue outgoing filer"
69 Q
70STOPIN ;Entry point used by OPTION file to stop an incoming filer
71 N PTRSUB,FLRLST
72 ;Get list of filers
73 D GETFLRS^HLCSUTL2("IN","FLRLST")
74 ;No filers running
75 I ('$D(FLRLST)) W $C(7),!!,"No incoming filers are running",!! Q
76 ;Get first filer out of list
77 S PTRSUB=+$O(FLRLST(0))
78 I ('PTRSUB) W $C(7),!!,"No incoming filers are running",!! Q
79 ;Stop incoming filer
80 D STOPFLR^HLCSUTL1(PTRSUB,"IN")
81 W !!,"Incoming filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!
82 Q
83STOPOUT ;Entry point used by OPTION file to stop an outgoing filer
84 N PTRSUB,FLRLST
85 ;Get list of filers
86 D GETFLRS^HLCSUTL2("OUT","FLRLST")
87 ;No filers running
88 I ('$D(FLRLST)) W $C(7),!!,"No outgoing filers are running",!! Q
89 ;Get first filer out of list
90 S PTRSUB=+$O(FLRLST(0))
91 I ('PTRSUB) W $C(7),!!,"No outgoing filers are running",!! Q
92 ;Stop filer
93 D STOPFLR^HLCSUTL1(PTRSUB,"OUT")
94 W !!,"Outgoing filer queued as task number ",+FLRLST(PTRSUB)," has been asked to stop",!!
95 Q
96STOPAIN ;Entry point used by OPTION file to stop all incoming filers
97 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
98 ;Make sure user wants to stop all filers
99 S DIR(0)="YA"
100 S DIR("A")="Are you sure you want to stop all incoming filers ? "
101 S DIR("B")="NO"
102 S DIR("?",1)="Stopping all incoming filers will prevent messages being"
103 S DIR("?",2)="received through Logical Links from being passed to the"
104 S DIR("?",3)="appropriate application. Answer 'YES' if you really want"
105 S DIR("?")="this to occur."
106 W !!
107 D ^DIR
108 I (($D(DIRUT))!('$G(Y))) W !!,"Incoming filers will not be stopped",!! Q
109 ;Stop all filers
110 W !!,"Please wait while all incoming filers are asked to stop ..."
111 D STOPALL("IN")
112 W !,"All incoming filers have been asked to stop",!!
113 Q
114STOPAOUT ;Entry point used by OPTION file to stop all outgoing filers
115 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
116 ;Make sure user wants to stop all filers
117 S DIR(0)="YA"
118 S DIR("A")="Are you sure you want to stop all outgoing filers ? "
119 S DIR("B")="NO"
120 S DIR("?",1)="Stopping all outgoing filers will prevent messages from"
121 S DIR("?",2)="being transmitted to external systems through Logical"
122 S DIR("?")="Links. Answer 'YES' if you really want this to occur."
123 W !!
124 D ^DIR
125 I (($D(DIRUT))!('$G(Y))) W !!,"Outgoing filers will not be stopped",!! Q
126 ;Stop all filers
127 W !!,"Please wait while all outgoing filers are asked to stop ..."
128 D STOPALL("OUT")
129 W !,"All outgoing filers have been asked to stop",!!
130 Q
131TASKFLR(FLRTYPE) ;Task an incoming/outgoing filer
132 ;INPUT : FLRTYPE - Flag denote type of filer to start
133 ; IN - Incoming filer (default)
134 ; OUT - Outgoing filer
135 ;OUTPUT : ZTSK (results of call to TaskMan)
136 ;
137 ;Check input
138 S FLRTYPE=$G(FLRTYPE)
139 ;Declare variables
140 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,TMP
141 S ZTIO=""
142 S ZTDTH=$H
143 ;Task incoming filer
144 S ZTRTN="STARTIN^HLCSIN"
145 S ZTDESC="HL7 Incoming Filer"
146 ;Task outgoing filer
147 I (FLRTYPE="OUT") D
148 .S ZTRTN="STARTOUT^HLCSOUT"
149 .S ZTDESC="HL7 Outgoing Filer"
150 ;Call TaskMan
151 S ZTSK=0
152 D ^%ZTLOAD
153 S ZTSK=+$G(ZTSK)
154 ;Not tasked
155 Q:('ZTSK)
156 ;Create entry in HL COMMUNICATION SERVER PARAMETER file
157 S TMP=$$CRTFLR^HLCSUTL1(ZTSK,FLRTYPE)
158 ;Return task number
159 Q ZTSK
160STOPALL(FLRTYPE) ;Stop all incoming/outgoing filers
161 ;INPUT : FLRTYPE - Flag denote type of filer to start
162 ; IN - Incoming filer (default)
163 ; OUT - Outgoing filer
164 ;OUTPUT : None
165 ;
166 ;Check input
167 S FLRTYPE=$G(FLRTYPE)
168 S:((FLRTYPE'="OUT")&(FLRTYPE'="IN")) FLRTYPE="IN"
169 ;Declare variables
170 N PTRSUB,FLRLST
171 ;Get list of filers
172 D GETFLRS^HLCSUTL2(FLRTYPE,"FLRLST")
173 ;No filers running
174 Q:('$D(FLRLST))
175 ;Loop through list of filers, stopping each
176 S PTRSUB=0
177 F S PTRSUB=+$O(FLRLST(PTRSUB)) Q:('PTRSUB) D STOPFLR^HLCSUTL1(PTRSUB,FLRTYPE)
178 Q
179EDITPRAM ;Entry point used by OPTION file to edit file 869.3
180 ;Declare variables
181 N DIC,X,Y,DTOUT,DUOUT,DLAYGO,DIE,DA,DR
182 ;Create/find entry HL COMMUNICATION SERVER PARAMETER file (#869.3)
183 S DLAYGO=869.3
184 S DIC="^HLCS(869.3,"
185 S DIC(0)="L"
186 S DIC("DR")="11///1;12///1"
187 S X=1
188 D ^DIC
189 ;Error
190 I (Y="-1") D Q
191 .W !!,"Unable to create/find entry in HL COMMUNICATION SERVER"
192 .W !,"PARAMETER file (#869.3). Entry must exist in order for"
193 .W !,"the incoming & outgoing filers to run. Use FileMan to"
194 .W !,"create an initial entry for editing.",!!
195 ;Entry created
196 I ($P(Y,"^",3)) D
197 .;Tell user entry was created
198 .W !!,"Initial entry in HL COMMUNICATION SERVER PARAMETER file"
199 .W !,"(#869.3) has been created.",!
200 ;Edit parameters
201 S DIE="^HLCS(869.3,"
202 S DA=+Y
203 S DR="11Default number of incoming filers;12Default number of outgoing filers"
204 D ^DIE
205 Q
Note: See TracBrowser for help on using the repository browser.