- XQ2 ;SEA/MJM - Menu lister & Utilities ; [2/20/03 7:32am]
- ;;8.0;KERNEL;**273**;Jul 10, 1995
- ;
- WRITE ;Get data for this option
- S XQSN=$P(X,U,(J*8+1)),XQNM=$P(X,U,(J*8+2)),XQTXT=$P(X,U,(J*8+3)),XQOO=$P(X,U,(J*8+4)),XQLK=$P(X,U,(J*8+5)),XQTM=$P(X,U,(J*8+6)),XQRD=$P(X,U,(J*8+7)),XQRL=$P(X,U,(J*8+8))
- Q:'$S($L(XQLK):XQUR="??"&(DUZ(0)="@"!(DUZ(0)="#")!($D(DUZ("SAV"))))!$D(^XUSEC(XQLK,DUZ)),1:1)
- Q:'$S($L(XQRL):XQUR="??"&(DUZ(0)="@"!(DUZ(0)="#")!($D(DUZ("SAV"))))!'$D(^XUSEC(XQRL,DUZ)),1:1)
- W !?3,XQSN,?10,XQTXT D MR:XQUR["??" S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- I $L(XQOO) W !,?13,"**> Out of order: ",XQOO S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- I $L(XQTM) W !,?13,"**> Not available on ",$P(X,U,(J*8+6)) S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- I XQRD="y" W !,?13,"**> Can't be run on all devices." S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- Q
- MR W " ["_XQNM_"]" I XQLK]"" W !,?13,"**> Locked with ",XQLK S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- I XQRL]"" W !,?13,"**> Reverse lock ",XQRL S XQL=XQL-1 I 'XQL D PAUSE Q:'XQL
- Q
- ;
- PAUSE R !!?15,"Press 'RETURN' to continue, '^' to stop: ",XQL:DTIME S XQL=$S(XQL[U:-1,1:XQLN) Q ;W $C(13),$J("",15),$C(13) Q
- ;
- ;
- EN ;Entry point from XQ and XQT2 with +XQDIC
- I XQUR["????" S XQUR="?"_$G(^DIC(19,XQY,"U")) D:$L(XQUR>4) OPT^XQHLP G M2^XQ
- I XQUR["???" G EN^XQHLP
- EN1 S XQLN=$S($D(IOSL):IOSL-2,1:18),XQL=XQLN,XQMMF=""
- L +^XUTL("XQO",XQDIC):5 D:$S('($D(^XUTL("XQO",XQDIC,0))#2):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET L -^XUTL("XQO",XQDIC)
- S XQK=+$G(^XUTL("XQO",XQDIC,0)) W ! F XQI=1:1:XQK Q:XQL<0 S X=^XUTL("XQO",XQDIC,0,XQI) F J=0:1 Q:XQL<0!'$L($P(X,U,(J*8+1))_$P(X,U,(J*8+2))) D WRITE
- G:XQL<0 BACK S XQJ=$S('$D(^VA(200,DUZ,200)):0,1:+$P(^(200),U,11)) G:(XQUR'="??")&'XQJ BACK
- ;
- I $S('$D(^VA(200,DUZ,203)):1,$P(^(203,0),U,4)'>0:1,1:0) G COM
- S XQDIC="U"_DUZ,XQL=XQL-3 D:XQL<1 PAUSE G:'XQL BACK W !!,"You can also select a secondary option:",!
- D:$S('($D(^XUTL("XQO",XQDIC,0))#2):1,'$D(^VA(200,DUZ,203.1)):1,1:^VA(200,DUZ,203.1)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET
- S XQK=+^XUTL("XQO",XQDIC,0) F XQI=1:1:XQK Q:XQL<0 S X=^XUTL("XQO",XQDIC,0,XQI) F J=0:1 Q:XQL<0!'$L($P(X,U,(J*8+1))_$P(X,U,(J*8+2))) D WRITE G:XQL<0 BACK
- ;
- COM S XQL=XQL-3 D:XQL<1 PAUSE G:XQL<0 B2 W !!,"Or a Common Option:",! D:XQL<1 PAUSE G:XQL<0 B2 S XQDIC=$O(^DIC(19,"B","XUCOMMAND",0)) S:XQDIC="" XQDIC=-1
- D:$S('($D(^XUTL("XQO",XQDIC,0)))#2:1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET
- S XQK=+^XUTL("XQO",XQDIC,0) F XQI=1:1:XQK Q:XQL<0 S X=^XUTL("XQO",XQDIC,0,XQI) F J=0:1 Q:XQL<0!'$L($P(X,U,(J*8+1))_$P(X,U,(J*8+2))) D WRITE
- S XQUR=0
- BACK I XQUR["?" W !!,"Enter " W:XQUR="?" "?? for more options, " W "??? for brief descriptions, ?OPTION for help text."
- B2 W ! K XQSN,XQNM,XQTXT,XQOO,XQL,XQLK,XQLN,XQTM,XQRD,XQRL,D
- S XQDIC=+^(^XUTL("XQ",$J,"T"))
- G M2^XQ
- ;
- M6 ;
- I $E(XQDIC,1)="U" D:$S('($D(^XUTL("XQO",XQDIC,0))#2):1,'$D(^VA(200,DUZ,203.1)):1,1:^VA(200,DUZ,203.1)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET
- I XQDIC=+XQDIC L +^XUTL("XQO",XQDIC):5 D:$S('($D(^XUTL("XQO",XQDIC,0))#2):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET L -^XUTL("XQO",XQDIC)
- Q
- LIST S XQK=+^XUTL("XQO",XQDIC,0),XQLN=$S($D(IOSL):IOSL-2,1:18),XQL=XQLN
- F XQI=1:1:XQK Q:XQL<0 S X=^XUTL("XQO",XQDIC,0,XQI) F J=0:1 Q:XQL<0!'$L($P(X,U,(J*8+1))_$P(X,U,(J*8+2))) D WRITE
- Q
- ;
- HS W " [Extended Help Available]" Q
- Q
- DISP ;
- S XQDIC=D0,XQUR="?." S X=^DIC(19,D0,0) I $P(X,U,4)="M" W !,"Menu: " S XQL=999 D M6,LIST W ! S X="" K D Q
- I $P(X,U,4)="A" S X="Action: "_$S($D(^DIC(19,D0,20)):^(20),1:"") W !?3,X,! Q
- I $P(X,U,4)="R" S X="Run routine: "_$S($D(^DIC(19,D0,25)):^(25),1:"") W !?3,X,! Q
- I $P(X,U,4)="E" S X="Edit file: "_$S($D(^DIC(19,D0,50)):^(50),1:"") W !?3,X,! Q
- I $P(X,U,4)="P" S X="Print file "_$S($D(^DIC(19,D0,60)):^(60),1:"") W !?3,X,! Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQ2 3915 printed Feb 18, 2025@23:31:07 Page 2
- XQ2 ;SEA/MJM - Menu lister & Utilities ; [2/20/03 7:32am]
- +1 ;;8.0;KERNEL;**273**;Jul 10, 1995
- +2 ;
- WRITE ;Get data for this option
- +1 SET XQSN=$PIECE(X,U,(J*8+1))
- SET XQNM=$PIECE(X,U,(J*8+2))
- SET XQTXT=$PIECE(X,U,(J*8+3))
- SET XQOO=$PIECE(X,U,(J*8+4))
- SET XQLK=$PIECE(X,U,(J*8+5))
- SET XQTM=$PIECE(X,U,(J*8+6))
- SET XQRD=$PIECE(X,U,(J*8+7))
- SET XQRL=$PIECE(X,U,(J*8+8))
- +2 if '$SELECT($LENGTH(XQLK)
- QUIT
- +3 if '$SELECT($LENGTH(XQRL)
- QUIT
- +4 WRITE !?3,XQSN,?10,XQTXT
- if XQUR["??"
- DO MR
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +5 IF $LENGTH(XQOO)
- WRITE !,?13,"**> Out of order: ",XQOO
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +6 IF $LENGTH(XQTM)
- WRITE !,?13,"**> Not available on ",$PIECE(X,U,(J*8+6))
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +7 IF XQRD="y"
- WRITE !,?13,"**> Can't be run on all devices."
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +8 QUIT
- MR WRITE " ["_XQNM_"]"
- IF XQLK]""
- WRITE !,?13,"**> Locked with ",XQLK
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +1 IF XQRL]""
- WRITE !,?13,"**> Reverse lock ",XQRL
- SET XQL=XQL-1
- IF 'XQL
- DO PAUSE
- if 'XQL
- QUIT
- +2 QUIT
- +3 ;
- PAUSE ;W $C(13),$J("",15),$C(13) Q
- READ !!?15,"Press 'RETURN' to continue, '^' to stop: ",XQL:DTIME
- SET XQL=$SELECT(XQL[U:-1,1:XQLN)
- QUIT
- +1 ;
- +2 ;
- EN ;Entry point from XQ and XQT2 with +XQDIC
- +1 IF XQUR["????"
- SET XQUR="?"_$GET(^DIC(19,XQY,"U"))
- if $LENGTH(XQUR>4)
- DO OPT^XQHLP
- GOTO M2^XQ
- +2 IF XQUR["???"
- GOTO EN^XQHLP
- EN1 SET XQLN=$SELECT($DATA(IOSL):IOSL-2,1:18)
- SET XQL=XQLN
- SET XQMMF=""
- +1 LOCK +^XUTL("XQO",XQDIC):5
- if $SELECT('($DATA(^XUTL("XQO",XQDIC,0))#2)
- DO ^XQSET
- LOCK -^XUTL("XQO",XQDIC)
- +2 SET XQK=+$GET(^XUTL("XQO",XQDIC,0))
- WRITE !
- FOR XQI=1:1:XQK
- if XQL<0
- QUIT
- SET X=^XUTL("XQO",XQDIC,0,XQI)
- FOR J=0:1
- if XQL<0!'$LENGTH($PIECE(X,U,(J*8+1))_$PIECE(X,U,(J*8+2)))
- QUIT
- DO WRITE
- +3 if XQL<0
- GOTO BACK
- SET XQJ=$SELECT('$DATA(^VA(200,DUZ,200)):0,1:+$PIECE(^(200),U,11))
- if (XQUR'="??")&'XQJ
- GOTO BACK
- +4 ;
- +5 IF $SELECT('$DATA(^VA(200,DUZ,203)):1,$PIECE(^(203,0),U,4)'>0:1,1:0)
- GOTO COM
- +6 SET XQDIC="U"_DUZ
- SET XQL=XQL-3
- if XQL<1
- DO PAUSE
- if 'XQL
- GOTO BACK
- WRITE !!,"You can also select a secondary option:",!
- +7 if $SELECT('($DATA(^XUTL("XQO",XQDIC,0))#2)
- DO ^XQSET
- +8 SET XQK=+^XUTL("XQO",XQDIC,0)
- FOR XQI=1:1:XQK
- if XQL<0
- QUIT
- SET X=^XUTL("XQO",XQDIC,0,XQI)
- FOR J=0:1
- if XQL<0!'$LENGTH($PIECE(X,U,(J*8+1))_$PIECE(X,U,(J*8+2)))
- QUIT
- DO WRITE
- if XQL<0
- GOTO BACK
- +9 ;
- COM SET XQL=XQL-3
- if XQL<1
- DO PAUSE
- if XQL<0
- GOTO B2
- WRITE !!,"Or a Common Option:",!
- if XQL<1
- DO PAUSE
- if XQL<0
- GOTO B2
- SET XQDIC=$ORDER(^DIC(19,"B","XUCOMMAND",0))
- if XQDIC=""
- SET XQDIC=-1
- +1 if $SELECT('($DATA(^XUTL("XQO",XQDIC,0)))#2
- DO ^XQSET
- +2 SET XQK=+^XUTL("XQO",XQDIC,0)
- FOR XQI=1:1:XQK
- if XQL<0
- QUIT
- SET X=^XUTL("XQO",XQDIC,0,XQI)
- FOR J=0:1
- if XQL<0!'$LENGTH($PIECE(X,U,(J*8+1))_$PIECE(X,U,(J*8+2)))
- QUIT
- DO WRITE
- +3 SET XQUR=0
- BACK IF XQUR["?"
- WRITE !!,"Enter "
- if XQUR="?"
- WRITE "?? for more options, "
- WRITE "??? for brief descriptions, ?OPTION for help text."
- B2 WRITE !
- KILL XQSN,XQNM,XQTXT,XQOO,XQL,XQLK,XQLN,XQTM,XQRD,XQRL,D
- +1 SET XQDIC=+^(^XUTL("XQ",$JOB,"T"))
- +2 GOTO M2^XQ
- +3 ;
- M6 ;
- +1 IF $EXTRACT(XQDIC,1)="U"
- if $SELECT('($DATA(^XUTL("XQO",XQDIC,0))#2)
- DO ^XQSET
- +2 IF XQDIC=+XQDIC
- LOCK +^XUTL("XQO",XQDIC):5
- if $SELECT('($DATA(^XUTL("XQO",XQDIC,0))#2)
- DO ^XQSET
- LOCK -^XUTL("XQO",XQDIC)
- +3 QUIT
- LIST SET XQK=+^XUTL("XQO",XQDIC,0)
- SET XQLN=$SELECT($DATA(IOSL):IOSL-2,1:18)
- SET XQL=XQLN
- +1 FOR XQI=1:1:XQK
- if XQL<0
- QUIT
- SET X=^XUTL("XQO",XQDIC,0,XQI)
- FOR J=0:1
- if XQL<0!'$LENGTH($PIECE(X,U,(J*8+1))_$PIECE(X,U,(J*8+2)))
- QUIT
- DO WRITE
- +2 QUIT
- +3 ;
- HS WRITE " [Extended Help Available]"
- QUIT
- +1 QUIT
- DISP ;
- +1 SET XQDIC=D0
- SET XQUR="?."
- SET X=^DIC(19,D0,0)
- IF $PIECE(X,U,4)="M"
- WRITE !,"Menu: "
- SET XQL=999
- DO M6
- DO LIST
- WRITE !
- SET X=""
- KILL D
- QUIT
- +2 IF $PIECE(X,U,4)="A"
- SET X="Action: "_$SELECT($DATA(^DIC(19,D0,20)):^(20),1:"")
- WRITE !?3,X,!
- QUIT
- +3 IF $PIECE(X,U,4)="R"
- SET X="Run routine: "_$SELECT($DATA(^DIC(19,D0,25)):^(25),1:"")
- WRITE !?3,X,!
- QUIT
- +4 IF $PIECE(X,U,4)="E"
- SET X="Edit file: "_$SELECT($DATA(^DIC(19,D0,50)):^(50),1:"")
- WRITE !?3,X,!
- QUIT
- +5 IF $PIECE(X,U,4)="P"
- SET X="Print file "_$SELECT($DATA(^DIC(19,D0,60)):^(60),1:"")
- WRITE !?3,X,!
- QUIT
- +6 QUIT