source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCS2.m@ 1111

Last change on this file since 1111 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 6.4 KB
Line 
1HLCS2 ;SF/JC - More Communication Server utilities ; 12/31/2003 17:50
2 ;;1.6;HEALTH LEVEL SEVEN;**14,40,43,49,57,58,82,84,109**;Oct 13, 1995
3FWD ; Add supplemental clients from HLL("LINKS") to HLSUP array
4 ;This enhancement also supports distribution of a message to
5 ;the same client over multiple logical links.
6 Q:'$D(HLL("LINKS"))
7 N CNT,LNK,CLIAP
8 S CNT=0,ROUTINE=1 F S CNT=$O(HLL("LINKS",CNT)) Q:CNT<1 D
9 . S PTR=$P(HLL("LINKS",CNT),"^"),LNK=$P(HLL("LINKS",CNT),"^",2)
10 . Q:PTR="" I +PTR<1 S PTR=$O(^ORD(101,"B",PTR,0)) Q:PTR<1
11 . Q:LNK="" I +LNK<1 S LNK=$O(^HLCS(870,"B",LNK,0)) Q:LNK<1
12 . Q:'$D(^HLCS(870,LNK))
13 . S CLIAP=$$PTR^HLUTIL2(PTR)
14 . S HLSUP("S",PTR,+LNK)=CLIAP_$S(CLIAP<1:U_HLL("LINKS",CNT),1:"")
15 Q
16ADD ;Deliver message to supplemental client list.
17 ;Invoked by HLTP before and after processing normal clients
18 ;Only processes remote links. Local clients must be subscribing
19 ;protocols.
20 Q:'$D(HLSUP("S"))
21 N HLTCP,HLTCPI,HLTCPO,ZHLEIDS,ZLCLIENT,ZLOGLINK,ZMTIENS
22 S ZHLEIDS=0 F S ZHLEIDS=$O(HLSUP("S",ZHLEIDS)) Q:ZHLEIDS<1 D
23 .S ZLOGLINK=0 F S ZLOGLINK=$O(HLSUP("S",ZHLEIDS,ZLOGLINK)) Q:ZLOGLINK<1 D
24 ..S ZLCLIENT=+HLSUP("S",ZHLEIDS,ZLOGLINK)
25 ..I ZLCLIENT<1 S:$G(HLERROR)="" HLERROR="15^Invalid Subscriber Protocol in HLL('LINKS'): "_$P(HLSUP("S",ZHLEIDS,ZLOGLINK),U,2,9) Q
26 ..S HLOGLINK=ZLOGLINK D SEND^HLMA2(ZHLEIDS,HLMTIEN,ZLCLIENT,"D",.ZMTIENS,ZLOGLINK),STATUS^HLTF0(+ZMTIENS,1)
27 K HLL("LINKS"),HLSUP
28 Q
29STALL ;STOP ALL LINKS AND FILERS
30 N DIR,Y
31 W ! S DIR(0)="Y",DIR("A")="Okay to shut down all Links and Filers"
32 D ^DIR
33 I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"Shutdown Aborted!" Q
34 W !,"Shutting down all Links and Filers..."
35 D CLEAR
36 D LLP(1)
37 Q
38QUE ;Restart Filers and AUTOSTART Logical Links after system re-boot
39 N DIR,Y
40 I '$D(ZTQUEUED) D Q:'Y!($D(DIRUT))!($D(DUOUT))
41 .W ! S DIR(0)="Y",DIR("A")="Shutdown and restart ALL AUTOSTART links and filers. Okay"
42 .D ^DIR
43 .I 'Y!($D(DIRUT))!($D(DUOUT)) W !!,"RESTART Aborted!" Q
44 .W !,"Restarting all Autostart-Enabled Links and Filers..."
45 D CLEAR
46 D STARTF
47 D LLP(0)
48 D STRT
49 Q
50CLEAR ;Reset state of 869.3
51 S DA(1)=1,DA=0,DIK="^HLCS(869.3,1,2,"
52 F S DA=$O(^HLCS(869.3,DA(1),2,DA)) Q:DA<1 D ^DIK
53 S DA=0,DIK="^HLCS(869.3,1,3,"
54 F S DA=$O(^HLCS(869.3,DA(1),3,DA)) Q:DA<1 D ^DIK
55 Q
56STARTF ;Start filers
57 ;Get Defaults
58 N TMP,PTR,DEFCNT,DA,HLCNT,HLNODE1
59 S PTR=+$O(^HLCS(869.3,0)) Q:'PTR
60 ;default # of incoming filers
61 S HLNODE1=$G(^HLCS(869.3,PTR,1)),DEFCNT=+$P(HLNODE1,U) S:'DEFCNT DEFCNT=1
62 F HLCNT=1:1:DEFCNT S TMP=$$TASKFLR^HLCS1("IN")
63 ;default # of outgoing filers
64 S DEFCNT=+$P(HLNODE1,U,2) S:'DEFCNT DEFCNT=1
65 F HLCNT=1:1:DEFCNT S TMP=$$TASKFLR^HLCS1("OUT")
66 Q
67LLP(ALL) ;Stop Logical Links
68 ;ALL=1 OR 0 IF zero, only AUTOSTART LINKS get stopped
69 N HLDP,HLDP0,HLPARM0,HLPARM4,HLJ,X,Y S HLDP=0
70 F S HLDP=$O(^HLCS(870,HLDP)) Q:'HLDP S HLDP0=$G(^(HLDP,0)),X=+$P(HLDP0,U,3) D:X
71 .;skip this link if not stopping all and Autostart not enabled
72 . I 'ALL&('$P(HLDP0,U,6)) Q
73 . S HLPARM4=$G(^HLCS(870,HLDP,400))
74 . ;TCP Multi listener for non-Cache uses UCX
75 . I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
76 . ;4=status,10=Time Stopped,9=Time Started,11=Task Number,3=Device Type,14=shutdown?
77 . S X="HLJ(870,"""_HLDP_","")",@X@(4)="Halting",@X@(10)=$$NOW^XLFDT,(@X@(11),@X@(9))="@",@X@(14)=1
78 . I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)),'$P(HLDP0,U,12) S @X@(4)="Shutdown"
79 . D FILE^HLDIE("","HLJ","","LLP","HLCS2") ;HL*1.6*109
80 . ;Cache system, need to open TCP port to release job
81 . I ^%ZOSF("OS")["OpenM",($P(HLPARM4,U,3)="M"!($P(HLPARM4,U,3)="S")) D
82 .. ;pass task number to stop listener
83 .. S:$P(HLDP0,U,12) X=$$ASKSTOP^%ZTLOAD(+$P(HLDP0,U,12))
84 .. D CALL^%ZISTCP($P(HLPARM4,U),$P(HLPARM4,U,2),10)
85 .. I POP D HOME^%ZIS Q
86 .. D CLOSE^%ZISTCP
87 Q
88STRT ;Start Links
89 N HLDP,HLDP0,HLDAPP,HLTYPTR,HLBGR,HLENV,HLPARAM0,HLPARM4,HLQUIT,ZTRTN,ZTDESC,ZTSK,ZTCPU
90 S HLDP=0
91 F S HLDP=$O(^HLCS(870,HLDP)) Q:HLDP<1 S HLDP0=$G(^(HLDP,0)) D
92 . S HLPARM4=$G(^HLCS(870,HLDP,400))
93 . ;quit if no parameters or AUTOSTART is disabled
94 . Q:'$P(HLDP0,U,6)
95 . ;HLDAPP=LL name, HLTYPTR=LL type, HLBGR=routine, HLENV=environment check
96 . S HLDAPP=$P(HLDP0,U),HLTYPTR=+$P(HLDP0,U,3),HLBGR=$G(^HLCS(869.1,HLTYPTR,100)),HLENV=$G(^(200))
97 . ;quit if no LL type or no routine
98 . Q:'HLTYPTR!(HLBGR="")
99 . I HLENV'="" K HLQUIT X HLENV Q:$D(HLQUIT)
100 . ;TCP Multi listener for non-Cache uses UCX
101 . I $P(HLPARM4,U,3)="M" Q:^%ZOSF("OS")'["OpenM" Q:$$OS^%ZOSV["VMS"
102 . I $P(HLPARM4,U,3)="C"&("N"[$P(HLPARM4,U,4)) D Q
103 .. ;4=status 9=Time Started, 10=Time Stopped, 11=Task Number
104 .. ;14=Shutdown LLP, 3=Device Type, 18=Gross Errors
105 .. N HLJ,X
106 .. I $P(HLDP0,U,15)=0 Q
107 .. L +^HLCS(870,HLDP,0):2
108 .. E Q
109 .. S X="HLJ(870,"""_HLDP_","")"
110 .. S @X@(4)="Enabled",@X@(9)=$$NOW^XLFDT,@X@(14)=0
111 .. D FILE^HLDIE("","HLJ","","STRT","HLCS2") ; HL*1.6*109
112 .. L -^HLCS(870,HLDP,0)
113 .. Q
114 . S ZTRTN=$P(HLBGR," ",2),ZTIO="",ZTDTH=$H,HLTRACE=""
115 . S ZTDESC=HLDAPP_" Low Level Protocol",ZTSAVE("HLDP")=""
116 . ;get startup node
117 . I $P(HLPARM4,U,6),$D(^%ZIS(14.7,+$P(HLPARM4,U,6),0)) S ZTCPU=$P(^(0),U)
118 . D ^%ZTLOAD
119 Q
120SITEP ;Edit Site Parameters
121 S DDSFILE=869.3,DA=1,DR="[HL SITE PARAMETERS]" D ^DDS
122 Q
123PARAM() ;Return HL7 site parameters
124 ;HLPARAM=domain ien^domain name^production or test^institution ien^
125 ;institution name^institution number^mail group ien^mail group name^
126 ;purge completed messages^purge awaiting ack messages^purge all msgs^
127 ;default retention
128 N HLX,HLX4,HLX5,HLDOMP,HLDOMN,HLPROD,HLINSP,HLINSN,HLINSNM,HLMAILP,HLMAILN,HLPARAM,HLPRGAA,HLPRGALL,HLPRGCMP,HLDEFRET
129 S HLX=$G(^HLCS(869.3,1,0))
130 S HLX4=$G(^HLCS(869.3,1,4))
131 S HLX5=$G(^HLCS(869.3,1,5))
132 S HLDOMP=$P(HLX,U,2) I HLDOMP S HLDOMN=$P(^DIC(4.2,HLDOMP,0),U)
133 S HLPROD=$P(HLX,U,3)
134 S HLINSP=$P(HLX,U,4) I HLINSP S HLINSN=$P(^DIC(4,HLINSP,0),U),HLINSNM=$P($G(^DIC(4,HLINSP,99)),U)
135 S HLMAILP=$P(HLX,U,5) I HLMAILP S HLMAILN=$P(^XMB(3.8,HLMAILP,0),U)
136 S HLPRGCMP=$P(HLX4,U),HLPRGAA=$P(HLX4,U,2),HLPRGALL=$P(HLX4,U,3)
137 S HLDEFRET=$P(HLX5,U)
138 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
139 Q HLPARAM
140 ;
141GETAPP(HLAPP) ;Function to Retrieve parameters pertaining to a specific sending or receiving application
142 ;HLAPP=APPLICATION NAME OR IEN OF FILE 771
143 ;Returns MAIL GROUP NAME^'a' or 'i' (active or inactive)
144 S HLAPP=$G(HLAPP)
145 I HLAPP]"",'HLAPP S HLAPP=$O(^HL(771,"B",$E(HLAPP,1,30),0))
146 I 'HLAPP Q ""
147 I HLAPP S HLM=$P(^HL(771,HLAPP,0),U,4)
148 I HLM S HLM=$P($G(^XMB(3.8,HLM,0)),U)
149 Q $G(HLM)_U_$P(^HL(771,HLAPP,0),U,2)
Note: See TracBrowser for help on using the repository browser.