| [613] | 1 | DDW1 ;SFISC/PD KELTZ-LOAD, SAVE ;1:31 PM 16 Aug 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**18**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | LOAD ;Put up "box" and load document
|
|---|
| 6 | N DDWI,DDWX
|
|---|
| 7 | D BOX
|
|---|
| 8 | ;
|
|---|
| 9 | I $D(DWLC)[0 D
|
|---|
| 10 | . S DWLC=$S($D(@DDWDIC@(0))#2:+$P(@DDWDIC@(0),U,4),1:$O(@DDWDIC@(""),-1))
|
|---|
| 11 | . S:$D(@DDWDIC@(1))#2 $E(DDWBF,4)=1
|
|---|
| 12 | S DDWCNT=$S(DWLC:DWLC,1:1)
|
|---|
| 13 | ;
|
|---|
| 14 | D:DDWCNT>1 MSG^DDW("Loading text ...")
|
|---|
| 15 | F DDWI=DDWCNT:-1:DDWMR+1 D
|
|---|
| 16 | . S DDWSTB=DDWSTB+1
|
|---|
| 17 | . S DDWX=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
|
|---|
| 18 | . D:DDWX?.E1C.E CTRL
|
|---|
| 19 | . S ^TMP("DDW1",$J,DDWSTB)=DDWX
|
|---|
| 20 | ;
|
|---|
| 21 | F DDWI=1:1:DDWMR D
|
|---|
| 22 | . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
|
|---|
| 23 | . D:DDWX?.E1C.E CTRL
|
|---|
| 24 | . S DDWL(DDWI)=DDWX
|
|---|
| 25 | . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D
|
|---|
| 26 | .. D CUP(DDWI,1) W $E(DDWX,1,IOM)
|
|---|
| 27 | ;
|
|---|
| 28 | I DDWCNT=1,DDWL(1)?1." " S DDWL(1)=""
|
|---|
| 29 | D:DDWCNT>1 MSG^DDW()
|
|---|
| 30 | ;
|
|---|
| 31 | 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))
|
|---|
| 32 | ;
|
|---|
| 33 | I DDWRW="B" D
|
|---|
| 34 | . D BOT^DDW3
|
|---|
| 35 | E D LINE^DDWG(DDWRW,DDWC)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | CTRL ;Strip control characters from DDWX
|
|---|
| 39 | N I
|
|---|
| 40 | S DDWED=1
|
|---|
| 41 | F I=1:1:$L(DDWX) S:$E(DDWX,I)?1C $E(DDWX,I)=" "
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | BOX ;Draw box
|
|---|
| 45 | N DDWX
|
|---|
| 46 | ;
|
|---|
| 47 | I $D(DIWETXT) D
|
|---|
| 48 | . D CUP(-1,1)
|
|---|
| 49 | . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10)
|
|---|
| 50 | ;
|
|---|
| 51 | I $D(DIWESUB) S DDWX=DIWESUB
|
|---|
| 52 | E I $D(DH)#2,$D(DIE) S DDWX=DH
|
|---|
| 53 | S DDWX=$E($G(DDWX),1,30)
|
|---|
| 54 | ;
|
|---|
| 55 | D CUP(0,1) W $TR($J("",IOM)," ","=")
|
|---|
| 56 | I DDWRAP S DX=2 X IOXY W "[ WRAP ]"
|
|---|
| 57 | S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
|
|---|
| 58 | S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >"
|
|---|
| 59 | S DX=61 X IOXY W "[ <PF1>H=Help ]"
|
|---|
| 60 | ;
|
|---|
| 61 | D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM)
|
|---|
| 62 | I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
|
|---|
| 63 | . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<"
|
|---|
| 64 | I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
|
|---|
| 65 | . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">"
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | AUTOTM ;Prompt for autosave time
|
|---|
| 69 | N DDWHLP,DDWANS,DDWCOD
|
|---|
| 70 | S DDWHLP(1)=" Enter the interval in MINUTES you wish to have the Screen Editor"
|
|---|
| 71 | S DDWHLP(2)=" automatically save the text. Enter a number between 0 and 120."
|
|---|
| 72 | S DDWHLP(3)=" A value of 0 means text is NOT automatically saved."
|
|---|
| 73 | D ASK^DDWG(5,"Interval in MINUTES to automatically save text: ",15,+$G(DDWAUTO),"D AUTOVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
|
|---|
| 74 | ;
|
|---|
| 75 | Q:DDWCOD="TO"!(DDWANS=U)
|
|---|
| 76 | I $G(DDWANS) D
|
|---|
| 77 | . S DDWAUTO=DDWANS
|
|---|
| 78 | . S DDWAUTO("H")=$H
|
|---|
| 79 | . S DDWAUTO("S")=DDWAUTO*60
|
|---|
| 80 | E K DDWAUTO
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | AUTOVAL ;Validate autosave time
|
|---|
| 84 | K DDWERR
|
|---|
| 85 | I DDWX?."^"!($P($G(DDWCOD),U)="TO") S DDWX=U Q
|
|---|
| 86 | I $L(DDWX)>15 D
|
|---|
| 87 | . S DDWERR=" Response must not be more than 15 characters in length."
|
|---|
| 88 | I DDWX'=+$P(DDWX,"E") D
|
|---|
| 89 | . S DDWERR=" Response must be numeric."
|
|---|
| 90 | I DDWX>120!(DDWX<0) D
|
|---|
| 91 | . S DDWERR=" Response must be between 0 and 120."
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | AUTOSV ;Autosave
|
|---|
| 95 | I $D(DDWED) K DDWED D SV
|
|---|
| 96 | S DDWAUTO("H")=$H
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | SV ;Called from DDWT1 and AUTOSV
|
|---|
| 100 | D SAVE
|
|---|
| 101 | S:DDWCNT<1 DDWCNT=1
|
|---|
| 102 | I DDWRW+DDWA>DDWCNT D
|
|---|
| 103 | . D POS(DDWCNT-DDWA,"E","RN")
|
|---|
| 104 | E D POS(DDWRW,DDWC)
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | SAVE ;Save document
|
|---|
| 108 | N DDWI,DDWLMEM,DDWLSTB,DDWX
|
|---|
| 109 | D MSG^DDW("Saving text ...") H .5
|
|---|
| 110 | S DDWCNT=0
|
|---|
| 111 | K @DDWDIC
|
|---|
| 112 | ;
|
|---|
| 113 | F DDWI=1:1:DDWA D
|
|---|
| 114 | . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI))
|
|---|
| 115 | . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
|
|---|
| 116 | . E S @DDWDIC@(DDWCNT)=DDWX
|
|---|
| 117 | ;
|
|---|
| 118 | S DDWLMEM=999
|
|---|
| 119 | F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB Q:^TMP("DDW1",$J,DDWI)'?." "
|
|---|
| 120 | I DDWI'>DDWSTB S DDWLSTB=DDWI
|
|---|
| 121 | E D
|
|---|
| 122 | . F DDWI=DDWMR:-1:0 Q:'DDWI Q:DDWL(DDWI)'?." "
|
|---|
| 123 | . S DDWLMEM=DDWI
|
|---|
| 124 | ;
|
|---|
| 125 | F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D
|
|---|
| 126 | . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI))
|
|---|
| 127 | . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
|
|---|
| 128 | . E S @DDWDIC@(DDWCNT)=DDWX
|
|---|
| 129 | ;
|
|---|
| 130 | I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D
|
|---|
| 131 | . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI))
|
|---|
| 132 | . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
|
|---|
| 133 | . E S @DDWDIC@(DDWCNT)=DDWX
|
|---|
| 134 | ;
|
|---|
| 135 | S DWLC=DDWCNT,DWHD=U
|
|---|
| 136 | I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U
|
|---|
| 137 | D MSG^DDW()
|
|---|
| 138 | Q
|
|---|
| 139 | ;
|
|---|
| 140 | QUIT ;If any edits were made, issue confirmation prompt.
|
|---|
| 141 | S DDWFIN=""
|
|---|
| 142 | Q:$G(DDWFLAGS)["Q"!'$D(DDWED)
|
|---|
| 143 | ;
|
|---|
| 144 | N DDWHLP,DDWANS,DDWCOD
|
|---|
| 145 | S DDWHLP(1)=" Enter 'Yes' to save changes and quit."
|
|---|
| 146 | S DDWHLP(2)=" Enter 'No' to discard changes and quit."
|
|---|
| 147 | S DDWHLP(3)=" Enter '^' to return to the editor without saving or quitting."
|
|---|
| 148 | ;
|
|---|
| 149 | D ASK^DDWG(5,"Do you want to save changes? ",3,"","D QUITVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
|
|---|
| 150 | ;
|
|---|
| 151 | I DDWCOD="TO"!(DDWANS=U) K DDWFIN
|
|---|
| 152 | E I DDWANS="Y" D SAVE K DUOUT ;GFT
|
|---|
| 153 | Q
|
|---|
| 154 | ;
|
|---|
| 155 | QUITVAL ;Validate responses to the confirmation prompt
|
|---|
| 156 | K DDWERR
|
|---|
| 157 | I DDWX[U!($P(DDWCOD,U)="TO") S DDWX=U Q
|
|---|
| 158 | I DDWX="" S DDWERR=" Response is required. Enter ? for help." Q
|
|---|
| 159 | ;
|
|---|
| 160 | S:DDWX?.E1L.E DDWX=$TR(DDWX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 161 | ;
|
|---|
| 162 | I $P("YES",DDWX)]"",$P("NO",DDWX)]"" D Q
|
|---|
| 163 | . S DDWERR=" Not a valid response. Enter ? for help."
|
|---|
| 164 | ;
|
|---|
| 165 | S DDWX=$E(DDWX)
|
|---|
| 166 | Q
|
|---|
| 167 | ;
|
|---|
| 168 | POS(R,C,F) ;Pos cursor based on char pos C
|
|---|
| 169 | N DDWX
|
|---|
| 170 | S:$G(C)="E" C=$L($G(DDWL(R)))+1
|
|---|
| 171 | S:$G(F)["N" DDWN=$G(DDWL(R))
|
|---|
| 172 | S:$G(F)["R" DDWRW=R,DDWC=C
|
|---|
| 173 | ;
|
|---|
| 174 | S DDWX=C-DDWOFS
|
|---|
| 175 | I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
|
|---|
| 176 | S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
|
|---|
| 177 | Q
|
|---|
| 178 | ;
|
|---|
| 179 | CUP(Y,X) ;Cursor positioning
|
|---|
| 180 | S DY=IOTM+Y-2,DX=X-1 X IOXY
|
|---|
| 181 | Q
|
|---|
| 182 | ;
|
|---|
| 183 | MIN(X,Y) ;Return the minimum of X and Y
|
|---|
| 184 | Q $S(X<Y:X,1:Y)
|
|---|
| 185 | ;
|
|---|
| 186 | NTS(X) ;Change "" to " "
|
|---|
| 187 | Q $S(X="":" ",1:X)
|
|---|
| 188 | ;
|
|---|
| 189 | TR(X,F) ;Strip trailing blanks
|
|---|
| 190 | ;If F["B" return " " if X=""
|
|---|
| 191 | I $G(X)]"" D
|
|---|
| 192 | . N I
|
|---|
| 193 | . F I=$L(X):-1:0 Q:$E(X,I)'=" "
|
|---|
| 194 | . S X=$E(X,1,I)
|
|---|
| 195 | I X="",$G(F)["B" S X=" "
|
|---|
| 196 | Q X
|
|---|
