- GMRYDIR ;HIRNFO/YH-REPLACE...WITH ;12/14/95
- ;;4.0;Intake/Output;;Apr 25, 1997
- RW(STRING,LEN) ; Replace...With...
- N X,Y,%,L S Y=STRING W !,STRING,! S:$D(DTIME)[0 DTIME=999
- A W:$X>75 ! W " Replace " R X:DTIME I '$T!(X["^") S GMROUT=1 G Q
- G Q:X="",Q:X?1."^",Q:$E(X)=U&(Y'[X),C:X?."?",Q:X="@",E2:X="END"!(X="end")
- I Y[X S D=X,L=$L(X) D H G:GMROUT Q S:'%&'GMROUT Y=$P(Y,D,1)_X_$P(Y,D,2,999) G A
- S D=$P(X,"...",1),DH=$F(Y,D) I DH S X=$P(X,"...",2,99),X=$S(X="":$L(Y)+1,1:$F(Y,X,DH)) I X S DH=DH-$L(D)-1,D=X,L=D-DH-1 D H G:GMROUT Q S:'%&'GMROUT Y=$E(Y,1,DH)_X_$E(Y,D,999) G A
- W $C(7)," ??" G A
- H W " With " R X:DTIME I '$T!(X["^") S GMROUT=1,X="",%=0 Q
- S %=$L(Y)-L+$L(X)>LEN I % W $C(7),$S($L(Y)-L'>LEN:" String too long by "_($L(Y)-L+$L(X)-LEN)_" character(s)",X'=U:" String too long! '^' to quit",1:" ??") Q:$L(Y)-L>LEN&(X=U) G H
- Q:X?.ANP W $C(7)," ??" G H
- E2 S L=0 D H G:GMROUT Q S:'%&'GMROUT Y=Y_X G A
- C W !,"Entry must be lesser than "_LEN_" characters",! G A
- B W:GMROUT *7 I STRING'=Y S X=Y W !?3 W X I X="" S X="@"
- Q W:'GMROUT !,Y,! Q Y
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYDIR 1072 printed Feb 18, 2025@23:21:36 Page 2
- GMRYDIR ;HIRNFO/YH-REPLACE...WITH ;12/14/95
- +1 ;;4.0;Intake/Output;;Apr 25, 1997
- RW(STRING,LEN) ; Replace...With...
- +1 NEW X,Y,%,L
- SET Y=STRING
- WRITE !,STRING,!
- if $DATA(DTIME)[0
- SET DTIME=999
- A if $X>75
- WRITE !
- WRITE " Replace "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET GMROUT=1
- GOTO Q
- +1 if X=""
- GOTO Q
- if X?1."^"
- GOTO Q
- if $EXTRACT(X)=U&(Y'[X)
- GOTO Q
- if X?."?"
- GOTO C
- if X="@"
- GOTO Q
- if X="END"!(X="end")
- GOTO E2
- +2 IF Y[X
- SET D=X
- SET L=$LENGTH(X)
- DO H
- if GMROUT
- GOTO Q
- if '%&'GMROUT
- SET Y=$PIECE(Y,D,1)_X_$PIECE(Y,D,2,999)
- GOTO A
- +3 SET D=$PIECE(X,"...",1)
- SET DH=$FIND(Y,D)
- IF DH
- SET X=$PIECE(X,"...",2,99)
- SET X=$SELECT(X="":$LENGTH(Y)+1,1:$FIND(Y,X,DH))
- IF X
- SET DH=DH-$LENGTH(D)-1
- SET D=X
- SET L=D-DH-1
- DO H
- if GMROUT
- GOTO Q
- if '%&'GMROUT
- SET Y=$EXTRACT(Y,1,DH)_X_$EXTRACT(Y,D,999)
- GOTO A
- +4 WRITE $CHAR(7)," ??"
- GOTO A
- H WRITE " With "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET GMROUT=1
- SET X=""
- SET %=0
- QUIT
- +1 SET %=$LENGTH(Y)-L+$LENGTH(X)>LEN
- IF %
- WRITE $CHAR(7),$SELECT($LENGTH(Y)-L'>LEN:" String too long by "_($LENGTH(Y)-L+$LENGTH(X)-LEN)_" character(s)",X'=U:" String too long! '^' to quit",1:" ??")
- if $LENGTH(Y)-L>LEN&(X=U)
- QUIT
- GOTO H
- +2 if X?.ANP
- QUIT
- WRITE $CHAR(7)," ??"
- GOTO H
- E2 SET L=0
- DO H
- if GMROUT
- GOTO Q
- if '%&'GMROUT
- SET Y=Y_X
- GOTO A
- C WRITE !,"Entry must be lesser than "_LEN_" characters",!
- GOTO A
- B if GMROUT
- WRITE *7
- IF STRING'=Y
- SET X=Y
- WRITE !?3
- WRITE X
- IF X=""
- SET X="@"
- Q if 'GMROUT
- WRITE !,Y,!
- QUIT Y
- +1 ;