Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m
r613 r623 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 1 HLCSLNCH ;ALB/MTC/JC - START AND STOP THE LLP ;12/31/2003 17:37 2 ;;1.6;HEALTH LEVEL SEVEN;**6,19,43,49,57,75,84,109**;Oct 13, 1995 3 ; 4 ;This program is callable from a menu 5 ;It allows the user to Start and Stop the Lower Layer 6 ;Protocol in the Background or in the foreground 7 ; 8 ;Required or Optional INPUT PARAMETERS 9 ; None 10 ; 11 ; 12 ;Output variables 13 ; HLDP=IEN of Logical Link in file #870 14 ;(optional)HLTRACE=if SET it launches the LLP in the Foreground 15 ;(optional) ZTSK=if defined LLP was launched in the 16 ;background 17 ; 18 ; 19 START ; Start up the lower level protocol 20 N DIC,DIRUT,DTOUT,DUOUT,HLDP,HLDAPP,HLJ,HLQUIT,HLTRACE 21 N HLPARM0,HLPARM4,HLTYPTR,HLBGR,X,Y,ZTCPU,ZTSK,ZTRTN,ZTDESC 22 W !!,"This option is used to launch the lower level protocol for the" 23 W !,"appropriate device. Please select the node with which you want" 24 W !,"to communicate",! 25 S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC G:Y<0 STARTQ 26 S HLDP=+Y,HLDAPP=Y(0,0),HLTYPTR=+$P(Y(0),U,3),HLPARM0=Y(0) 27 ;-- check if parameter have been setup 28 ;-- check for LLP type 29 I 'HLTYPTR W !,$C(7),"A Lower Layer Protocol must be selected before start-up can occur." G STARTQ 30 ;-- get TCP information 31 S HLPARM4=$G(^HLCS(870,HLDP,400)) 32 ;-- get routine (background job for LLP) 33 S HLBGR=$G(^HLCS(869.1,HLTYPTR,100)) 34 ;-- get environment check routine (HLQUIT should be defined in fails) 35 S HLENV=$G(^HLCS(869.1,HLTYPTR,200)) 36 ; 37 I HLBGR="" W !,$C(7),"No routine has been specified for this LLP." G STARTQ 38 ; 39 ;-- execute environment check routine if HLQUIT is defined then terminate 40 I HLENV'="" X HLENV G:$D(HLQUIT) STARTQ 41 ;Multi-Servers, only enable the link if not OpenM 42 I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D G STARTQ 43 . 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." 44 . Q 45 ; 46 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" 47 I $P(HLPARM0,U,11) W !,"The LLP was last shutdown on ",$$DAT2^HLUTIL1($P(HLPARM0,U,11)),"." 48 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 !" 49 I $$TASK^HLUTIL1($P(HLPARM0,U,12)) D G STARTQ 50 . W !,$C(7),"NOTE: The lower level protocol for this application is already running." 51 I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D G STARTQ 52 .;4=status 9=Time Started, 10=Time Stopped, 11=Task Number 53 .;14=Shutdown LLP, 3=Device Type, 18=Gross Errors 54 .N HLJ,X 55 .I $P(HLPARM0,U,15)=0 W !,"This LLP is already enabled!" Q 56 .L +^HLCS(870,HLDP,0):2 57 .E W !,$C(7),"Unable to enable this LLP !" Q 58 .S X="HLJ(870,"""_HLDP_","")" 59 .S @X@(4)="Enabled",@X@(9)=$$NOW^XLFDT,@X@(14)=0 60 .D FILE^HLDIE("","HLJ","","START","HLCSLNCH") ;HL*1.6*109 61 .L -^HLCS(870,HLDP,0) 62 .W !,"This LLP has been enabled!" 63 .Q 64 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.",! 65 ; 66 W ! S DIR(0)="SM^F:FOREGROUND;B:BACKGROUND;Q:QUIT" 67 S DIR("A")="Method for running the receiver" 68 S DIR("B")="B" 69 S DIR("?",1)="Enter F for Foreground (and trace)" 70 S DIR("?",2)=" B for Background (normal) or" 71 S DIR("?")=" Q to quit without starting the receiver" 72 D ^DIR K DIR 73 Q:(Y=U)!(Y="Q") 74 ; 75 S HLX=$G(^HLCS(870,HLDP,0)) 76 ;-- foreground 77 I Y="F" S HLTRACE=1 D G STARTQ 78 . X HLBGR 79 ;-- background 80 I Y="B" D G STARTQ 81 . S ZTRTN=$P(HLBGR," ",2),HLTRACE="",ZTIO="",ZTDTH=$H 82 . S ZTDESC=HLDAPP_" Low Level Protocol",ZTSAVE("HLDP")="" 83 . D ^%ZTLOAD 84 . W !,$S($D(ZTSK):"Job was queued as "_ZTSK_".",1:"Unable to queue job.") 85 ; 86 Q 87 ; 88 ; 89 STARTQ ; 90 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." 91 Q 92 ; 93 STOP ; Shut down a lower level protocol.. 94 N DIC,DIRUT,DTOUT,DUOUT,HLDP,HLDAPP,HLJ,HLPARM0,HLPARM4,X,Y 95 W !!,"This option is used to shut down the lower level protocol for the" 96 W !,"appropriate device. Please select the link which you would" 97 W !,"like to shutdown.",! 98 S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC K DIC Q:Y<0 99 S HLDP=+Y,HLDAPP=Y(0,0),HLPARM0=Y(0),HLPARM4=$G(^HLCS(870,HLDP,400)) 100 I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D Q 101 . W !,$C(7),"This LLP is a multi-threaded server. It is controlled by external service, i.e. UCX. You must use the external service to disable this LLP." 102 . Q 103 ; 104 I $P(HLPARM0,U,15) W !,$C(7),"The lower level protocol is already ",$P(HLPARM0,U,5),"." Q 105 I $P(HLPARM0,U,10) W !,$C(7),"The lower level protocol was started on ",$$DAT2^HLUTIL1($P(HLPARM0,U,10)),"." 106 STP1 ; 107 W ! S DIR(0)="Y",DIR("A")="Okay to shut down this job" D ^DIR K DIR 108 I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"The job will not be shut down." Q 109 S ; 110 F L +^HLCS(870,HLDP,0):2 Q:$T 111 ;4=status,10=Time Stopped,9=Time Started,11=Task Number,3=Device Type,14=shutdown 112 S X="HLJ(870,"""_HLDP_","")",@X@(4)="Halting",@X@(10)=$$NOW^XLFDT,(@X@(11),@X@(9))="@",@X@(14)=1 113 I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)),'$P(HLPARM0,U,12) S @X@(4)="Shutdown" 114 D FILE^HLDIE("","HLJ","","STOP","HLCSLNCH") ; HL*1.6*109 115 I ^%ZOSF("OS")["OpenM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D 116 . ;pass task number to stop listener 117 . S:$P(HLPARM0,U,12) X=$$ASKSTOP^%ZTLOAD(+$P(HLPARM0,U,12)) 118 . D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10) 119 . I POP D HOME^%ZIS U IO W !,"Unable to shutdown logical link!!!",$C(7),$C(7) Q 120 . U IO W "**STOP**" 121 . W ! 122 . D CLOSE^%ZISTCP 123 L -^HLCS(870,HLDP,0) 124 W !,"The job for the "_HLDAPP_" Lower Level Protocol will be shut down." 125 Q 126 ; 127 STOPQ Q
Note:
See TracChangeset
for help on using the changeset viewer.
