source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 7.0 KB
Line 
1HLCSLNCH ;ALB/MTC/JC - START AND STOP THE LLP ;07/26/2007 17:10
2 ;;1.6;HEALTH LEVEL SEVEN;**6,19,43,49,57,75,84,109,122**;Oct 13, 1995;Build 14
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This program is callable from a menu
6 ;It allows the user to Start and Stop the Lower Layer
7 ;Protocol in the Background or in the foreground
8 ;
9 ;Required or Optional INPUT PARAMETERS
10 ; None
11 ;
12 ;
13 ;Output variables
14 ; HLDP=IEN of Logical Link in file #870
15 ;(optional)HLTRACE=if SET it launches the LLP in the Foreground
16 ;(optional) ZTSK=if defined LLP was launched in the
17 ;background
18 ;
19 ;
20START ; Start up the lower level protocol
21 N DIC,DIRUT,DTOUT,DUOUT,HLDP,HLDAPP,HLJ,HLQUIT,HLTRACE
22 N HLPARM0,HLPARM4,HLTYPTR,HLBGR,X,Y,ZTCPU,ZTSK,ZTRTN,ZTDESC
23 W !!,"This option is used to launch the lower level protocol for the"
24 W !,"appropriate device. Please select the node with which you want"
25 W !,"to communicate",!
26 ; patch HL*1.6*122
27 S POP=0
28 S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC G:Y<0 STARTQ
29 S HLDP=+Y,HLDAPP=Y(0,0),HLTYPTR=+$P(Y(0),U,3),HLPARM0=Y(0)
30 ;-- check if parameter have been setup
31 ;-- check for LLP type
32 I 'HLTYPTR W !!,$C(7),"A Lower Layer Protocol must be selected before start-up can occur." G STARTQ
33 ;-- get TCP information
34 S HLPARM4=$G(^HLCS(870,HLDP,400))
35 ;-- get routine (background job for LLP)
36 S HLBGR=$G(^HLCS(869.1,HLTYPTR,100))
37 ;-- get environment check routine (HLQUIT should be defined in fails)
38 S HLENV=$G(^HLCS(869.1,HLTYPTR,200))
39 ;
40 I HLBGR="" W !!,$C(7),"No routine has been specified for this LLP." G STARTQ
41 ;
42 ;-- execute environment check routine if HLQUIT is defined then terminate
43 I HLENV'="" X HLENV G:$D(HLQUIT) STARTQ
44 ; patch HL*1.6*122 start
45 ; Multi-Servers: TCP service (GT.M, DSM, and Cache/VMS) is controlled
46 ; by the external service
47 I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D G STARTQ
48 . W !,$C(7),"This LLP is a multi-threaded server. It is controlled by external service, i.e. TCPIP/UCX. You must use the external service to start this LLP."
49 . Q
50 ; patch HL*1.6*122 end
51 ;
52 I $P(HLPARM0,U,10) W !,$C(7),"The LLP was last started on ",$$DAT2^HLUTIL1($P(HLPARM0,U,10)),"." G STP1:$P(HLPARM0,U,5)'="Error"
53 I $P(HLPARM0,U,11) W !,"The LLP was last shutdown on ",$$DAT2^HLUTIL1($P(HLPARM0,U,11)),"."
54 ; patch HL*1.6*122 start
55 ; comment out-should be taken care of by the code 2 line above
56 ; I $P(HLPARM0,U,5)'="Error",'($P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4))),$P(HLPARM0,U,10)]""&($P(HLPARM0,U,11)=""),$P(HLPARM0,U,12) W !,"The LLP appears to be online already !"
57 ; I $$TASK^HLUTIL1($P(HLPARM0,U,12)) D G STARTQ
58 ; . W !,$C(7),"NOTE: The lower level protocol for this application is already running."
59 N HLTEMP
60 S HLTEMP=0
61 I $P(HLPARM0,U,12) D G:HLTEMP STARTQ
62 . N ZTSK
63 . S ZTSK=$P(HLPARM0,U,12)
64 . D STAT^%ZTLOAD
65 . I "12"[ZTSK(1) D
66 .. W !,$C(7),"NOTE: The lower level protocol for this application is already running."
67 .. I '$P(^HLCS(870,HLDP,0),"^",10) S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
68 .. S HLTEMP=1
69 ; patch HL*1.6*122 end
70 I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D G STARTQ
71 .;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
72 .;14=Shutdown LLP, 3=Device Type, 18=Gross Errors
73 .N HLJ,X
74 . ; patch HL*1.6*122-comment out
75 . ; I $P(HLPARM0,U,15)=0 W !,"This LLP is already enabled!" Q
76 .L +^HLCS(870,HLDP,0):2
77 .E W !,$C(7),"Unable to enable this LLP !" Q
78 .S X="HLJ(870,"""_HLDP_","")"
79 .S @X@(4)="Enabled",@X@(9)=$$NOW^XLFDT,@X@(14)=0
80 .D FILE^HLDIE("","HLJ","","START","HLCSLNCH") ;HL*1.6*109
81 .L -^HLCS(870,HLDP,0)
82 .W !,"This LLP has been enabled!"
83 .Q
84 I $P(HLPARM4,U,6),$D(^%ZIS(14.7,+$P(HLPARM4,U,6),0)) S ZTCPU=$P(^(0),U) W !,"This LLP will start on node ",ZTCPU," if it is run in the Background.",!
85 ;
86 ; patch HL*1.6*122 start, for tcp link
87 I HLTYPTR=4 D Q
88 . S Y="B"
89 . D STARTJOB
90 ; patch HL*1.6*122 end
91 ;
92 W ! S DIR(0)="SM^F:FOREGROUND;B:BACKGROUND;Q:QUIT"
93 S DIR("A")="Method for running the receiver"
94 S DIR("B")="B"
95 S DIR("?",1)="Enter F for Foreground (and trace)"
96 S DIR("?",2)=" B for Background (normal) or"
97 S DIR("?")=" Q to quit without starting the receiver"
98 D ^DIR K DIR
99 Q:(Y=U)!(Y="Q")
100 ;
101STARTJOB ;
102 S HLX=$G(^HLCS(870,HLDP,0))
103 ;-- foreground
104 I Y="F" S HLTRACE=1 D G STARTQ
105 . S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
106 . D MON^HLCSTCP("Start")
107 . X HLBGR
108 ;-- background
109 I Y="B" D G STARTQ
110 . S ZTRTN=$P(HLBGR," ",2),HLTRACE="",ZTIO="",ZTDTH=$H
111 . S ZTDESC=HLDAPP_" Low Level Protocol",ZTSAVE("HLDP")=""
112 . D ^%ZTLOAD
113 . ; patch HL*1.6*122 start
114 . I $D(ZTSK) D
115 .. K HLTRACE
116 .. D MON^HLCSTCP("Tasked")
117 .. S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
118 . ; patch HL*1.6*122 end
119 . W !,$S($D(ZTSK):"Job was queued as "_ZTSK_".",1:"Unable to queue job.")
120 ;
121 Q
122 ;
123STARTQ ;
124 I $G(POP) W !,?5,"-Unable to Open the Device !",!,!,?6,"Check that Port is Logged Out, and that the",!,?6,"Lower Level Protocol is not Already Running."
125 Q
126 ;
127STOP ; Shut down a lower level protocol..
128 N DIC,DIRUT,DTOUT,DUOUT,HLDP,HLDAPP,HLJ,HLPARM0,HLPARM4,X,Y
129 W !!,"This option is used to shut down the lower level protocol for the"
130 W !,"appropriate device. Please select the link which you would"
131 W !,"like to shutdown.",!
132 S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC K DIC Q:Y<0
133 S HLDP=+Y,HLDAPP=Y(0,0),HLPARM0=Y(0),HLPARM4=$G(^HLCS(870,HLDP,400))
134 ; patch HL*1.6*122
135 ; Multi-Servers: TCP service (GT.M, DSM, and Cache/VMS) is controlled
136 ; by the external service
137 I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D Q
138 . W !,$C(7),"This LLP is a multi-threaded server. It is controlled by external service, i.e. TCPIP/UCX. You must use the external service to disable this LLP."
139 . Q
140 ;
141 I $P(HLPARM0,U,15) W !,$C(7),"The lower level protocol is already ",$P(HLPARM0,U,5),"." Q
142 I $P(HLPARM0,U,10) W !,$C(7),"The lower level protocol was started on ",$$DAT2^HLUTIL1($P(HLPARM0,U,10)),"."
143STP1 ;
144 W ! S DIR(0)="Y",DIR("A")="Okay to shut down this job" D ^DIR K DIR
145 I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"The job will not be shut down." Q
146S ;
147 F L +^HLCS(870,HLDP,0):2 Q:$T
148 ;4=status,10=Time Stopped,9=Time Started,11=Task Number,3=Device Type,14=shutdown
149 S X="HLJ(870,"""_HLDP_","")",@X@(4)="Halting",@X@(10)=$$NOW^XLFDT,(@X@(11),@X@(9))="@",@X@(14)=1
150 I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)),'$P(HLPARM0,U,12) S @X@(4)="Shutdown"
151 D FILE^HLDIE("","HLJ","","STOP","HLCSLNCH") ; HL*1.6*109
152 ; patch HL*1.6*122 start
153 ; I ^%ZOSF("OS")["OpenM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D
154 ; I ^%ZOSF("OS")'["DSM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D
155 I ($P(HLPARM4,U,3)="S")!(($P(HLPARM4,U,3)="M")&($S(^%ZOSF("OS")'["OpenM":0,1:$$OS^%ZOSV'["VMS"))) D
156 . ;pass task number to stop listener
157 . S:$P(HLPARM0,U,12) X=$$ASKSTOP^%ZTLOAD(+$P(HLPARM0,U,12))
158 . ; D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
159 . ; I POP D HOME^%ZIS U IO W !,"Unable to shutdown logical link!!!",$C(7),$C(7) Q
160 . ; U IO W "**STOP**"
161 . ; W !
162 . ; D CLOSE^%ZISTCP
163 . ; patch HL*1.6*122 end
164 L -^HLCS(870,HLDP,0)
165 W !,"The job for the "_HLDAPP_" Lower Level Protocol will be shut down."
166 Q
167 ;
168STOPQ Q
Note: See TracBrowser for help on using the repository browser.