XMJDIR ;ISC-SF/GMB- MailMan's DIR ;10/31/2001 12:33
;;8.0;MailMan;;Jun 28, 2002
XMDIR(XMDIR,XMOPT,XMOX,XMY,XMABORT) ;
; XMDIR("A") User prompt
; XMDIR("B") Default choice
; XMDIR(0) Special instructions
; S - Show the choices
; C - Show choices in 2 columns, if necessary
; XMDIR("?") Help text for 1 ?
; XMDIR("??") Help text for 2 or more ?
N XMX
K XMY
I +XMDIR("A")=XMDIR("A") S XMDIR("A")=$$EZBLD^DIALOG(XMDIR("A"))
I $D(XMDIR("B")),+XMDIR("B")=XMDIR("B") S XMDIR("B")=$$EZBLD^DIALOG(XMDIR("B"))
I $G(XMDIR(0))["S" D
. W !!,?5,$$EZBLD^DIALOG(37008),! ; Select one of the following:
. D HELPCMD(.XMOPT,.XMOX,$S(XMDIR(0)["C":IOSL-$Y-3,1:IOSL-4))
F D Q:$D(XMY)!XMABORT
. W !!,XMDIR("A"),$S($D(XMDIR("B")):$P(XMDIR("B"),":",2,99)_"// ",1:"")
. R XMX:DTIME I '$T S XMABORT=DTIME Q
. I XMX[U S XMABORT=1 Q
. I XMX="" D Q
. . I '$D(XMDIR("B")) S XMABORT=1 Q
. . S XMY=$P(XMDIR("B"),":",1)
. I $E(XMX)="?" D QHELP Q
. I $D(XMDIR("PRE")) X XMDIR("PRE")
. S XMY=$$COMMAND(.XMOPT,.XMOX,XMX)
. I $D(XMOPT(XMY)),'$D(XMOPT(XMY,"?")) Q
. I XMY=-1 D
. . W $C(7) D HELPSCR(.XMOPT,.XMOX)
. E D SHOWERR(.XMOPT,XMY) I $D(XMOPT(XMY,"?X")) X XMOPT(XMY,"?X") I $T Q
. K XMY
Q
SHOWERR(XMOPT,XMY) ; Show error message
W $C(7),!
I +XMOPT(XMY,"?")=XMOPT(XMY,"?") D Q
. N XMTEXT
. D BLD^DIALOG(XMOPT(XMY,"?"),"","","XMTEXT","F")
. D MSG^DIALOG("WE","",IOM,"","XMTEXT")
I $D(XMOPT(XMY,"?",1)) D
. N I
. S I=0
. F S I=$O(XMOPT(XMY,"?",I)) Q:'I W !,XMOPT(XMY,"?",I)
W !,XMOPT(XMY,"?")
Q
QHELP ;
I XMX="?" D HELPSCR(.XMOPT,.XMOX) Q
N XQH
S XQH=$G(XMDIR("??"),"XM-U-MO-READ")
I "@"[XQH D HELPSCR(.XMOPT,.XMOX) Q
I $E(XQH,1,2)="D " X XQH Q
D EN^XQH
Q
HELPSCR(XMOPT,XMOX) ;
I $D(XMDIR("?")) D
. N XMTEXT
. W !
. D BLD^DIALOG(XMDIR("?"),"","","XMTEXT","F")
. D MSG^DIALOG("WH","",IOM,"","XMTEXT")
W !!,$$EZBLD^DIALOG(34054),! ; Enter a code from the list.
D HELPCMD(.XMOPT,.XMOX)
Q
HELPCMD(XMOPT,XMOX,XMPMAX) ;
N XMCNT,XMCMD,XMROWS,I,XMHELP,XMLEN
S (XMCNT,XMLEN)=0,XMCMD=""
F S XMCMD=$O(XMOPT(XMCMD)) Q:XMCMD="" I '$D(XMOPT(XMCMD,"?")) S XMCNT=XMCNT+1 I $L(XMOX("O",XMCMD))>XMLEN S XMLEN=$L(XMOX("O",XMCMD))
I XMCNT<$G(XMPMAX,IOSL-4) D Q
. F S XMCMD=$O(XMOX("X",XMCMD)) Q:XMCMD="" D
. . Q:$D(XMOPT(XMOX("X",XMCMD),"?"))
. . W !,?9,$E(XMCMD_" ",1,10)_XMOPT(XMOX("X",XMCMD))
S XMROWS=XMCNT+1\2
S I=0
F D Q:I=XMROWS
. S XMCMD=$O(XMOX("X",XMCMD))
. Q:$D(XMOPT(XMOX("X",XMCMD),"?"))
. S I=I+1
. S XMHELP(I)=" "_$E(XMCMD_" ",1,XMLEN+2)_XMOPT(XMOX("X",XMCMD))
S I=0
F S XMCMD=$O(XMOX("X",XMCMD)) Q:XMCMD="" D
. Q:$D(XMOPT(XMOX("X",XMCMD),"?"))
. S I=I+1
. W !,$E(XMHELP(I)_" ",1,39)_" "_$E(XMCMD_" ",1,XMLEN+2)_$E(XMOPT(XMOX("X",XMCMD)),1,37-XMLEN)
S I=I+1
W:$D(XMHELP(I)) !,XMHELP(I)
Q
COMMAND(XMOPT,XMOX,XMY) ; Check what the user enters against the list of
; acceptable choices. If the user enters something ambiguous,
; ^DIR is called to ask the user to choose one.
I XMY?.E1C.E Q -1
I $L(XMY)>64 Q -1
N XMX,XMCD,XMLEN
S XMX=XMY
S XMLEN=$L(XMX)
S XMY=$$UP^XLFSTR(XMY)
I $D(XMOX("X",XMY)) D Q XMCD
. S XMCD=XMOX("X",XMY)
. D PARROT
N XMTXT,XMC,XMT,XMCHOOSE
S XMCD=""
F S XMCD=$O(XMOPT(XMCD)) Q:XMCD="" S:'$D(XMOPT(XMCD,"?")) XMTXT(XMOPT(XMCD))=XMCD
S XMT=$CHAR($A($E(XMY))-1)_"~"
F S XMT=$O(XMTXT(XMT)) Q:XMT=""!($E(XMT)'=$E(XMY)) I $$UP^XLFSTR($E(XMT,1,XMLEN))=XMY S XMCHOOSE(XMT)=""
S XMC=$CHAR($A($E(XMY))-1)_"~"
F S XMC=$O(XMOX("X",XMC)) Q:XMC=""!($E(XMC)'=$E(XMY)) I $$UP^XLFSTR($E(XMC,1,XMLEN))=XMY S:'$D(XMOPT(XMOX("X",XMC),"?")) XMCHOOSE(XMOPT(XMOX("X",XMC)))=""
I '$D(XMCHOOSE) Q -1
N I,DIR,Y,X
S I=0,(DIR(0),XMT)=""
F S XMT=$O(XMCHOOSE(XMT)) Q:XMT="" S I=I+1,DIR(0)=DIR(0)_I_":"_XMT_";",XMCD(I)=XMTXT(XMT)
I I=1 D Q $P(XMCD," ") ; (for Q xxx)
. S XMCD=XMCD(I)
. D PARROT
S DIR(0)="SO^"_$E(DIR(0),1,$L(DIR(0))-1)
;S DIR("A")="Choose 1-"_I
D ^DIR Q:$D(DIRUT) -1
Q $P(XMCD(Y)," ") ; (for Q xxx)
PARROT ;
I $E(XMOPT(XMCD),1,XMLEN)=XMX W $E(XMOPT(XMCD),XMLEN+1,99) Q
W " ",XMOPT(XMCD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJDIR 4207 printed Jun 11, 2024@21:59:45 Page 2
XMJDIR ;ISC-SF/GMB- MailMan's DIR ;10/31/2001 12:33
+1 ;;8.0;MailMan;;Jun 28, 2002
XMDIR(XMDIR,XMOPT,XMOX,XMY,XMABORT) ;
+1 ; XMDIR("A") User prompt
+2 ; XMDIR("B") Default choice
+3 ; XMDIR(0) Special instructions
+4 ; S - Show the choices
+5 ; C - Show choices in 2 columns, if necessary
+6 ; XMDIR("?") Help text for 1 ?
+7 ; XMDIR("??") Help text for 2 or more ?
+8 NEW XMX
+9 KILL XMY
+10 IF +XMDIR("A")=XMDIR("A")
SET XMDIR("A")=$$EZBLD^DIALOG(XMDIR("A"))
+11 IF $DATA(XMDIR("B"))
IF +XMDIR("B")=XMDIR("B")
SET XMDIR("B")=$$EZBLD^DIALOG(XMDIR("B"))
+12 IF $GET(XMDIR(0))["S"
Begin DoDot:1
+13 ; Select one of the following:
WRITE !!,?5,$$EZBLD^DIALOG(37008),!
+14 DO HELPCMD(.XMOPT,.XMOX,$SELECT(XMDIR(0)["C":IOSL-$Y-3,1:IOSL-4))
End DoDot:1
+15 FOR
Begin DoDot:1
+16 WRITE !!,XMDIR("A"),$SELECT($DATA(XMDIR("B")):$PIECE(XMDIR("B"),":",2,99)_"// ",1:"")
+17 READ XMX:DTIME
IF '$TEST
SET XMABORT=DTIME
QUIT
+18 IF XMX[U
SET XMABORT=1
QUIT
+19 IF XMX=""
Begin DoDot:2
+20 IF '$DATA(XMDIR("B"))
SET XMABORT=1
QUIT
+21 SET XMY=$PIECE(XMDIR("B"),":",1)
End DoDot:2
QUIT
+22 IF $EXTRACT(XMX)="?"
DO QHELP
QUIT
+23 IF $DATA(XMDIR("PRE"))
XECUTE XMDIR("PRE")
+24 SET XMY=$$COMMAND(.XMOPT,.XMOX,XMX)
+25 IF $DATA(XMOPT(XMY))
IF '$DATA(XMOPT(XMY,"?"))
QUIT
+26 IF XMY=-1
Begin DoDot:2
+27 WRITE $CHAR(7)
DO HELPSCR(.XMOPT,.XMOX)
End DoDot:2
+28 IF '$TEST
DO SHOWERR(.XMOPT,XMY)
IF $DATA(XMOPT(XMY,"?X"))
XECUTE XMOPT(XMY,"?X")
IF $TEST
QUIT
+29 KILL XMY
End DoDot:1
if $DATA(XMY)!XMABORT
QUIT
+30 QUIT
SHOWERR(XMOPT,XMY) ; Show error message
+1 WRITE $CHAR(7),!
+2 IF +XMOPT(XMY,"?")=XMOPT(XMY,"?")
Begin DoDot:1
+3 NEW XMTEXT
+4 DO BLD^DIALOG(XMOPT(XMY,"?"),"","","XMTEXT","F")
+5 DO MSG^DIALOG("WE","",IOM,"","XMTEXT")
End DoDot:1
QUIT
+6 IF $DATA(XMOPT(XMY,"?",1))
Begin DoDot:1
+7 NEW I
+8 SET I=0
+9 FOR
SET I=$ORDER(XMOPT(XMY,"?",I))
if 'I
QUIT
WRITE !,XMOPT(XMY,"?",I)
End DoDot:1
+10 WRITE !,XMOPT(XMY,"?")
+11 QUIT
QHELP ;
+1 IF XMX="?"
DO HELPSCR(.XMOPT,.XMOX)
QUIT
+2 NEW XQH
+3 SET XQH=$GET(XMDIR("??"),"XM-U-MO-READ")
+4 IF "@"[XQH
DO HELPSCR(.XMOPT,.XMOX)
QUIT
+5 IF $EXTRACT(XQH,1,2)="D "
XECUTE XQH
QUIT
+6 DO EN^XQH
+7 QUIT
HELPSCR(XMOPT,XMOX) ;
+1 IF $DATA(XMDIR("?"))
Begin DoDot:1
+2 NEW XMTEXT
+3 WRITE !
+4 DO BLD^DIALOG(XMDIR("?"),"","","XMTEXT","F")
+5 DO MSG^DIALOG("WH","",IOM,"","XMTEXT")
End DoDot:1
+6 ; Enter a code from the list.
WRITE !!,$$EZBLD^DIALOG(34054),!
+7 DO HELPCMD(.XMOPT,.XMOX)
+8 QUIT
HELPCMD(XMOPT,XMOX,XMPMAX) ;
+1 NEW XMCNT,XMCMD,XMROWS,I,XMHELP,XMLEN
+2 SET (XMCNT,XMLEN)=0
SET XMCMD=""
+3 FOR
SET XMCMD=$ORDER(XMOPT(XMCMD))
if XMCMD=""
QUIT
IF '$DATA(XMOPT(XMCMD,"?"))
SET XMCNT=XMCNT+1
IF $LENGTH(XMOX("O",XMCMD))>XMLEN
SET XMLEN=$LENGTH(XMOX("O",XMCMD))
+4 IF XMCNT<$GET(XMPMAX,IOSL-4)
Begin DoDot:1
+5 FOR
SET XMCMD=$ORDER(XMOX("X",XMCMD))
if XMCMD=""
QUIT
Begin DoDot:2
+6 if $DATA(XMOPT(XMOX("X",XMCMD),"?"))
QUIT
+7 WRITE !,?9,$EXTRACT(XMCMD_" ",1,10)_XMOPT(XMOX("X",XMCMD))
End DoDot:2
End DoDot:1
QUIT
+8 SET XMROWS=XMCNT+1\2
+9 SET I=0
+10 FOR
Begin DoDot:1
+11 SET XMCMD=$ORDER(XMOX("X",XMCMD))
+12 if $DATA(XMOPT(XMOX("X",XMCMD),"?"))
QUIT
+13 SET I=I+1
+14 SET XMHELP(I)=" "_$EXTRACT(XMCMD_" ",1,XMLEN+2)_XMOPT(XMOX("X",XMCMD))
End DoDot:1
if I=XMROWS
QUIT
+15 SET I=0
+16 FOR
SET XMCMD=$ORDER(XMOX("X",XMCMD))
if XMCMD=""
QUIT
Begin DoDot:1
+17 if $DATA(XMOPT(XMOX("X",XMCMD),"?"))
QUIT
+18 SET I=I+1
+19 WRITE !,$EXTRACT(XMHELP(I)_" ",1,39)_" "_$EXTRACT(XMCMD_" ",1,XMLEN+2)_$EXTRACT(XMOPT(XMOX("X",XMCMD)),1,37-XMLEN)
End DoDot:1
+20 SET I=I+1
+21 if $DATA(XMHELP(I))
WRITE !,XMHELP(I)
+22 QUIT
COMMAND(XMOPT,XMOX,XMY) ; Check what the user enters against the list of
+1 ; acceptable choices. If the user enters something ambiguous,
+2 ; ^DIR is called to ask the user to choose one.
+3 IF XMY?.E1C.E
QUIT -1
+4 IF $LENGTH(XMY)>64
QUIT -1
+5 NEW XMX,XMCD,XMLEN
+6 SET XMX=XMY
+7 SET XMLEN=$LENGTH(XMX)
+8 SET XMY=$$UP^XLFSTR(XMY)
+9 IF $DATA(XMOX("X",XMY))
Begin DoDot:1
+10 SET XMCD=XMOX("X",XMY)
+11 DO PARROT
End DoDot:1
QUIT XMCD
+12 NEW XMTXT,XMC,XMT,XMCHOOSE
+13 SET XMCD=""
+14 FOR
SET XMCD=$ORDER(XMOPT(XMCD))
if XMCD=""
QUIT
if '$DATA(XMOPT(XMCD,"?"))
SET XMTXT(XMOPT(XMCD))=XMCD
+15 SET XMT=$CHAR($ASCII($EXTRACT(XMY))-1)_"~"
+16 FOR
SET XMT=$ORDER(XMTXT(XMT))
if XMT=""!($EXTRACT(XMT)'=$EXTRACT(XMY))
QUIT
IF $$UP^XLFSTR($EXTRACT(XMT,1,XMLEN))=XMY
SET XMCHOOSE(XMT)=""
+17 SET XMC=$CHAR($ASCII($EXTRACT(XMY))-1)_"~"
+18 FOR
SET XMC=$ORDER(XMOX("X",XMC))
if XMC=""!($EXTRACT(XMC)'=$EXTRACT(XMY))
QUIT
IF $$UP^XLFSTR($EXTRACT(XMC,1,XMLEN))=XMY
if '$DATA(XMOPT(XMOX("X",XMC),"?"))
SET XMCHOOSE(XMOPT(XMOX("X",XMC)))=""
+19 IF '$DATA(XMCHOOSE)
QUIT -1
+20 NEW I,DIR,Y,X
+21 SET I=0
SET (DIR(0),XMT)=""
+22 FOR
SET XMT=$ORDER(XMCHOOSE(XMT))
if XMT=""
QUIT
SET I=I+1
SET DIR(0)=DIR(0)_I_":"_XMT_";"
SET XMCD(I)=XMTXT(XMT)
+23 ; (for Q xxx)
IF I=1
Begin DoDot:1
+24 SET XMCD=XMCD(I)
+25 DO PARROT
End DoDot:1
QUIT $PIECE(XMCD," ")
+26 SET DIR(0)="SO^"_$EXTRACT(DIR(0),1,$LENGTH(DIR(0))-1)
+27 ;S DIR("A")="Choose 1-"_I
+28 DO ^DIR
if $DATA(DIRUT)
QUIT -1
+29 ; (for Q xxx)
QUIT $PIECE(XMCD(Y)," ")
PARROT ;
+1 IF $EXTRACT(XMOPT(XMCD),1,XMLEN)=XMX
WRITE $EXTRACT(XMOPT(XMCD),XMLEN+1,99)
QUIT
+2 WRITE " ",XMOPT(XMCD)
+3 QUIT
