NVSMKPRN ;emc/maw-VistA and VMS device setup utilities main menu; 04/01/04
;;Added check for SYSTEM username (9/13/2004) (MBS)
;;6.0;EMC SYSTEM UTILITIES; Jan 01, 2002
;
; -- added to NVSMENU KIDs BUILD jls 1/21/06 NOON
;
I +$G(DUZ)'>0 D
.S DUZ=.5
.S DUZ(0)="@"
.D DT^DICRW
.D HOME^%ZIS
;
I $P($ZF("GETJPI",$J,"USERNAME")," ")'="SYSTEM" D
.W !!," *** WARNING - You are not logged-in using the OpenVMS SYSTEM account. ***"
.W !," *** It is recommended that this utility be run from the SYSTEM account. ***"
.W !," *** You can select ""5"" from the menu below to quit, logout, and then ***"
.W !," *** login using the SYSTEM account. ***"
.W !!," You are currently logged-in using the "_$P($ZF("GETJPI",$J,"USERNAME")," ")_" account.",!
.S DIR(0)="EA"
.S DIR("A")="Press <enter> to continue..."
.W ! D ^DIR K DIR
;
F D Q:$D(DIRUT)
.I $G(IOF)'="" W @IOF
.W !!,$$CJ^XLFSTR(" ENTERPRISE MANAGEMENT CENTER :: VISTA AND VMS DEVICE UTILITIES ",80,"*")
.W !,$$CJ^XLFSTR("Version 6.1C -- September 2004",80)
.S DIR(0)="NAO^1:5"
.S DIR("A")="Select OPTION: "
.S DIR("A",1)=" [1] Enter/Edit VistA Device"
.S DIR("A",2)=" [2] Create a Terminal Type for TCP use"
.S DIR("A",3)=" [3] Reload VMS LAT table (^XTLATSET)"
.S DIR("A",4)=" [4] Reload VMS Outbound Telnet table (^NVSTNSET)"
.S DIR("A",5)=" [5] Quit"
.S DIR("A",6)=" "
.W ! D ^DIR K DIR
.I Y=5 S DIRUT=1
.I $D(DIRUT) Q
.S NVSMOPT=Y
.; enter/edit device...
.I NVSMOPT=1 D Q
..K NVSDEV
..D SELDEV
..I $G(NVSDEV("DA"))="" K NVSMOPT Q
..D GETDEV^NVSMKPU1(.NVSDEV)
..; LPD queue...
..I NVSDEV("VMSTYPE")="LPD" D ^NVSMKP1
..; telnet queue...
..I NVSDEV("VMSTYPE")="TNQ" D ^NVSMKP2
..; LAT device...
..I NVSDEV("VMSTYPE")="LAT" D ^NVSMKP3
..; Outbound telnet...
..I NVSDEV("VMSTYPE")="TNA" D ^NVSMKP4
..K NVSDEV,NVSMOPT
.; create subtype...
.I NVSMOPT=2 D Q
..D ^NVSMKP5
..K NVSMOPT
.; reload LAT...
.I NVSMOPT=3 D Q
..D ^XTLATSET
..K NVSMOPT
.; reload outbound telnet...
.I NVSMOPT=4 D
..S X="NVSTNSET"
..X ^%ZOSF("TEST")
..I $T=0 D Q
...W !!,"The routine ^NVSTNSET is not present in this system."
...W !,"Aborted."
...K NVSMOPT
..D ^NVSTNSET
..K NVSMOPT
;
K DIRUT,DTOUT,NVSDNS,NVSHOST,X,Y
Q
;
SELDEV ; select add new or edit existing device...
N DIR,DIRUT,NVSXDEV,X,Y
S DIR(0)="SA^A:ADD;E:EDIT"
S DIR("A")="Do you wish to [A]DD a new or [E]DIT an existing device? "
S DIR("?")="Enter 'A' to add a new or 'E' to edit an existing device"
W ! D ^DIR K DIR
I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
S NVSXDEV=Y
; add new device...
I NVSXDEV="A" D I $D(DIRUT) K DIRUT,DTOUT,NVSXDEV,X,Y Q
.S DIR(0)="FAO^1:30^"_$P($G(^DD(3.5,.01,0)),"^",5)
.S DIR("A")="NEW DEVICE'S NAME: "
.W ! D ^DIR K DIR
.I $D(DIRUT) Q
.S NVSDEV("DA")="NEW"
.S NVSDEV("NAME")=Y
.I $D(^%ZIS(1,"B",NVSDEV("NAME"))) D Q
..W $C(7)
..W !,"A device by that name already exists. See record number "
..W +$O(^%ZIS(1,"B",NVSDEV("NAME"),0))
..R X:2
..K NVSDEV
..S DIRUT=1
.; get VMS type...
.S NVSDEV("VMSTYPE")="?"
.D VMSTYPE(.NVSDEV)
.I NVSDEV("VMSTYPE")="?" K NVSDEV
; edit existing device...
I NVSXDEV="E" D
.K NVSDEV
.S DIC=3.5
.S DIC(0)="QEAMZ"
.W ! D ^DIC K DIC
.I +Y'>0 Q
.S NVSDEV("DA")=+Y
.S NVSDEV("$I")=$P(Y(0),"^",2)
.S NVSDEV("NAME")=Y(0,0)
.I NVSDEV("$I")["_LTA" S NVSDEV("VMSTYPE")="LAT"
.I NVSDEV("$I")["_TNA" S NVSDEV("VMSTYPE")="TNA"
.I NVSDEV("$I")["$:" D
..I $G(^%ZIS(1,NVSDEV("DA"),"VMS"))="" S NVSDEV("VMSTYPE")="?" Q
..I $P(^%ZIS(1,NVSDEV("DA"),"VMS"),"^",6)="" S NVSDEV("VMSTYPE")="LPD" Q
..S NVSDEV("VMSTYPE")="TNQ"
.I $G(NVSDEV("VMSTYPE"))="" S NVSDEV("VMSTYPE")="?"
.W !!,"This device's $I value is: ",NVSDEV("$I")
.W !,"Based on this, it looks like this device's VMS device type is currently"
.W !,$S(NVSDEV("VMSTYPE")="LAT":"a LAT device.",NVSDEV("VMSTYPE")="LPD":"an LPD queue.",NVSDEV("VMSTYPE")="TNQ":"a telnet queue.",NVSDEV("VMSTYPE")="TNA":"outbound telnet.",1:"unknown!")
.W !!,"At this point, you can change the VistA device to another VMS"
.W !,"device type, or simply edit the data for the existing VMS device"
.W !,"type."
.I NVSDEV("VMSTYPE")'="?" W " Please change or verify VMS device type."
.I NVSDEV("VMSTYPE")="?" D
..W !,"WARNING: I was unable to determine the device's current VMS"
..W !,"device type. You MUST specify a type in order to continue."
.D VMSTYPE(.NVSDEV)
.I NVSDEV("VMSTYPE")="?" K NVSDEV
K NVSXDEV
Q
;
VMSTYPE(DEVDATA) ; select a VMS device type...
; DEVDATA = an array passed by reference containing device data
; returns DEVDATA("VMSTYPE")=a selected VMS device type or "" if none selected
N DIR,DIRUT,DTOUT,X,Y
S DIR(0)="NA^1:4"
S DIR("A")="Select VMS DEVICE TYPE (1-4): "
S DIR("A",1)=" 1 = LAT device"
S DIR("A",2)=" 2 = LPD queue (LPD)"
S DIR("A",3)=" 3 = Telnet queue (TNQ)"
S DIR("A",4)=" 4 = Outbound telnet (TNA)"
S DIR("A",5)=""
I $G(DEVDATA("VMSTYPE"))'="?" S DIR("B")=$S(DEVDATA("VMSTYPE")="LAT":1,DEVDATA("VMSTYPE")="LPD":2,DEVDATA("VMSTYPE")="TNQ":3,1:4)
S DIR("?")="Select (by number) what type of VMS device this new VistA device will be"
W ! D ^DIR K DIR
I $D(DIRUT) S DEVDATA("VMSTYPE")="?" Q
S DEVDATA("VMSTYPE")=$S(Y=1:"LAT",Y=2:"LPD",Y=3:"TNQ",1:"TNA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNVSMKPRN 5394 printed Sep 23, 2025@19:53:59 Page 2
NVSMKPRN ;emc/maw-VistA and VMS device setup utilities main menu; 04/01/04
+1 ;;Added check for SYSTEM username (9/13/2004) (MBS)
+2 ;;6.0;EMC SYSTEM UTILITIES; Jan 01, 2002
+3 ;
+4 ; -- added to NVSMENU KIDs BUILD jls 1/21/06 NOON
+5 ;
+6 IF +$GET(DUZ)'>0
Begin DoDot:1
+7 SET DUZ=.5
+8 SET DUZ(0)="@"
+9 DO DT^DICRW
+10 DO HOME^%ZIS
End DoDot:1
+11 ;
+12 IF $PIECE($ZF("GETJPI",$JOB,"USERNAME")," ")'="SYSTEM"
Begin DoDot:1
+13 WRITE !!," *** WARNING - You are not logged-in using the OpenVMS SYSTEM account. ***"
+14 WRITE !," *** It is recommended that this utility be run from the SYSTEM account. ***"
+15 WRITE !," *** You can select ""5"" from the menu below to quit, logout, and then ***"
+16 WRITE !," *** login using the SYSTEM account. ***"
+17 WRITE !!," You are currently logged-in using the "_$PIECE($ZF("GETJPI",$JOB,"USERNAME")," ")_" account.",!
+18 SET DIR(0)="EA"
+19 SET DIR("A")="Press <enter> to continue..."
+20 WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+21 ;
+22 FOR
Begin DoDot:1
+23 IF $GET(IOF)'=""
WRITE @IOF
+24 WRITE !!,$$CJ^XLFSTR(" ENTERPRISE MANAGEMENT CENTER :: VISTA AND VMS DEVICE UTILITIES ",80,"*")
+25 WRITE !,$$CJ^XLFSTR("Version 6.1C -- September 2004",80)
+26 SET DIR(0)="NAO^1:5"
+27 SET DIR("A")="Select OPTION: "
+28 SET DIR("A",1)=" [1] Enter/Edit VistA Device"
+29 SET DIR("A",2)=" [2] Create a Terminal Type for TCP use"
+30 SET DIR("A",3)=" [3] Reload VMS LAT table (^XTLATSET)"
+31 SET DIR("A",4)=" [4] Reload VMS Outbound Telnet table (^NVSTNSET)"
+32 SET DIR("A",5)=" [5] Quit"
+33 SET DIR("A",6)=" "
+34 WRITE !
DO ^DIR
KILL DIR
+35 IF Y=5
SET DIRUT=1
+36 IF $DATA(DIRUT)
QUIT
+37 SET NVSMOPT=Y
+38 ; enter/edit device...
+39 IF NVSMOPT=1
Begin DoDot:2
+40 KILL NVSDEV
+41 DO SELDEV
+42 IF $GET(NVSDEV("DA"))=""
KILL NVSMOPT
QUIT
+43 DO GETDEV^NVSMKPU1(.NVSDEV)
+44 ; LPD queue...
+45 IF NVSDEV("VMSTYPE")="LPD"
DO ^NVSMKP1
+46 ; telnet queue...
+47 IF NVSDEV("VMSTYPE")="TNQ"
DO ^NVSMKP2
+48 ; LAT device...
+49 IF NVSDEV("VMSTYPE")="LAT"
DO ^NVSMKP3
+50 ; Outbound telnet...
+51 IF NVSDEV("VMSTYPE")="TNA"
DO ^NVSMKP4
+52 KILL NVSDEV,NVSMOPT
End DoDot:2
QUIT
+53 ; create subtype...
+54 IF NVSMOPT=2
Begin DoDot:2
+55 DO ^NVSMKP5
+56 KILL NVSMOPT
End DoDot:2
QUIT
+57 ; reload LAT...
+58 IF NVSMOPT=3
Begin DoDot:2
+59 DO ^XTLATSET
+60 KILL NVSMOPT
End DoDot:2
QUIT
+61 ; reload outbound telnet...
+62 IF NVSMOPT=4
Begin DoDot:2
+63 SET X="NVSTNSET"
+64 XECUTE ^%ZOSF("TEST")
+65 IF $TEST=0
Begin DoDot:3
+66 WRITE !!,"The routine ^NVSTNSET is not present in this system."
+67 WRITE !,"Aborted."
+68 KILL NVSMOPT
End DoDot:3
QUIT
+69 DO ^NVSTNSET
+70 KILL NVSMOPT
End DoDot:2
End DoDot:1
if $DATA(DIRUT)
QUIT
+71 ;
+72 KILL DIRUT,DTOUT,NVSDNS,NVSHOST,X,Y
+73 QUIT
+74 ;
SELDEV ; select add new or edit existing device...
+1 NEW DIR,DIRUT,NVSXDEV,X,Y
+2 SET DIR(0)="SA^A:ADD;E:EDIT"
+3 SET DIR("A")="Do you wish to [A]DD a new or [E]DIT an existing device? "
+4 SET DIR("?")="Enter 'A' to add a new or 'E' to edit an existing device"
+5 WRITE !
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
KILL DIRUT,DTOUT,X,Y
QUIT
+7 SET NVSXDEV=Y
+8 ; add new device...
+9 IF NVSXDEV="A"
Begin DoDot:1
+10 SET DIR(0)="FAO^1:30^"_$PIECE($GET(^DD(3.5,.01,0)),"^",5)
+11 SET DIR("A")="NEW DEVICE'S NAME: "
+12 WRITE !
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
QUIT
+14 SET NVSDEV("DA")="NEW"
+15 SET NVSDEV("NAME")=Y
+16 IF $DATA(^%ZIS(1,"B",NVSDEV("NAME")))
Begin DoDot:2
+17 WRITE $CHAR(7)
+18 WRITE !,"A device by that name already exists. See record number "
+19 WRITE +$ORDER(^%ZIS(1,"B",NVSDEV("NAME"),0))
+20 READ X:2
+21 KILL NVSDEV
+22 SET DIRUT=1
End DoDot:2
QUIT
+23 ; get VMS type...
+24 SET NVSDEV("VMSTYPE")="?"
+25 DO VMSTYPE(.NVSDEV)
+26 IF NVSDEV("VMSTYPE")="?"
KILL NVSDEV
End DoDot:1
IF $DATA(DIRUT)
KILL DIRUT,DTOUT,NVSXDEV,X,Y
QUIT
+27 ; edit existing device...
+28 IF NVSXDEV="E"
Begin DoDot:1
+29 KILL NVSDEV
+30 SET DIC=3.5
+31 SET DIC(0)="QEAMZ"
+32 WRITE !
DO ^DIC
KILL DIC
+33 IF +Y'>0
QUIT
+34 SET NVSDEV("DA")=+Y
+35 SET NVSDEV("$I")=$PIECE(Y(0),"^",2)
+36 SET NVSDEV("NAME")=Y(0,0)
+37 IF NVSDEV("$I")["_LTA"
SET NVSDEV("VMSTYPE")="LAT"
+38 IF NVSDEV("$I")["_TNA"
SET NVSDEV("VMSTYPE")="TNA"
+39 IF NVSDEV("$I")["$:"
Begin DoDot:2
+40 IF $GET(^%ZIS(1,NVSDEV("DA"),"VMS"))=""
SET NVSDEV("VMSTYPE")="?"
QUIT
+41 IF $PIECE(^%ZIS(1,NVSDEV("DA"),"VMS"),"^",6)=""
SET NVSDEV("VMSTYPE")="LPD"
QUIT
+42 SET NVSDEV("VMSTYPE")="TNQ"
End DoDot:2
+43 IF $GET(NVSDEV("VMSTYPE"))=""
SET NVSDEV("VMSTYPE")="?"
+44 WRITE !!,"This device's $I value is: ",NVSDEV("$I")
+45 WRITE !,"Based on this, it looks like this device's VMS device type is currently"
+46 WRITE !,$SELECT(NVSDEV("VMSTYPE")="LAT":"a LAT device.",NVSDEV("VMSTYPE")="LPD":"an LPD queue.",NVSDEV("VMSTYPE")="TNQ":"a telnet queue.",NVSDEV("VMSTYPE")="TNA":"outbound telnet.",1:"unknown!")
+47 WRITE !!,"At this point, you can change the VistA device to another VMS"
+48 WRITE !,"device type, or simply edit the data for the existing VMS device"
+49 WRITE !,"type."
+50 IF NVSDEV("VMSTYPE")'="?"
WRITE " Please change or verify VMS device type."
+51 IF NVSDEV("VMSTYPE")="?"
Begin DoDot:2
+52 WRITE !,"WARNING: I was unable to determine the device's current VMS"
+53 WRITE !,"device type. You MUST specify a type in order to continue."
End DoDot:2
+54 DO VMSTYPE(.NVSDEV)
+55 IF NVSDEV("VMSTYPE")="?"
KILL NVSDEV
End DoDot:1
+56 KILL NVSXDEV
+57 QUIT
+58 ;
VMSTYPE(DEVDATA) ; select a VMS device type...
+1 ; DEVDATA = an array passed by reference containing device data
+2 ; returns DEVDATA("VMSTYPE")=a selected VMS device type or "" if none selected
+3 NEW DIR,DIRUT,DTOUT,X,Y
+4 SET DIR(0)="NA^1:4"
+5 SET DIR("A")="Select VMS DEVICE TYPE (1-4): "
+6 SET DIR("A",1)=" 1 = LAT device"
+7 SET DIR("A",2)=" 2 = LPD queue (LPD)"
+8 SET DIR("A",3)=" 3 = Telnet queue (TNQ)"
+9 SET DIR("A",4)=" 4 = Outbound telnet (TNA)"
+10 SET DIR("A",5)=""
+11 IF $GET(DEVDATA("VMSTYPE"))'="?"
SET DIR("B")=$SELECT(DEVDATA("VMSTYPE")="LAT":1,DEVDATA("VMSTYPE")="LPD":2,DEVDATA("VMSTYPE")="TNQ":3,1:4)
+12 SET DIR("?")="Select (by number) what type of VMS device this new VistA device will be"
+13 WRITE !
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
SET DEVDATA("VMSTYPE")="?"
QUIT
+15 SET DEVDATA("VMSTYPE")=$SELECT(Y=1:"LAT",Y=2:"LPD",Y=3:"TNQ",1:"TNA")
+16 QUIT
