Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m (modified) (8 diffs)

FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCSLNCH.m

@@ -1 @@
-HLCSLNCH ;ALB/MTC/JC - START AND STOP THE LLP ;07/26/2007  17:10
- ;;1.6;HEALTH LEVEL SEVEN;**6,19,43,49,57,75,84,109,122**;Oct 13, 1995;Build 14
- ;Per VHA Directive 2004-038, this routine should not be modified.
+HLCSLNCH ;ALB/MTC/JC - START AND STOP THE LLP ;12/31/2003  17:37
+ ;;1.6;HEALTH LEVEL SEVEN;**6,19,43,49,57,75,84,109**;Oct 13, 1995
  ;
  ;This program is callable from a menu
@@ -24 +23 @@
  W !,"appropriate device.  Please select the node with which you want"
  W !,"to communicate",!
- ; patch HL*1.6*122
- S POP=0
  S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC G:Y<0 STARTQ
  S HLDP=+Y,HLDAPP=Y(0,0),HLTYPTR=+$P(Y(0),U,3),HLPARM0=Y(0)
  ;-- check if parameter have been setup
  ;-- check for LLP type
- I 'HLTYPTR W !!,$C(7),"A Lower Layer Protocol must be selected before start-up can occur." G STARTQ
+ I 'HLTYPTR W !,$C(7),"A Lower Layer Protocol must be selected before start-up can occur." G STARTQ
  ;-- get TCP information
  S HLPARM4=$G(^HLCS(870,HLDP,400))
@@ -38 +35 @@
  S HLENV=$G(^HLCS(869.1,HLTYPTR,200))
  ;
- I HLBGR="" W !!,$C(7),"No routine has been specified for this LLP." G STARTQ
+ I HLBGR="" W !,$C(7),"No routine has been specified for this LLP." G STARTQ
  ;
  ;-- execute environment check routine if HLQUIT is defined then terminate
  I HLENV'="" X HLENV G:$D(HLQUIT) STARTQ
- ; patch HL*1.6*122 start
- ; Multi-Servers: TCP service (GT.M, DSM, and Cache/VMS) is controlled
- ; by the external service
+ ;Multi-Servers, only enable the link if not OpenM
  I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D  G STARTQ
  . 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."
  . Q
- ; patch HL*1.6*122 end
  ;
  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"
  I $P(HLPARM0,U,11) W !,"The LLP was last shutdown on ",$$DAT2^HLUTIL1($P(HLPARM0,U,11)),"."
- ; patch HL*1.6*122 start
- ; comment out-should be taken care of by the code 2 line above
- ; 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 !"
- ; I $$TASK^HLUTIL1($P(HLPARM0,U,12)) D  G STARTQ
- ; . W !,$C(7),"NOTE: The lower level protocol for this application is already running."
- N HLTEMP
- S HLTEMP=0
- I $P(HLPARM0,U,12) D  G:HLTEMP STARTQ
- . N ZTSK
- . S ZTSK=$P(HLPARM0,U,12)
- . D STAT^%ZTLOAD
- . I "12"[ZTSK(1) D
- .. W !,$C(7),"NOTE: The lower level protocol for this application is already running."
- .. I '$P(^HLCS(870,HLDP,0),"^",10) S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
- .. S HLTEMP=1
- ; patch HL*1.6*122 end
+ 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 !"
+ I $$TASK^HLUTIL1($P(HLPARM0,U,12)) D  G STARTQ
+ . W !,$C(7),"NOTE: The lower level protocol for this application is already running."
  I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D  G STARTQ
- .;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
+ .;4=status 9=Time Started, 10=Time Stopped, 11=Task Number 
  .;14=Shutdown LLP, 3=Device Type, 18=Gross Errors
  .N HLJ,X
- . ; patch HL*1.6*122-comment out
- . ; I $P(HLPARM0,U,15)=0 W !,"This LLP is already enabled!" Q
+ .I $P(HLPARM0,U,15)=0 W !,"This LLP is already enabled!" Q
  .L +^HLCS(870,HLDP,0):2
  .E  W !,$C(7),"Unable to enable this LLP !" Q
@@ -84 +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.",!
  ;
- ; patch HL*1.6*122 start, for tcp link
- I HLTYPTR=4 D  Q
- . S Y="B"
- . D STARTJOB
- ; patch HL*1.6*122 end
- ;
  W ! S DIR(0)="SM^F:FOREGROUND;B:BACKGROUND;Q:QUIT"
  S DIR("A")="Method for running the receiver"
@@ -99 +73 @@
  Q:(Y=U)!(Y="Q")
  ;
-STARTJOB ;
  S HLX=$G(^HLCS(870,HLDP,0))
  ;-- foreground
  I Y="F" S HLTRACE=1 D  G STARTQ
- . S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
- . D MON^HLCSTCP("Start")
  . X HLBGR
  ;-- background
@@ -111 +82 @@
  . S ZTDESC=HLDAPP_" Low Level Protocol",ZTSAVE("HLDP")=""
  . D ^%ZTLOAD
- . ; patch HL*1.6*122 start
- . I $D(ZTSK) D
- .. K HLTRACE
- .. D MON^HLCSTCP("Tasked")
- .. S $P(^HLCS(870,HLDP,0),"^",10)=$$NOW^XLFDT
- . ; patch HL*1.6*122 end
  . W !,$S($D(ZTSK):"Job was queued as "_ZTSK_".",1:"Unable to queue job.")
  ;
  Q
+ ;
  ;
 STARTQ ;
@@ -132 +98 @@
  S DIC="^HLCS(870,",DIC(0)="QEAMZ" D ^DIC K DIC Q:Y<0
  S HLDP=+Y,HLDAPP=Y(0,0),HLPARM0=Y(0),HLPARM4=$G(^HLCS(870,HLDP,400))
- ; patch HL*1.6*122
- ; Multi-Servers: TCP service (GT.M, DSM, and Cache/VMS) is controlled
- ; by the external service
  I $P(HLPARM4,U,3)="M",$S(^%ZOSF("OS")'["OpenM":1,1:$$OS^%ZOSV["VMS") D  Q
- . 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."
+ . 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."
  . Q
  ;
@@ -150 +113 @@
  I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)),'$P(HLPARM0,U,12) S @X@(4)="Shutdown"
  D FILE^HLDIE("","HLJ","","STOP","HLCSLNCH") ; HL*1.6*109
- ; patch HL*1.6*122 start
- ; I ^%ZOSF("OS")["OpenM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D
- ; I ^%ZOSF("OS")'["DSM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D
- I ($P(HLPARM4,U,3)="S")!(($P(HLPARM4,U,3)="M")&($S(^%ZOSF("OS")'["OpenM":0,1:$$OS^%ZOSV'["VMS"))) D
+ I ^%ZOSF("OS")["OpenM",(($P(HLPARM4,U,3)="M"&($$OS^%ZOSV'["VMS"))!($P(HLPARM4,U,3)="S")) D
  . ;pass task number to stop listener
  . S:$P(HLPARM0,U,12) X=$$ASKSTOP^%ZTLOAD(+$P(HLPARM0,U,12))
- . ; D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
- . ; I POP D HOME^%ZIS U IO W !,"Unable to shutdown logical link!!!",$C(7),$C(7) Q
- . ; U IO W "**STOP**"
- . ; W !
- . ; D CLOSE^%ZISTCP
- . ; patch HL*1.6*122 end
+ . D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
+ . I POP D HOME^%ZIS U IO W !,"Unable to shutdown logical link!!!",$C(7),$C(7) Q
+ . U IO W "**STOP**"
+ . W !
+ . D CLOSE^%ZISTCP
  L -^HLCS(870,HLDP,0)
  W !,"The job for the "_HLDAPP_" Lower Level Protocol will be shut down."