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

DDW1.m

Go to the documentation of this file. 
  1. DDW1 ;SFISC/PD KELTZ-LOAD, SAVE ;1:31 PM  16 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. LOAD ;Put up "box" and load document
  1.  N DDWI,DDWX
  1.  D BOX
  1.  ;
  1.  I $D(DWLC)[0 D
  1.  . S DWLC=$S($D(@DDWDIC@(0))#2:+$P(@DDWDIC@(0),U,4),1:$O(@DDWDIC@(""),-1))
  1.  . S:$D(@DDWDIC@(1))#2 $E(DDWBF,4)=1
  1.  S DDWCNT=$S(DWLC:DWLC,1:1)
  1.  ;
  1.  D:DDWCNT>1 MSG^DDW("Loading text ...")
  1.  F DDWI=DDWCNT:-1:DDWMR+1 D
  1.  . S DDWSTB=DDWSTB+1
  1.  . S DDWX=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
  1.  . D:DDWX?.E1C.E CTRL
  1.  . S ^TMP("DDW1",$J,DDWSTB)=DDWX
  1.  ;
  1.  F DDWI=1:1:DDWMR D
  1.  . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
  1.  . D:DDWX?.E1C.E CTRL
  1.  . S DDWL(DDWI)=DDWX
  1.  . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D
  1.  .. D CUP(DDWI,1) W $E(DDWX,1,IOM)
  1.  ;
  1.  I DDWCNT=1,DDWL(1)?1." " S DDWL(1)=""
  1.  D:DDWCNT>1 MSG^DDW()
  1.  ;
  1.  D:$G(DDWED) MSG^DDW($C(7)_$P(DDGLVID,DDGLDEL,6)_"WARNING: Control characters in the text have been replaced with spaces."_$P(DDGLVID,DDGLDEL,10))
  1.  ;
  1.  I DDWRW="B" D
  1.  . D BOT^DDW3
  1.  E  D LINE^DDWG(DDWRW,DDWC)
  1.  Q
  1.  ;
  1. CTRL ;Strip control characters from DDWX
  1.  N I
  1.  S DDWED=1
  1.  F I=1:1:$L(DDWX) S:$E(DDWX,I)?1C $E(DDWX,I)=" "
  1.  Q
  1.  ;
  1. BOX ;Draw box
  1.  N DDWX
  1.  ;
  1.  I $D(DIWETXT) D
  1.  . D CUP(-1,1)
  1.  . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10)
  1.  ;
  1.  I $D(DIWESUB) S DDWX=DIWESUB
  1.  E  I $D(DH)#2,$D(DIE) S DDWX=DH
  1.  S DDWX=$E($G(DDWX),1,30)
  1.  ;
  1.  D CUP(0,1) W $TR($J("",IOM)," ","=")
  1.  I DDWRAP S DX=2 X IOXY W "[ WRAP ]"
  1.  S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
  1.  S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >"
  1.  S DX=61 X IOXY W "[ <PF1>H=Help ]"
  1.  ;
  1.  D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM)
  1.  I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
  1.  . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<"
  1.  I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
  1.  . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">"
  1.  Q
  1.  ;
  1. AUTOTM ;Prompt for autosave time
  1.  N DDWHLP,DDWANS,DDWCOD
  1.  S DDWHLP(1)="  Enter the interval in MINUTES you wish to have the Screen Editor"
  1.  S DDWHLP(2)="  automatically save the text. Enter a number between 0 and 120."
  1.  S DDWHLP(3)="  A value of 0 means text is NOT automatically saved."
  1.  D ASK^DDWG(5,"Interval in MINUTES to automatically save text: ",15,+$G(DDWAUTO),"D AUTOVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
  1.  ;
  1.  Q:DDWCOD="TO"!(DDWANS=U)
  1.  I $G(DDWANS) D
  1.  . S DDWAUTO=DDWANS
  1.  . S DDWAUTO("H")=$H
  1.  . S DDWAUTO("S")=DDWAUTO*60
  1.  E  K DDWAUTO
  1.  Q
  1.  ;
  1. AUTOVAL ;Validate autosave time
  1.  K DDWERR
  1.  I DDWX?."^"!($P($G(DDWCOD),U)="TO") S DDWX=U Q
  1.  I $L(DDWX)>15 D
  1.  . S DDWERR="  Response must not be more than 15 characters in length."
  1.  I DDWX'=+$P(DDWX,"E") D
  1.  . S DDWERR="  Response must be numeric."
  1.  I DDWX>120!(DDWX<0) D
  1.  . S DDWERR="  Response must be between 0 and 120."
  1.  Q
  1.  ;
  1. AUTOSV ;Autosave
  1.  I $D(DDWED) K DDWED D SV
  1.  S DDWAUTO("H")=$H
  1.  Q
  1.  ;
  1. SV ;Called from DDWT1 and AUTOSV
  1.  D SAVE
  1.  S:DDWCNT<1 DDWCNT=1
  1.  I DDWRW+DDWA>DDWCNT D
  1.  . D POS(DDWCNT-DDWA,"E","RN")
  1.  E  D POS(DDWRW,DDWC)
  1.  Q
  1.  ;
  1. SAVE ;Save document
  1.  N DDWI,DDWLMEM,DDWLSTB,DDWX
  1.  D MSG^DDW("Saving text ...") H .5
  1.  S DDWCNT=0
  1.  K @DDWDIC
  1.  ;
  1.  F DDWI=1:1:DDWA D
  1.  . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI))
  1.  . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
  1.  . E  S @DDWDIC@(DDWCNT)=DDWX
  1.  ;
  1.  S DDWLMEM=999
  1.  F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB  Q:^TMP("DDW1",$J,DDWI)'?." "
  1.  I DDWI'>DDWSTB S DDWLSTB=DDWI
  1.  E  D
  1.  . F DDWI=DDWMR:-1:0 Q:'DDWI  Q:DDWL(DDWI)'?." "
  1.  . S DDWLMEM=DDWI
  1.  ;
  1.  F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D
  1.  . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI))
  1.  . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
  1.  . E  S @DDWDIC@(DDWCNT)=DDWX
  1.  ;
  1.  I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D
  1.  . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI))
  1.  . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
  1.  . E  S @DDWDIC@(DDWCNT)=DDWX
  1.  ;
  1.  S DWLC=DDWCNT,DWHD=U
  1.  I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U
  1.  D MSG^DDW()
  1.  Q
  1.  ;
  1. QUIT ;If any edits were made, issue confirmation prompt.
  1.  S DDWFIN=""
  1.  Q:$G(DDWFLAGS)["Q"!'$D(DDWED)
  1.  ;
  1.  N DDWHLP,DDWANS,DDWCOD
  1.  S DDWHLP(1)="  Enter 'Yes' to save changes and quit."
  1.  S DDWHLP(2)="  Enter 'No' to discard changes and quit."
  1.  S DDWHLP(3)="  Enter '^' to return to the editor without saving or quitting."
  1.  ;
  1.  D ASK^DDWG(5,"Do you want to save changes? ",3,"","D QUITVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
  1.  ;
  1.  I DDWCOD="TO"!(DDWANS=U) K DDWFIN
  1.  E  I DDWANS="Y" D SAVE K DUOUT ;GFT
  1.  Q
  1.  ;
  1. QUITVAL ;Validate responses to the confirmation prompt
  1.  K DDWERR
  1.  I DDWX[U!($P(DDWCOD,U)="TO") S DDWX=U Q
  1.  I DDWX="" S DDWERR="  Response is required.  Enter ? for help." Q
  1.  ;
  1.  S:DDWX?.E1L.E DDWX=$TR(DDWX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;
  1.  I $P("YES",DDWX)]"",$P("NO",DDWX)]"" D  Q
  1.  . S DDWERR="  Not a valid response.  Enter ? for help."
  1.  ;
  1.  S DDWX=$E(DDWX)
  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. CUP(Y,X) ;Cursor positioning
  1.  S DY=IOTM+Y-2,DX=X-1 X IOXY
  1.  Q
  1.  ;
  1. MIN(X,Y) ;Return the minimum of X and Y
  1.  Q $S(X<Y:X,1:Y)
  1.  ;
  1. NTS(X) ;Change "" to " "
  1.  Q $S(X="":" ",1:X)
  1.  ;
  1. TR(X,F) ;Strip trailing blanks
  1.  ;If F["B" return " " if X=""
  1.  I $G(X)]"" D
  1.  . N I
  1.  . F I=$L(X):-1:0 Q:$E(X,I)'=" "
  1.  . S X=$E(X,1,I)
  1.  I X="",$G(F)["B" S X=" "
  1.  Q X