source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDW1.m@ 1800

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