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

DDW4.m

Go to the documentation of this file. 
  1. DDW4 ;SFISC/PD KELTZ-OTHER NAVIGATION, DEL ;2:54 PM  23 Aug 2000 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**18**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. TAB N DDWX
  1.  S DDWX=$F(DDWRUL,"T",DDWC+1) G:'DDWX ERR
  1.  D POS(DDWRW,DDWX-1,"R")
  1.  Q
  1.  ;
  1. DEOL S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
  1.  W $P(DDGLCLR,DDGLDEL)
  1.  Q
  1.  ;
  1. DELW N DDWI,DDWW
  1.  I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
  1.  I DDWC>$L(DDWN) D  Q
  1.  . I DDWN?." " D
  1.  .. D XLINE^DDW5()
  1.  . E  D
  1.  .. N DDWY,DDWX
  1.  .. S DDWY=DDWRW+DDWA,DDWX=DDWC
  1.  .. D JOIN^DDW6
  1.  .. D POS(DDWY-DDWA,DDWX,"RN")
  1.  ;
  1.  S DDWI=$$WRPOS(DDWN)
  1.  S DDWW=$E(DDWN,DDWC,DDWI-1)
  1.  S $E(DDWN,DDWC,DDWI-1)="",DDWL(DDWRW)=DDWN
  1.  I $P(DDGLED,DDGLDEL,6)]"" D
  1.  . F DDWI=1:1:$L(DDWW) W $P(DDGLED,DDGLDEL,6)
  1.  . S DDWI=$E(DDWN,IOM-$L(DDWW)+1+DDWOFS,IOM+DDWOFS)
  1.  . I DDWI]"" D CUP(DDWRW,IOM-$L(DDWW)+1) W DDWI D CUP(DDWRW,DDWC-DDWOFS)
  1.  E  D
  1.  . W $E(DDWN_$J("",$L(DDWW)),DDWC,IOM+DDWOFS)
  1.  . D CUP(DDWRW,DDWC-DDWOFS)
  1.  Q
  1.  ;
  1. WORDR N DDWI
  1.  S DDWI=$$WRPOS(DDWN)
  1.  D POS(DDWRW,DDWI,"R")
  1.  Q
  1.  ;
  1. WRPOS(DDWT) ;
  1.  N DDWP,DDWS
  1.  S DDWT=$$PUNC(DDWT)
  1.  S DDWS=$F(DDWT," ",DDWC+1),DDWP=$F(DDWT,"!",DDWC+1)
  1.  S:'DDWS DDWS=999 S:'DDWP DDWP=999
  1.  ;
  1.  I DDWC>$L(DDWT) D
  1.  . I DDWRW+DDWA'<DDWCNT S DDWI=$L(DDWT)+1
  1.  . E  D DN^DDWT1 S DDWI=1
  1.  E  I DDWS=999,DDWP=999 D
  1.  . S DDWI=$L(DDWT)+1
  1.  E  I $E(DDWT,DDWC)="!" D
  1.  . F DDWI=DDWC+1:1 Q:$E(DDWT,DDWI)'="!"
  1.  . F DDWI=DDWI:1 Q:$E(DDWT,DDWI)'=" "
  1.  E  I DDWS<DDWP D
  1.  . F DDWI=DDWS:1 Q:$E(DDWT,DDWI)'=" "
  1.  E  S DDWI=DDWP-1
  1.  Q DDWI
  1.  ;
  1. WORDL N DDWD,DDWI,DDWT
  1.  S DDWT=$$PUNC(DDWN)
  1.  ;
  1.  I DDWC=1 D
  1.  . I DDWRW=1,'DDWA S DDWI=1
  1.  . E  D UP^DDWT1 S DDWI=$L(DDWN)+1
  1.  E  D
  1.  . S DDWI=DDWC-1
  1.  . S:$E(DDWT,DDWI)="" DDWI=$L(DDWT)
  1.  . I $E(DDWT,DDWI)=" " F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'=" "
  1.  . I $E(DDWT,DDWI)="!" D
  1.  .. F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'="!"
  1.  . E  I DDWI D
  1.  .. F DDWI=DDWI-1:-1:0 Q:" !"[$E(DDWT,DDWI)
  1.  . S DDWI=DDWI+1
  1.  D POS(DDWRW,DDWI,"R")
  1.  Q
  1.  ;
  1. PGDN N DDWX
  1.  I DDWRW<DDWMR D
  1.  . D POS($$MIN(DDWCNT-DDWA,DDWMR),DDWC,"RN")
  1.  E  D
  1.  . S DDWX=$$MIN(DDWSTB,DDWMR)
  1.  . D:DDWX MVFWD^DDW3(DDWX)
  1.  Q
  1.  ;
  1. PGUP N DDWX
  1.  I DDWRW>1 D
  1.  . D POS(1,DDWC,"RN")
  1.  E  D
  1.  . S DDWX=$$MIN(DDWA,DDWMR)
  1.  . D:DDWX MVBCK^DDW3(DDWX)
  1.  Q
  1.  ;
  1. JLEFT I DDWC=1,'DDWOFS Q
  1.  N DDWX
  1.  I DDWN?." " S DDWX=1
  1.  E  F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
  1.  I DDWC-DDWOFS=1,DDWC>1 D POS(DDWRW,DDWC-1,"R") Q:DDWC=DDWX
  1.  S DDWC=$$MAX($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:0),1+DDWOFS)
  1.  D POS(DDWRW,DDWC,"R")
  1.  Q
  1. JRIGHT N DDWX
  1.  S DDWX=$L(DDWN)+1
  1.  I DDWC-DDWOFS=IOM,DDWC<246 D POS(DDWRW,DDWC+1,"R") Q:DDWC=DDWX
  1.  S DDWC=$$MIN($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:999),$$MIN(IOM+DDWOFS,246))
  1.  D POS(DDWRW,DDWC,"R")
  1.  Q
  1.  ;
  1. LBEG N DDWX
  1.  I DDWN?." " D POS(DDWRW,1,"R") Q
  1.  I $E(DDWN,1,DDWC-1)?." ",$E(DDWN,DDWC)'=" " D POS(DDWRW,1,"R") Q
  1.  F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
  1.  D POS(DDWRW,DDWX,"R")
  1.  Q
  1. LEND D POS(DDWRW,"E","R")
  1.  Q
  1.  ;
  1. ERR ;Beep
  1.  W $C(7)
  1.  Q
  1.  ;
  1. CUP(Y,X) ;Cursor positioning
  1.  S DY=IOTM+Y-2,DX=X-1 X IOXY
  1.  Q
  1.  ;
  1. POS(R,C,F) ;Pos cursor based on char pos C
  1.  N DDWX
  1.  S:$G(C)="E" C=$L($G(DDWL(R)))+1
  1.  S:$G(F)["N" DDWN=$G(DDWL(R))
  1.  S:$G(F)["R" DDWRW=R,DDWC=C
  1.  ;
  1.  S DDWX=C-DDWOFS
  1.  I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q
  1.  ;
  1. SCR(C) ;Screen #
  1.  Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
  1.  ;
  1. MIN(X,Y) ;
  1.  Q $S(X<Y:X,1:Y)
  1. MAX(X,Y) ;
  1.  Q $S(X>Y:X,1:Y)
  1. PUNC(X) ;
  1.  Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))