[628] | 1 | HLCSLNCH ;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 | ;
|
---|
| 20 | START ; 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 | ;
|
---|
| 101 | STARTJOB ;
|
---|
| 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 | ;
|
---|
| 123 | STARTQ ;
|
---|
| 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 | ;
|
---|
| 127 | STOP ; 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)),"."
|
---|
| 143 | STP1 ;
|
---|
| 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
|
---|
| 146 | S ;
|
---|
| 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 | ;
|
---|
| 168 | STOPQ Q
|
---|