Changeset 636 for FOIAVistA/tag/r/HEALTH_LEVEL_SEVEN-HL/HLCS2.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/HLCS2.m (modified) (5 diffs)

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

@@ -1 @@
-HLCS2 ;SF/JC - More Communication Server utilities ; 10/04/2007  14:31
- ;;1.6;HEALTH LEVEL SEVEN;**14,40,43,49,57,58,82,84,109,122**;Oct 13, 1995;Build 14
- ;Per VHA Directive 2004-038, this routine should not be modified.
+HLCS2 ;SF/JC - More Communication Server utilities ; 12/31/2003  17:50
+ ;;1.6;HEALTH LEVEL SEVEN;**14,40,43,49,57,58,82,84,109**;Oct 13, 1995
 FWD ; Add supplemental clients from HLL("LINKS") to HLSUP array
  ;This enhancement also supports distribution of a message to
@@ -10 +9 @@
  . S PTR=$P(HLL("LINKS",CNT),"^"),LNK=$P(HLL("LINKS",CNT),"^",2)
  . Q:PTR=""  I +PTR<1 S PTR=$O(^ORD(101,"B",PTR,0)) Q:PTR<1
- . ;
- . ; patch HL*1.6*122: excluding subscribers defined in
- . ; HLP("EXCLUDE SUBSCRIBER",I) = ien of subscriber
- . N I,EXCLUDE
- . S (EXCLUDE,I)=0
- . F  S I=$O(HLP("EXCLUDE SUBSCRIBER",I)) Q:'I  D  Q:EXCLUDE
- .. N TEMP
- .. S TEMP=HLP("EXCLUDE SUBSCRIBER",I)
- .. I 'TEMP,TEMP]"" S TEMP=$O(^ORD(101,"B",TEMP,0))
- .. I TEMP=PTR S EXCLUDE=1
- . Q:EXCLUDE
- . ; 
  . Q:LNK=""  I +LNK<1 S LNK=$O(^HLCS(870,"B",LNK,0)) Q:LNK<1
  . Q:'$D(^HLCS(870,LNK))
  . S CLIAP=$$PTR^HLUTIL2(PTR)
- . ; patch HL*1.6*122: add the 3rd component as receiving facility
- . ; S HLSUP("S",PTR,+LNK)=CLIAP_$S(CLIAP<1:U_HLL("LINKS",CNT),1:"")
- . S HLSUP("S",PTR,+LNK)=CLIAP_U_$S(CLIAP<1:HLL("LINKS",CNT),1:$P(HLL("LINKS",CNT),"^",3))
+ . S HLSUP("S",PTR,+LNK)=CLIAP_$S(CLIAP<1:U_HLL("LINKS",CNT),1:"")
  Q
 ADD ;Deliver message to supplemental client list.
@@ -39 +24 @@
  ..S ZLCLIENT=+HLSUP("S",ZHLEIDS,ZLOGLINK)
  ..I ZLCLIENT<1 S:$G(HLERROR)="" HLERROR="15^Invalid Subscriber Protocol in HLL('LINKS'): "_$P(HLSUP("S",ZHLEIDS,ZLOGLINK),U,2,9) Q
- .. ; patch HL*1.6*122 start
- .. ; S HLOGLINK=ZLOGLINK D SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK),STATUS^HLTF0(+ZMTIENS,1)
- .. S HLOGLINK=ZLOGLINK
- .. ; 3rd component for receiving facility
- .. S ZMTIENS("REC-FACILITY")=$P(HLSUP("S",ZHLEIDS,ZLOGLINK),U,3)
- .. D SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK)
- .. D STATUS^HLTF0(+ZMTIENS,1)
- .. ; patch HL*1.6*122 end
- .. ;
+ ..S HLOGLINK=ZLOGLINK D SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK),STATUS^HLTF0(+ZMTIENS,1)
  K HLL("LINKS"),HLSUP
  Q
@@ -95 +72 @@
  . I 'ALL&('$P(HLDP0,U,6)) Q
  . S HLPARM4=$G(^HLCS(870,HLDP,400))
- . ; patch HL*1.6*122
- . ; TCP Multi listener: quit if TCP service as GT.M, DSM,
- . ; or Cache/VMS
+ . ;TCP Multi listener for non-Cache uses UCX
  . I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM"  Q:$$OS^%ZOSV["VMS"
- . ;
  . ;4=status,10=Time Stopped,9=Time Started,11=Task Number,3=Device Type,14=shutdown?
- . S X="HLJ(870,"""_HLDP_","")",@X@(10)=$$NOW^XLFDT,(@X@(11),@X@(9))="@",@X@(14)=1
- . I "Shutdown,SHUTDOWN"'[$P(HLDP0,U,5) S @X@(4)="Halting"
+ . S X="HLJ(870,"""_HLDP_","")",@X@(4)="Halting",@X@(10)=$$NOW^XLFDT,(@X@(11),@X@(9))="@",@X@(14)=1
  . I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)),'$P(HLDP0,U,12) S @X@(4)="Shutdown"
  . D FILE^HLDIE("","HLJ","","LLP","HLCS2") ;HL*1.6*109
+ . ;Cache system, need to open TCP port to release job
  . I ^%ZOSF("OS")["OpenM",($P(HLPARM4,U,3)="M"!($P(HLPARM4,U,3)="S")) D
- .. ; pass task number to stop listener
+ .. ;pass task number to stop listener
  .. S:$P(HLDP0,U,12) X=$$ASKSTOP^%ZTLOAD(+$P(HLDP0,U,12))
- ; patch HL*1.6*122 start
- ; .. D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
- ; .. I POP D HOME^%ZIS Q
- ; .. 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 Q
+ .. D CLOSE^%ZISTCP
  Q
 STRT ;Start Links
@@ -126 +98 @@
  . Q:'HLTYPTR!(HLBGR="")
  . I HLENV'="" K HLQUIT X HLENV Q:$D(HLQUIT)
- . ; patch HL*1.6*122
- . ; TCP Multi listener: quit if TCP service as GT.M, DSM,
- . ; or Cache/VMS
+ . ;TCP Multi listener for non-Cache uses UCX
  . I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM"  Q:$$OS^%ZOSV["VMS"
- . ;
  . I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D  Q
  .. ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number