| 1 | HLCSTCPA ;OIFO-O/RJH - (TCP/IP) VMS ;07/26/2007  10:29 | 
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**84,122**;Oct 13, 1995;Build 14 | 
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | ; 1. port number is input from VMS COM file, such as HLSxxxxDSM.COM, | 
|---|
| 6 | ;    HLSxxxxCACHE.COM, or HLSxxxxGTM.COM file, where xxxx is port | 
|---|
| 7 | ;    number. | 
|---|
| 8 | ; 2. find the ien of #870(logical link file) for the multi-listener | 
|---|
| 9 | Q | 
|---|
| 10 | ; | 
|---|
| 11 | GTMPORT(%) ; From tcpip ZFOO for GT.M | 
|---|
| 12 | ; %: device^port number | 
|---|
| 13 | N HLPORT | 
|---|
| 14 | S HLPORT=$P($G(%),"^",2) | 
|---|
| 15 | I $G(^%ZOSF("OS"))'["GT.M" D ^%ZTER Q | 
|---|
| 16 | D IEN | 
|---|
| 17 | Q | 
|---|
| 18 | ; | 
|---|
| 19 | PORT ; | 
|---|
| 20 | ; HLPORT: port number of multi-listener | 
|---|
| 21 | ; input of DSM: % = device^port number of multi-listener | 
|---|
| 22 | ; input of Cache: port number of TCPIP | 
|---|
| 23 | ; | 
|---|
| 24 | N HLPORT | 
|---|
| 25 | S HLPORT=0 | 
|---|
| 26 | I ^%ZOSF("OS")["OpenM" D | 
|---|
| 27 | . S HLPORT=$ZF("GETSYM","PORT") | 
|---|
| 28 | I ^%ZOSF("OS")["DSM" D | 
|---|
| 29 | . S HLPORT=$P(%,"^",2) | 
|---|
| 30 | ; | 
|---|
| 31 | IEN ; | 
|---|
| 32 | ; HLIEN870: ien in #870 (logical link file) | 
|---|
| 33 | ; HLPRTS: port number in entry to be tested | 
|---|
| 34 | ; | 
|---|
| 35 | N HLIEN870 | 
|---|
| 36 | I 'HLPORT D ^%ZTER Q | 
|---|
| 37 | S HLIEN870=0 | 
|---|
| 38 | F  S HLIEN870=$O(^HLCS(870,"E","M",HLIEN870)) Q:'HLIEN870  D  Q:(HLPRTS=HLPORT) | 
|---|
| 39 | . S HLPRTS=$P(^HLCS(870,HLIEN870,400),"^",2) | 
|---|
| 40 | I 'HLIEN870 D ^%ZTER Q | 
|---|
| 41 | ; | 
|---|
| 42 | K HLPORT,HLPRTS | 
|---|
| 43 | ; patch 122 | 
|---|
| 44 | S U="^" | 
|---|
| 45 | ; | 
|---|
| 46 | ;for Cache/VMS | 
|---|
| 47 | I ^%ZOSF("OS")["OpenM" D  Q | 
|---|
| 48 | . D CACHEVMS(HLIEN870) | 
|---|
| 49 | ; | 
|---|
| 50 | ;for DSM | 
|---|
| 51 | I ^%ZOSF("OS")["DSM" D  Q | 
|---|
| 52 | . S $P(%,"^",2)=HLIEN870   ;set % = device^ien of #870 | 
|---|
| 53 | . K HLIEN870 | 
|---|
| 54 | . D EN | 
|---|
| 55 | ; | 
|---|
| 56 | ;for GT.M | 
|---|
| 57 | I ^%ZOSF("OS")["GT.M" D  Q | 
|---|
| 58 | . S HLDP=HLIEN870   ;set HLDP = ien of #870 | 
|---|
| 59 | . K HLIEN870 | 
|---|
| 60 | . D GTMUCX | 
|---|
| 61 | ; | 
|---|
| 62 | D ^%ZTER | 
|---|
| 63 | Q | 
|---|
| 64 | GTMUCX ; GT.M /VMS tcpip | 
|---|
| 65 | ;listener,  % = device^port | 
|---|
| 66 | S U="^",IO=$P(%,U) | 
|---|
| 67 | ; S IO(0)=$P O IO(0) ;Setup null device | 
|---|
| 68 | ; GTM specific code | 
|---|
| 69 | S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""") | 
|---|
| 70 | X "O IO:(RECORDSIZE=512)" | 
|---|
| 71 | D LISTEN^HLCSTCP | 
|---|
| 72 | C IO | 
|---|
| 73 | Q | 
|---|
| 74 | ; | 
|---|
| 75 | ; $ x=f$trnlnm("sys$net")  !This is our MBX device | 
|---|
| 76 | ; $! | 
|---|
| 77 | ; $! for GT.M | 
|---|
| 78 | ; $ assign 'f$trnlnm("SYS$NET")' SYS$NET | 
|---|
| 79 | ; $! Depending on how your command files are set up, you may need to | 
|---|
| 80 | ; $! run the GT.M profile file. | 
|---|
| 81 | ; $ @<user$:[gtmmgr]>gtmprofile.com | 
|---|
| 82 | ; $ forfoo="$" + f$parse("user$:[gtmmgr.r]ZFOO.exe") | 
|---|
| 83 | ; $ PORT=5000 | 
|---|
| 84 | ; $ data="''x'^''PORT'" | 
|---|
| 85 | ; $ forfoo GTMPORT^HLCSTCPA("''data'") | 
|---|
| 86 | ; | 
|---|
| 87 | CACHEVMS(%) ;Cache'/VMS tcpip | 
|---|
| 88 | ;listener,  % = HLDP | 
|---|
| 89 | I $G(%)="" D ^%ZTER Q | 
|---|
| 90 | ; patch 133 | 
|---|
| 91 | S IO="SYS$NET",U="^",HLDP=% | 
|---|
| 92 | S IO(0)="_NLA0:" O IO(0) ;Setup null device | 
|---|
| 93 | ; **Cache'/VMS specific code** | 
|---|
| 94 | O IO::5 E  D MON^HLCSTCP("Openfail") Q | 
|---|
| 95 | X "U IO:(::""-M"")" ;Packet mode like DSM | 
|---|
| 96 | D LISTEN^HLCSTCP | 
|---|
| 97 | C IO | 
|---|
| 98 | Q | 
|---|
| 99 | ; | 
|---|
| 100 | EN ; DSM/VMS tcpip | 
|---|
| 101 | ;listener,  % = device^HLDP | 
|---|
| 102 | I $G(%)="" D ^%ZTER Q | 
|---|
| 103 | ; patch 122 | 
|---|
| 104 | ; S IO="SYS$NET",U="^",HLDP=$P(%,U,2) | 
|---|
| 105 | S U="^",IO=$P(%,U),HLDP=$P(%,U,2) | 
|---|
| 106 | ; patch 133 | 
|---|
| 107 | S IO(0)="_NLA0:" O IO(0) ;Setup null device | 
|---|
| 108 | ; **VMS specific code, need to share device** | 
|---|
| 109 | O IO:(TCPDEV):60 E  D MON^HLCSTCP("Openfail") Q | 
|---|
| 110 | ; patch 122 | 
|---|
| 111 | D LISTEN^HLCSTCP | 
|---|
| 112 | C IO | 
|---|
| 113 | Q | 
|---|