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