- 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 Feb 18, 2025@23:38 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