XQUTL ;SEA/Luke - Menu System Utilities ;04/27/98 12:36
;;8.0;KERNEL;**46**;Jul 10, 1995
;
CSYN(XQUSR) ;Collect XQUSR's menu synonyms in ^XUTL("XQ",$J,"SYN")
N %,XQSYN
S (XQI,XQSOP,%)=0
S XQSOP=$O(^VA(200,XQUSR,203,XQSOP)) Q:XQSOP="" I $L($P(^(XQSOP,0),U,2)) S X=^(0) D
.S ^XUTL("XQ",XQUSR,"SYN",$P(X,U,2))=+X_"^"_$P(^DIC(19,+X,0),U,2)
.;W !?5,$P(X,U,2),?10,^XUTL("XQ",XQUSR,"SYN",$P(X,U,2))
.Q
Q
;
;
PSYN(XQUSR) ;Print XQUSR's collected synonyms
N %
I '$D(^XUTL("XQ",XQUSR,"SYN")) D CSYN(XQUSR)
I '$D(^XUTL("XQ",XQUSR,"SYN")) W !?5,$P(^VA(200,XQUSR,0),",",2)_" "_$P(^(0),",")," has no synonyms defined.",! Q
S %="" F S %=$O(^XUTL("XQ",XQUSR,"SYN",%)) Q:%="" W !?5,%,?12,$P(^(%),U,2)
Q
;
;
KSNY ;Kill off all ^XUTL("XQ",duz,"SYN") nodes
N %
S %=0 F S %=$O(^XUTL("XQ",%)) Q:%="" K ^(%,"SYN")
Q
;
;
DISPLAY ;Display the XQUIT MESSAGE field of the Option File
I '$D(XQD) S XQD=XQY
I $D(^DIC(19,XQD,21)) D
.S XQIEN=XQD_","
.S %=$$GET1^DIQ(19,XQIEN,21,"","XQUT")
.D PRINT(.XQUT)
.K XQUT
.Q
Q
;
PRINT(XQUT) ;Print out the array XQUT()
N %,XQLN,XQNL,XQSL
;
I '$D(IOSL)#2 S IOP="HOME" D ^%ZIS
I '$D(IOSL)!('$L(IOSL)) S IOSL=20
S XQSL=IOSL-3
;
I '$D(IOM)#2 S IOP="HOME" D ^%ZIS
I '$D(IOM)!('$L(IOM)) S IOM=80
;
;Count the lines and remove the tabs
S XQNL=0
F %=0:1 S XQLINE=$O(XQUT(%)) Q:XQLINE="" D
.S XQNL=XQNL+1
.I XQUT(XQLINE)["|TAB|" D
..N T,L,X S T="|TAB|",L=XQUT(XQLINE),X=""
..F S X=$P(L,T)_" "_$P(L,T,2,99) Q:X'[T
..S XQUT(XQLINE)=X
..Q
.Q
;
RESTART ;Write the lines of text to the screen
S XQLINE=0
I $D(IOF) W @IOF
F %=1:1:XQNL Q:$D(XQEXIT) D
.S XQLINE=XQLINE+1
.S:$L(XQUT(%))>IOM XQLINE=XQLINE+1
.W !,XQUT(%) I XQLINE'<XQSL D
..D PAUSE(.XQSL)
..S XQLINE=0
..I $D(IOF) W @IOF
..Q
.Q
;
I '$D(XQEXIT) D
.I XQLINE<XQSL-1 D
..W !!,"**> END OF MESSAGE"
..D PAUSE(.XQSL)
..Q
.E D PAUSE(.XQSL)
.Q
;
I $D(XQREST) K XQEXIT,XQREST G RESTART
K XQEXIT,XQREST
Q
;
PAUSE(XQSL) ;Pause after a screen load and allow the adjustment of XQSL
N XQUR
;W !!," *****> XQSL = ",XQSL," XQLN = ",XQNL
R !!,"RETURN to continue, ""^"" to halt, ""B"" to backup, or ""?"" for more options: ",XQUR:DTIME S:'$T XQUR=U
I $E(XQUR,1)="?" S XQH=785 D EN^XQH S (XQREST,XQEXIT)=1
I XQUR]"","+-"[$E(XQUR,1) S XQSL=XQSL+XQUR S (XQREST,XQEXIT)=""
I XQUR]"","bB"[$E(XQUR,1) S (XQREST,XQEXIT)=1
I XQUR=U S XQEXIT=""
Q
;
HOLD ;Just hold the screen from moving until a RETURN is typed
N %
I $D(IOM) S %=(IOM-42)/2 S:(%'>1) %=1
E S %=1
R !!?%,"Hit the ""Enter"" or ""Return"" Key to Continue",%:DTIME
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQUTL 2676 printed Apr 09, 2024@21:11:06 Page 2
XQUTL ;SEA/Luke - Menu System Utilities ;04/27/98 12:36
+1 ;;8.0;KERNEL;**46**;Jul 10, 1995
+2 ;
CSYN(XQUSR) ;Collect XQUSR's menu synonyms in ^XUTL("XQ",$J,"SYN")
+1 NEW %,XQSYN
+2 SET (XQI,XQSOP,%)=0
+3 SET XQSOP=$ORDER(^VA(200,XQUSR,203,XQSOP))
if XQSOP=""
QUIT
IF $LENGTH($PIECE(^(XQSOP,0),U,2))
SET X=^(0)
Begin DoDot:1
+4 SET ^XUTL("XQ",XQUSR,"SYN",$PIECE(X,U,2))=+X_"^"_$PIECE(^DIC(19,+X,0),U,2)
+5 ;W !?5,$P(X,U,2),?10,^XUTL("XQ",XQUSR,"SYN",$P(X,U,2))
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
+9 ;
PSYN(XQUSR) ;Print XQUSR's collected synonyms
+1 NEW %
+2 IF '$DATA(^XUTL("XQ",XQUSR,"SYN"))
DO CSYN(XQUSR)
+3 IF '$DATA(^XUTL("XQ",XQUSR,"SYN"))
WRITE !?5,$PIECE(^VA(200,XQUSR,0),",",2)_" "_$PIECE(^(0),",")," has no synonyms defined.",!
QUIT
+4 SET %=""
FOR
SET %=$ORDER(^XUTL("XQ",XQUSR,"SYN",%))
if %=""
QUIT
WRITE !?5,%,?12,$PIECE(^(%),U,2)
+5 QUIT
+6 ;
+7 ;
KSNY ;Kill off all ^XUTL("XQ",duz,"SYN") nodes
+1 NEW %
+2 SET %=0
FOR
SET %=$ORDER(^XUTL("XQ",%))
if %=""
QUIT
KILL ^(%,"SYN")
+3 QUIT
+4 ;
+5 ;
DISPLAY ;Display the XQUIT MESSAGE field of the Option File
+1 IF '$DATA(XQD)
SET XQD=XQY
+2 IF $DATA(^DIC(19,XQD,21))
Begin DoDot:1
+3 SET XQIEN=XQD_","
+4 SET %=$$GET1^DIQ(19,XQIEN,21,"","XQUT")
+5 DO PRINT(.XQUT)
+6 KILL XQUT
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
PRINT(XQUT) ;Print out the array XQUT()
+1 NEW %,XQLN,XQNL,XQSL
+2 ;
+3 IF '$DATA(IOSL)#2
SET IOP="HOME"
DO ^%ZIS
+4 IF '$DATA(IOSL)!('$LENGTH(IOSL))
SET IOSL=20
+5 SET XQSL=IOSL-3
+6 ;
+7 IF '$DATA(IOM)#2
SET IOP="HOME"
DO ^%ZIS
+8 IF '$DATA(IOM)!('$LENGTH(IOM))
SET IOM=80
+9 ;
+10 ;Count the lines and remove the tabs
+11 SET XQNL=0
+12 FOR %=0:1
SET XQLINE=$ORDER(XQUT(%))
if XQLINE=""
QUIT
Begin DoDot:1
+13 SET XQNL=XQNL+1
+14 IF XQUT(XQLINE)["|TAB|"
Begin DoDot:2
+15 NEW T,L,X
SET T="|TAB|"
SET L=XQUT(XQLINE)
SET X=""
+16 FOR
SET X=$PIECE(L,T)_" "_$PIECE(L,T,2,99)
if X'[T
QUIT
+17 SET XQUT(XQLINE)=X
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;
RESTART ;Write the lines of text to the screen
+1 SET XQLINE=0
+2 IF $DATA(IOF)
WRITE @IOF
+3 FOR %=1:1:XQNL
if $DATA(XQEXIT)
QUIT
Begin DoDot:1
+4 SET XQLINE=XQLINE+1
+5 if $LENGTH(XQUT(%))>IOM
SET XQLINE=XQLINE+1
+6 WRITE !,XQUT(%)
IF XQLINE'<XQSL
Begin DoDot:2
+7 DO PAUSE(.XQSL)
+8 SET XQLINE=0
+9 IF $DATA(IOF)
WRITE @IOF
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;
+13 IF '$DATA(XQEXIT)
Begin DoDot:1
+14 IF XQLINE<XQSL-1
Begin DoDot:2
+15 WRITE !!,"**> END OF MESSAGE"
+16 DO PAUSE(.XQSL)
+17 QUIT
End DoDot:2
+18 IF '$TEST
DO PAUSE(.XQSL)
+19 QUIT
End DoDot:1
+20 ;
+21 IF $DATA(XQREST)
KILL XQEXIT,XQREST
GOTO RESTART
+22 KILL XQEXIT,XQREST
+23 QUIT
+24 ;
PAUSE(XQSL) ;Pause after a screen load and allow the adjustment of XQSL
+1 NEW XQUR
+2 ;W !!," *****> XQSL = ",XQSL," XQLN = ",XQNL
+3 READ !!,"RETURN to continue, ""^"" to halt, ""B"" to backup, or ""?"" for more options: ",XQUR:DTIME
if '$TEST
SET XQUR=U
+4 IF $EXTRACT(XQUR,1)="?"
SET XQH=785
DO EN^XQH
SET (XQREST,XQEXIT)=1
+5 IF XQUR]""
IF "+-"[$EXTRACT(XQUR,1)
SET XQSL=XQSL+XQUR
SET (XQREST,XQEXIT)=""
+6 IF XQUR]""
IF "bB"[$EXTRACT(XQUR,1)
SET (XQREST,XQEXIT)=1
+7 IF XQUR=U
SET XQEXIT=""
+8 QUIT
+9 ;
HOLD ;Just hold the screen from moving until a RETURN is typed
+1 NEW %
+2 IF $DATA(IOM)
SET %=(IOM-42)/2
if (%'>1)
SET %=1
+3 IF '$TEST
SET %=1
+4 READ !!?%,"Hit the ""Enter"" or ""Return"" Key to Continue",%:DTIME
+5 WRITE !
+6 QUIT
