HLCS2 ;SF/JC - More Communication Server utilities ; 08/05/2011 11:22
;;1.6;HEALTH LEVEL SEVEN;**14,40,43,49,57,58,82,84,109,122,157**;Oct 13, 1995;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
FWD ; Add supplemental clients from HLL("LINKS") to HLSUP array
;This enhancement also supports distribution of a message to
;the same client over multiple logical links.
Q:'$D(HLL("LINKS"))
N CNT,LNK,CLIAP
S CNT=0,ROUTINE=1 F S CNT=$O(HLL("LINKS",CNT)) Q:CNT<1 D
. 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))
Q
ADD ;Deliver message to supplemental client list.
;Invoked by HLTP before and after processing normal clients
;Only processes remote links. Local clients must be subscribing
;protocols.
Q:'$D(HLSUP("S"))
N HLTCP,HLTCPI,HLTCPO,ZHLEIDS,ZLCLIENT,ZLOGLINK,ZMTIENS
S ZHLEIDS=0 F S ZHLEIDS=$O(HLSUP("S",ZHLEIDS)) Q:ZHLEIDS<1 D
.S ZLOGLINK=0 F S ZLOGLINK=$O(HLSUP("S",ZHLEIDS,ZLOGLINK)) Q:ZLOGLINK<1 D
..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
.. ;
K HLL("LINKS"),HLSUP
Q
STALL ;STOP ALL LINKS AND FILERS
N DIR,Y
W ! S DIR(0)="Y",DIR("A")="Okay to shut down all Links and Filers"
D ^DIR
I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"Shutdown Aborted!" Q
W !,"Shutting down all Links and Filers..."
D CLEAR
D LLP(1)
Q
QUE ;Restart Filers and AUTOSTART Logical Links after system re-boot
N DIR,Y
I '$D(ZTQUEUED) D Q:'Y!($D(DIRUT))!($D(DUOUT))
.W ! S DIR(0)="Y",DIR("A")="Shutdown and restart ALL AUTOSTART links and filers. Okay"
.D ^DIR
.I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"RESTART Aborted!" Q
.W !,"Restarting all Autostart-Enabled Links and Filers..."
D CLEAR
D STARTF
D LLP(0)
D STRT
Q
CLEAR ;Reset state of 869.3
S DA(1)=1,DA=0,DIK="^HLCS(869.3,1,2,"
F S DA=$O(^HLCS(869.3,DA(1),2,DA)) Q:DA<1 D ^DIK
S DA=0,DIK="^HLCS(869.3,1,3,"
F S DA=$O(^HLCS(869.3,DA(1),3,DA)) Q:DA<1 D ^DIK
Q
STARTF ;Start filers
;Get Defaults
N TMP,PTR,DEFCNT,DA,HLCNT,HLNODE1
S PTR=+$O(^HLCS(869.3,0)) Q:'PTR
;default # of incoming filers
S HLNODE1=$G(^HLCS(869.3,PTR,1)),DEFCNT=+$P(HLNODE1,U) S:'DEFCNT DEFCNT=1
F HLCNT=1:1:DEFCNT S TMP=$$TASKFLR^HLCS1("IN")
;default # of outgoing filers
S DEFCNT=+$P(HLNODE1,U,2) S:'DEFCNT DEFCNT=1
F HLCNT=1:1:DEFCNT S TMP=$$TASKFLR^HLCS1("OUT")
Q
LLP(ALL) ;Stop Logical Links
;ALL=1 OR 0 IF zero, only AUTOSTART LINKS get stopped
N HLDP,HLDP0,HLPARM0,HLPARM4,HLJ,X,Y S HLDP=0
F S HLDP=$O(^HLCS(870,HLDP)) Q:'HLDP S HLDP0=$G(^(HLDP,0)),X=+$P(HLDP0,U,3) D:X
.;skip this link if not stopping all and Autostart not enabled
. 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
. ; patch HL*1.6*157
. ; I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
. I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:($$OS^%ZOSV["VMS")!($$OS^%ZOSV["UNIX")
. ;
. ;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"
. 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
. ; patch HL*1.6*157
. ; I ^%ZOSF("OS")["OpenM",($P(HLPARM4,U,3)="M"!($P(HLPARM4,U,3)="S")) D
. I ($P(HLPARM4,U,3)="M"!($P(HLPARM4,U,3)="S")) D
.. ; 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
Q
STRT ;Start Links
N HLDP,HLDP0,HLDAPP,HLTYPTR,HLBGR,HLENV,HLPARAM0,HLPARM4,HLQUIT,ZTRTN,ZTDESC,ZTSK,ZTCPU
S HLDP=0
F S HLDP=$O(^HLCS(870,HLDP)) Q:HLDP<1 S HLDP0=$G(^(HLDP,0)) D
. S HLPARM4=$G(^HLCS(870,HLDP,400))
. ;quit if no parameters or AUTOSTART is disabled
. Q:'$P(HLDP0,U,6)
. ;HLDAPP=LL name, HLTYPTR=LL type, HLBGR=routine, HLENV=environment check
. S HLDAPP=$P(HLDP0,U),HLTYPTR=+$P(HLDP0,U,3),HLBGR=$G(^HLCS(869.1,HLTYPTR,100)),HLENV=$G(^(200))
. ;quit if no LL type or no routine
. 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
. ; patch HL*1.6*157
. ; I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
. I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:($$OS^%ZOSV["VMS")!($$OS^%ZOSV["UNIX")
. ;
. I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D Q
.. ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
.. ;14=Shutdown LLP, 3=Device Type, 18=Gross Errors
.. N HLJ,X
.. I $P(HLDP0,U,15)=0 Q
.. L +^HLCS(870,HLDP,0):2
.. E Q
.. S X="HLJ(870,"""_HLDP_","")"
.. S @X@(4)="Enabled",@X@(9)=$$NOW^XLFDT,@X@(14)=0
.. D FILE^HLDIE("","HLJ","","STRT","HLCS2") ; HL*1.6*109
.. L -^HLCS(870,HLDP,0)
.. Q
. S ZTRTN=$P(HLBGR," ",2),ZTIO="",ZTDTH=$H,HLTRACE=""
. S ZTDESC=HLDAPP_" Low Level Protocol",ZTSAVE("HLDP")=""
. ;get startup node
. I $P(HLPARM4,U,6),$D(^%ZIS(14.7,+$P(HLPARM4,U,6),0)) S ZTCPU=$P(^(0),U)
. D ^%ZTLOAD
Q
SITEP ;Edit Site Parameters
S DDSFILE=869.3,DA=1,DR="[HL SITE PARAMETERS]" D ^DDS
Q
PARAM() ;Return HL7 site parameters
;HLPARAM=domain ien^domain name^production or test^institution ien^
;institution name^institution number^mail group ien^mail group name^
;purge completed messages^purge awaiting ack messages^purge all msgs^
;default retention
N HLX,HLX4,HLX5,HLDOMP,HLDOMN,HLPROD,HLINSP,HLINSN,HLINSNM,HLMAILP,HLMAILN,HLPARAM,HLPRGAA,HLPRGALL,HLPRGCMP,HLDEFRET
S HLX=$G(^HLCS(869.3,1,0))
S HLX4=$G(^HLCS(869.3,1,4))
S HLX5=$G(^HLCS(869.3,1,5))
S HLDOMP=$P(HLX,U,2) I HLDOMP S HLDOMN=$P(^DIC(4.2,HLDOMP,0),U)
S HLPROD=$P(HLX,U,3)
S HLINSP=$P(HLX,U,4) I HLINSP S HLINSN=$P(^DIC(4,HLINSP,0),U),HLINSNM=$P($G(^DIC(4,HLINSP,99)),U)
S HLMAILP=$P(HLX,U,5) I HLMAILP S HLMAILN=$P(^XMB(3.8,HLMAILP,0),U)
S HLPRGCMP=$P(HLX4,U),HLPRGAA=$P(HLX4,U,2),HLPRGALL=$P(HLX4,U,3)
S HLDEFRET=$P(HLX5,U)
S HLPARAM=HLDOMP_U_$G(HLDOMN)_U_$G(HLPROD)_U_HLINSP_U_$G(HLINSN)_U_$G(HLINSNM)_U_HLMAILP_U_$G(HLMAILN)_U_HLPRGCMP_U_HLPRGAA_U_HLPRGALL_U_HLDEFRET
Q HLPARAM
;
GETAPP(HLAPP) ;Function to Retrieve parameters pertaining to a specific sending or receiving application
;HLAPP=APPLICATION NAME OR IEN OF FILE 771
;Returns MAIL GROUP NAME^'a' or 'i' (active or inactive)
S HLAPP=$G(HLAPP)
I HLAPP]"",'HLAPP S HLAPP=$O(^HL(771,"B",$E(HLAPP,1,30),0))
I 'HLAPP Q ""
I HLAPP S HLM=$P(^HL(771,HLAPP,0),U,4)
I HLM S HLM=$P($G(^XMB(3.8,HLM,0)),U)
Q $G(HLM)_U_$P(^HL(771,HLAPP,0),U,2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCS2 8119 printed Oct 16, 2024@17:57:06 Page 2
HLCS2 ;SF/JC - More Communication Server utilities ; 08/05/2011 11:22
+1 ;;1.6;HEALTH LEVEL SEVEN;**14,40,43,49,57,58,82,84,109,122,157**;Oct 13, 1995;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
FWD ; Add supplemental clients from HLL("LINKS") to HLSUP array
+1 ;This enhancement also supports distribution of a message to
+2 ;the same client over multiple logical links.
+3 if '$DATA(HLL("LINKS"))
QUIT
+4 NEW CNT,LNK,CLIAP
+5 SET CNT=0
SET ROUTINE=1
FOR
SET CNT=$ORDER(HLL("LINKS",CNT))
if CNT<1
QUIT
Begin DoDot:1
+6 SET PTR=$PIECE(HLL("LINKS",CNT),"^")
SET LNK=$PIECE(HLL("LINKS",CNT),"^",2)
+7 if PTR=""
QUIT
IF +PTR<1
SET PTR=$ORDER(^ORD(101,"B",PTR,0))
if PTR<1
QUIT
+8 ;
+9 ; patch HL*1.6*122: excluding subscribers defined in
+10 ; HLP("EXCLUDE SUBSCRIBER",I) = ien of subscriber
+11 NEW I,EXCLUDE
+12 SET (EXCLUDE,I)=0
+13 FOR
SET I=$ORDER(HLP("EXCLUDE SUBSCRIBER",I))
if 'I
QUIT
Begin DoDot:2
+14 NEW TEMP
+15 SET TEMP=HLP("EXCLUDE SUBSCRIBER",I)
+16 IF 'TEMP
IF TEMP]""
SET TEMP=$ORDER(^ORD(101,"B",TEMP,0))
+17 IF TEMP=PTR
SET EXCLUDE=1
End DoDot:2
if EXCLUDE
QUIT
+18 if EXCLUDE
QUIT
+19 ;
+20 if LNK=""
QUIT
IF +LNK<1
SET LNK=$ORDER(^HLCS(870,"B",LNK,0))
if LNK<1
QUIT
+21 if '$DATA(^HLCS(870,LNK))
QUIT
+22 SET CLIAP=$$PTR^HLUTIL2(PTR)
+23 ; patch HL*1.6*122: add the 3rd component as receiving facility
+24 ; S HLSUP("S",PTR,+LNK)=CLIAP_$S(CLIAP<1:U_HLL("LINKS",CNT),1:"")
+25 SET HLSUP("S",PTR,+LNK)=CLIAP_U_$SELECT(CLIAP<1:HLL("LINKS",CNT),1:$PIECE(HLL("LINKS",CNT),"^",3))
End DoDot:1
+26 QUIT
ADD ;Deliver message to supplemental client list.
+1 ;Invoked by HLTP before and after processing normal clients
+2 ;Only processes remote links. Local clients must be subscribing
+3 ;protocols.
+4 if '$DATA(HLSUP("S"))
QUIT
+5 NEW HLTCP,HLTCPI,HLTCPO,ZHLEIDS,ZLCLIENT,ZLOGLINK,ZMTIENS
+6 SET ZHLEIDS=0
FOR
SET ZHLEIDS=$ORDER(HLSUP("S",ZHLEIDS))
if ZHLEIDS<1
QUIT
Begin DoDot:1
+7 SET ZLOGLINK=0
FOR
SET ZLOGLINK=$ORDER(HLSUP("S",ZHLEIDS,ZLOGLINK))
if ZLOGLINK<1
QUIT
Begin DoDot:2
+8 SET ZLCLIENT=+HLSUP("S",ZHLEIDS,ZLOGLINK)
+9 IF ZLCLIENT<1
if $GET(HLERROR)=""
SET HLERROR="15^Invalid Subscriber Protocol in HLL('LINKS'): "_$PIECE(HLSUP("S",ZHLEIDS,ZLOGLINK),U,2,9)
QUIT
+10 ; patch HL*1.6*122 start
+11 ; S HLOGLINK=ZLOGLINK D SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK),STATUS^HLTF0(+ZMTIENS,1)
+12 SET HLOGLINK=ZLOGLINK
+13 ; 3rd component for receiving facility
+14 SET ZMTIENS("REC-FACILITY")=$PIECE(HLSUP("S",ZHLEIDS,ZLOGLINK),U,3)
+15 DO SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK)
+16 DO STATUS^HLTF0(+ZMTIENS,1)
+17 ; patch HL*1.6*122 end
+18 ;
End DoDot:2
End DoDot:1
+19 KILL HLL("LINKS"),HLSUP
+20 QUIT
STALL ;STOP ALL LINKS AND FILERS
+1 NEW DIR,Y
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Okay to shut down all Links and Filers"
+3 DO ^DIR
+4 IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
WRITE !!,"Shutdown Aborted!"
QUIT
+5 WRITE !,"Shutting down all Links and Filers..."
+6 DO CLEAR
+7 DO LLP(1)
+8 QUIT
QUE ;Restart Filers and AUTOSTART Logical Links after system re-boot
+1 NEW DIR,Y
+2 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Shutdown and restart ALL AUTOSTART links and filers. Okay"
+4 DO ^DIR
+5 IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
WRITE !!,"RESTART Aborted!"
QUIT
+6 WRITE !,"Restarting all Autostart-Enabled Links and Filers..."
End DoDot:1
if 'Y!($DATA(DIRUT))!($DATA(DUOUT))
QUIT
+7 DO CLEAR
+8 DO STARTF
+9 DO LLP(0)
+10 DO STRT
+11 QUIT
CLEAR ;Reset state of 869.3
+1 SET DA(1)=1
SET DA=0
SET DIK="^HLCS(869.3,1,2,"
+2 FOR
SET DA=$ORDER(^HLCS(869.3,DA(1),2,DA))
if DA<1
QUIT
DO ^DIK
+3 SET DA=0
SET DIK="^HLCS(869.3,1,3,"
+4 FOR
SET DA=$ORDER(^HLCS(869.3,DA(1),3,DA))
if DA<1
QUIT
DO ^DIK
+5 QUIT
STARTF ;Start filers
+1 ;Get Defaults
+2 NEW TMP,PTR,DEFCNT,DA,HLCNT,HLNODE1
+3 SET PTR=+$ORDER(^HLCS(869.3,0))
if 'PTR
QUIT
+4 ;default # of incoming filers
+5 SET HLNODE1=$GET(^HLCS(869.3,PTR,1))
SET DEFCNT=+$PIECE(HLNODE1,U)
if 'DEFCNT
SET DEFCNT=1
+6 FOR HLCNT=1:1:DEFCNT
SET TMP=$$TASKFLR^HLCS1("IN")
+7 ;default # of outgoing filers
+8 SET DEFCNT=+$PIECE(HLNODE1,U,2)
if 'DEFCNT
SET DEFCNT=1
+9 FOR HLCNT=1:1:DEFCNT
SET TMP=$$TASKFLR^HLCS1("OUT")
+10 QUIT
LLP(ALL) ;Stop Logical Links
+1 ;ALL=1 OR 0 IF zero, only AUTOSTART LINKS get stopped
+2 NEW HLDP,HLDP0,HLPARM0,HLPARM4,HLJ,X,Y
SET HLDP=0
+3 FOR
SET HLDP=$ORDER(^HLCS(870,HLDP))
if 'HLDP
QUIT
SET HLDP0=$GET(^(HLDP,0))
SET X=+$PIECE(HLDP0,U,3)
if X
Begin DoDot:1
+4 ;skip this link if not stopping all and Autostart not enabled
+5 IF 'ALL&('$PIECE(HLDP0,U,6))
QUIT
+6 SET HLPARM4=$GET(^HLCS(870,HLDP,400))
+7 ; patch HL*1.6*122
+8 ; TCP Multi listener: quit if TCP service as GT.M, DSM,
+9 ; or Cache/VMS
+10 ; patch HL*1.6*157
+11 ; I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
+12 IF $PIECE(HLPARM4,U,3)="M"
if ^%ZOSF("OS")'["OpenM"
QUIT
if ($$OS^%ZOSV["VMS")!($$OS^%ZOSV["UNIX")
QUIT
+13 ;
+14 ;4=status,10=Time Stopped,9=Time Started,11=Task Number,3=Device Type,14=shutdown?
+15 SET X="HLJ(870,"""_HLDP_","")"
SET @X@(10)=$$NOW^XLFDT
SET (@X@(11),@X@(9))="@"
SET @X@(14)=1
+16 IF "Shutdown,SHUTDOWN"'[$PIECE(HLDP0,U,5)
SET @X@(4)="Halting"
+17 IF $PIECE(HLPARM4,U,3)="C"&("N"[$PIECE(HLPARM4,U,4))
IF '$PIECE(HLDP0,U,12)
SET @X@(4)="Shutdown"
+18 ;HL*1.6*109
DO FILE^HLDIE("","HLJ","","LLP","HLCS2")
+19 ; patch HL*1.6*157
+20 ; I ^%ZOSF("OS")["OpenM",($P(HLPARM4,U,3)="M"!($P(HLPARM4,U,3)="S")) D
+21 IF ($PIECE(HLPARM4,U,3)="M"!($PIECE(HLPARM4,U,3)="S"))
Begin DoDot:2
+22 ; pass task number to stop listener
+23 if $PIECE(HLDP0,U,12)
SET X=$$ASKSTOP^%ZTLOAD(+$PIECE(HLDP0,U,12))
End DoDot:2
End DoDot:1
+24 ; patch HL*1.6*122 start
+25 ; .. D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
+26 ; .. I POP D HOME^%ZIS Q
+27 ; .. D CLOSE^%ZISTCP
+28 ; patch HL*1.6*122 end
+29 QUIT
STRT ;Start Links
+1 NEW HLDP,HLDP0,HLDAPP,HLTYPTR,HLBGR,HLENV,HLPARAM0,HLPARM4,HLQUIT,ZTRTN,ZTDESC,ZTSK,ZTCPU
+2 SET HLDP=0
+3 FOR
SET HLDP=$ORDER(^HLCS(870,HLDP))
if HLDP<1
QUIT
SET HLDP0=$GET(^(HLDP,0))
Begin DoDot:1
+4 SET HLPARM4=$GET(^HLCS(870,HLDP,400))
+5 ;quit if no parameters or AUTOSTART is disabled
+6 if '$PIECE(HLDP0,U,6)
QUIT
+7 ;HLDAPP=LL name, HLTYPTR=LL type, HLBGR=routine, HLENV=environment check
+8 SET HLDAPP=$PIECE(HLDP0,U)
SET HLTYPTR=+$PIECE(HLDP0,U,3)
SET HLBGR=$GET(^HLCS(869.1,HLTYPTR,100))
SET HLENV=$GET(^(200))
+9 ;quit if no LL type or no routine
+10 if 'HLTYPTR!(HLBGR="")
QUIT
+11 IF HLENV'=""
KILL HLQUIT
XECUTE HLENV
if $DATA(HLQUIT)
QUIT
+12 ; patch HL*1.6*122
+13 ; TCP Multi listener: quit if TCP service as GT.M, DSM,
+14 ; or Cache/VMS
+15 ; patch HL*1.6*157
+16 ; I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
+17 IF $PIECE(HLPARM4,U,3)="M"
if ^%ZOSF("OS")'["OpenM"
QUIT
if ($$OS^%ZOSV["VMS")!($$OS^%ZOSV["UNIX")
QUIT
+18 ;
+19 IF $PIECE(HLPARM4,U,3)="C"&("N"[$PIECE(HLPARM4,U,4))
Begin DoDot:2
+20 ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
+21 ;14=Shutdown LLP, 3=Device Type, 18=Gross Errors
+22 NEW HLJ,X
+23 IF $PIECE(HLDP0,U,15)=0
QUIT
+24 LOCK +^HLCS(870,HLDP,0):2
+25 IF '$TEST
QUIT
+26 SET X="HLJ(870,"""_HLDP_","")"
+27 SET @X@(4)="Enabled"
SET @X@(9)=$$NOW^XLFDT
SET @X@(14)=0
+28 ; HL*1.6*109
DO FILE^HLDIE("","HLJ","","STRT","HLCS2")
+29 LOCK -^HLCS(870,HLDP,0)
+30 QUIT
End DoDot:2
QUIT
+31 SET ZTRTN=$PIECE(HLBGR," ",2)
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET HLTRACE=""
+32 SET ZTDESC=HLDAPP_" Low Level Protocol"
SET ZTSAVE("HLDP")=""
+33 ;get startup node
+34 IF $PIECE(HLPARM4,U,6)
IF $DATA(^%ZIS(14.7,+$PIECE(HLPARM4,U,6),0))
SET ZTCPU=$PIECE(^(0),U)
+35 DO ^%ZTLOAD
End DoDot:1
+36 QUIT
SITEP ;Edit Site Parameters
+1 SET DDSFILE=869.3
SET DA=1
SET DR="[HL SITE PARAMETERS]"
DO ^DDS
+2 QUIT
PARAM() ;Return HL7 site parameters
+1 ;HLPARAM=domain ien^domain name^production or test^institution ien^
+2 ;institution name^institution number^mail group ien^mail group name^
+3 ;purge completed messages^purge awaiting ack messages^purge all msgs^
+4 ;default retention
+5 NEW HLX,HLX4,HLX5,HLDOMP,HLDOMN,HLPROD,HLINSP,HLINSN,HLINSNM,HLMAILP,HLMAILN,HLPARAM,HLPRGAA,HLPRGALL,HLPRGCMP,HLDEFRET
+6 SET HLX=$GET(^HLCS(869.3,1,0))
+7 SET HLX4=$GET(^HLCS(869.3,1,4))
+8 SET HLX5=$GET(^HLCS(869.3,1,5))
+9 SET HLDOMP=$PIECE(HLX,U,2)
IF HLDOMP
SET HLDOMN=$PIECE(^DIC(4.2,HLDOMP,0),U)
+10 SET HLPROD=$PIECE(HLX,U,3)
+11 SET HLINSP=$PIECE(HLX,U,4)
IF HLINSP
SET HLINSN=$PIECE(^DIC(4,HLINSP,0),U)
SET HLINSNM=$PIECE($GET(^DIC(4,HLINSP,99)),U)
+12 SET HLMAILP=$PIECE(HLX,U,5)
IF HLMAILP
SET HLMAILN=$PIECE(^XMB(3.8,HLMAILP,0),U)
+13 SET HLPRGCMP=$PIECE(HLX4,U)
SET HLPRGAA=$PIECE(HLX4,U,2)
SET HLPRGALL=$PIECE(HLX4,U,3)
+14 SET HLDEFRET=$PIECE(HLX5,U)
+15 SET HLPARAM=HLDOMP_U_$GET(HLDOMN)_U_$GET(HLPROD)_U_HLINSP_U_$GET(HLINSN)_U_$GET(HLINSNM)_U_HLMAILP_U_$GET(HLMAILN)_U_HLPRGCMP_U_HLPRGAA_U_HLPRGALL_U_HLDEFRET
+16 QUIT HLPARAM
+17 ;
GETAPP(HLAPP) ;Function to Retrieve parameters pertaining to a specific sending or receiving application
+1 ;HLAPP=APPLICATION NAME OR IEN OF FILE 771
+2 ;Returns MAIL GROUP NAME^'a' or 'i' (active or inactive)
+3 SET HLAPP=$GET(HLAPP)
+4 IF HLAPP]""
IF 'HLAPP
SET HLAPP=$ORDER(^HL(771,"B",$EXTRACT(HLAPP,1,30),0))
+5 IF 'HLAPP
QUIT ""
+6 IF HLAPP
SET HLM=$PIECE(^HL(771,HLAPP,0),U,4)
+7 IF HLM
SET HLM=$PIECE($GET(^XMB(3.8,HLM,0)),U)
+8 QUIT $GET(HLM)_U_$PIECE(^HL(771,HLAPP,0),U,2)
