Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIR01

DIR01.m

Go to the documentation of this file.
  1. DIR01 ;SFISC/MKO-FIELD EDITOR ;12:37 PM 15 Feb 1995
  1. ;;22.0;VA FileMan;;Mar 30, 1999
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. I DIR0A]"",DIR0C=1 D F X IOXY Q:DIR0QT
  1. F D E X IOXY Q:DIR0QT
  1. Q
  1. ;
  1. F D READ(.DIR0CH)
  1. I "?^"'[DIR0CH=$L(DIR0CH) S DIR0A="" D REP,DEOF Q
  1. D:DIR0CH]"" E1
  1. Q
  1. ;
  1. E I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),DIR0F>DX,DIR0M>$L(DIR0A),'$D(DIR0KD) D
  1. . D PREAD($$MIN(DIR0F-DX,DIR0M-DIR0C+1),.DIR0ST,.DIR0CH)
  1. . Q:DIR0ST=""
  1. . S DIR0CHG=1
  1. . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
  1. . E S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
  1. . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
  1. E D READ(.DIR0CH)
  1. Q:DIR0CH=""
  1. ;
  1. E1 I "?^"[DIR0CH,DIR0C=1,'DIR0QU S DIR0A="",DIR0QU=1 D REP,DEOF Q
  1. D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
  1. I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
  1. Q
  1. ;
  1. REP I DIR0C>DIR0M W $C(7) Q
  1. S DIR0CHG=1
  1. S $E(DIR0A,DIR0C)=DIR0CH,DIR0C=DIR0C+1
  1. I DIR0F>DX S DX=DX+1 W DIR0CH Q
  1. N DIX
  1. S DIX=DIR0C-(DIR0L\2)
  1. S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
  1. S DX=DIR0S X IOXY
  1. W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
  1. Q
  1. ;
  1. INS I $L(DIR0A)'<DIR0M W $C(7) Q
  1. S DIR0CHG=1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999),DIR0C=DIR0C+1
  1. I DIR0F>DX S DX=DX+1 W $E(DIR0A,DIR0C-1,DIR0C+DIR0F-DX-1) Q
  1. S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1) S DX=DIR0F
  1. Q
  1. ;
  1. I DX<DIR0F S DX=DX+1,DIR0C=DIR0C+1 Q
  1. S DIR0C=DIR0C+1,DX=DIR0S X IOXY
  1. W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
  1. S DX=DIR0F
  1. Q
  1. ;
  1. LEFT Q:DIR0C'>1
  1. I DX>DIR0S S DX=DX-1,DIR0C=DIR0C-1 Q
  1. S DIR0C=DIR0C-1 W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
  1. Q
  1. ;
  1. JRT Q:DIR0C>$L(DIR0A)
  1. I DIR0F=DX D Q
  1. . S DIR0C=DIR0C+DIR0L S:DIR0C+1>$L(DIR0A) DIR0C=$L(DIR0A)+1
  1. . S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
  1. . S DX=DIR0F
  1. N DIX
  1. S DIX=$L(DIR0A)-DIR0C+1
  1. I DIR0F-DX>DIX S DX=DX+DIX,DIR0C=DIR0C+DIX Q
  1. S DIR0C=DIR0C+DIR0F-DX,DX=DIR0F
  1. Q
  1. ;
  1. JLT Q:DIR0C'>1
  1. I DX=DIR0S D Q
  1. . S DIR0C=DIR0C-DIR0L S:DIR0C<1 DIR0C=1
  1. . W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
  1. S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
  1. Q
  1. ;
  1. FDE Q:DIR0C>$L(DIR0A)
  1. I DX+$L(DIR0A)-DIR0C-DIR0L<DIR0S D Q
  1. . S DX=DX+$L(DIR0A)-DIR0C+1,DIR0C=$L(DIR0A)+1
  1. S DIR0C=$L(DIR0A)+1,DX=DIR0S X IOXY
  1. W $E(DIR0A,DIR0C-DIR0L,DIR0C)
  1. S DX=DIR0F
  1. Q
  1. ;
  1. FDB Q:DIR0C'>1
  1. I DX-DIR0C+1<DIR0S S DX=DIR0S X IOXY W $E(DIR0A,1,DIR0L)
  1. S DX=DIR0S,DIR0C=1
  1. Q
  1. ;
  1. BS Q:DIR0C'>1
  1. S DIR0CHG=1
  1. S DIR0C=DIR0C-1,DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
  1. I DX>DIR0S D Q
  1. . S DX=DX-1 X IOXY
  1. . W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
  1. N DIX
  1. S DIX=DIR0C-(DIR0L\2)
  1. S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
  1. S:DIX<1 DIX=1
  1. W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
  1. Q
  1. ;
  1. DEL Q:DIR0C>$L(DIR0A)!(DIR0F'>DX)
  1. S DIR0CHG=1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
  1. W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
  1. Q
  1. ;
  1. CLR S DIR0CHG=1
  1. S DIR0C=1,DX=DIR0S X IOXY
  1. I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
  1. S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
  1. W $E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
  1. Q
  1. ;
  1. DEOF S DIR0CHG=1
  1. W $E(DIR0SP,DX-DIR0S+1,999)
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)
  1. Q
  1. ;
  1. RPM N DX,DY
  1. I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
  1. I $G(DIR0("REP")) W:$D(DDS) "Insert " K DIR0("REP")
  1. E W:$D(DDS) "Replace" S DIR0("REP")=1
  1. Q
  1. ;
  1. KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
  1. E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
  1. Q
  1. ;
  1. WRT G WRT^DIR0W
  1. WLT G WLT^DIR0W
  1. DLW G DLW^DIR0W
  1. HLP G ^DIR0H
  1. ZM G SM^DIR02
  1. ;
  1. TO I $D(DIR0TO)#2 D @DIR0TO Q
  1. S DTOUT=1
  1. UP ;
  1. DOWN ;
  1. TAB ;
  1. FDL ;
  1. CR ;
  1. NB ;
  1. NP ;
  1. PP ;
  1. SEL ;
  1. EX ;
  1. QT ;
  1. CL ;
  1. SV ;
  1. RF ;
  1. S DIR0QT=1
  1. Q
  1. NOP W $C(7)
  1. Q
  1. ;
  1. READ(Y) ;Out: Y=char or mnemonic
  1. F D Q:Y'=-1
  1. . R *Y:DTIME
  1. . I Y>31,Y<127 S Y=$C(Y) Q
  1. . I Y<0 S Y="TO" Q
  1. . D MNE(.Y)
  1. I Y'="TO",$D(DIR0KD) D @DIR0KD
  1. Q
  1. ;
  1. PREAD(DIR0LEN,DIR0ST,Y) ;
  1. ; Y = Mnem, Null if DIR0LEN chars read or invalid
  1. X DDGLZOSF("EON")
  1. R DIR0ST#DIR0LEN:DTIME E S Y="TO" Q
  1. X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
  1. I $C(Y)?1C,Y D
  1. . D MNE(.Y) S:Y=-1 Y=""
  1. E S Y=""
  1. Q
  1. ;
  1. MNE(Y) ;Out: Y=mnemonic, or -1 if invalid
  1. N S,F
  1. S S="",F=0
  1. F D MNELOOP Q:F
  1. Q
  1. ;
  1. MNELOOP ;
  1. S S=S_$C(Y)
  1. I DIR0(DIR0P_"IN")'[(U_S) D I Y=-1 D FLUSH Q
  1. . I $C(Y)'?1L S Y=-1 Q
  1. . S S=$E(S,1,$L(S)-1)_$C(Y-32)
  1. . S:DIR0(DIR0P_"IN")'[(U_S_U) Y=-1
  1. ;
  1. I DIR0(DIR0P_"IN")[(U_S_U),S'=$C(27) D
  1. . S Y=$P(DIR0(DIR0P_"OUT"),";",$L($P(DIR0(DIR0P_"IN"),U_S_U),U)),F=1
  1. E R *Y:5 D:Y=-1 FLUSH
  1. Q
  1. ;
  1. FLUSH N X
  1. S F=1 W $C(7) F R *X:0 E Q
  1. Q
  1. ;
  1. MIN(X,Y) ;
  1. Q $S(X<Y:X,1:Y)