Annotation of freem_fileman/DDW1.m, revision 1.1.1.1
1.1 snw 1: DDW1 ;SFISC/PD KELTZ-LOAD, SAVE ;06:12 PM 13 Dec 1994
2: ;;21.0;VA FileMan;;Dec 28, 1994
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 ^TMP("DDW1",$J,DDWSTB)=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
18: ;
19: F DDWI=1:1:DDWMR D
20: . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
21: . S DDWL(DDWI)=DDWX
22: . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D
23: .. D CUP(DDWI,1) W $E(DDWX,1,IOM)
24: ;
25: I DDWCNT=1,DDWL(1)?1." " S DDWL(1)=""
26: D:DDWCNT>1 MSG^DDW()
27: I DDWRW="B" D
28: . D BOT^DDW3
29: E D LINE^DDWG(DDWRW,DDWC)
30: Q
31: ;
32: BOX ;Draw box
33: N DDWX
34: ;
35: I $D(DIWETXT) D
36: . D CUP(-1,1)
37: . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10)
38: ;
39: I $D(DIWESUB) S DDWX=DIWESUB
40: E I $D(XMSUB),DIC["^XMB" D
41: . S DDWX=XMSUB
42: . F Q:DDWX'["~U~" S DDWX=$P(DDWX,"~U~")_U_$P(DDWX,"~U~",2,999)
43: E I $D(DH)#2,$D(DIE) S DDWX=DH
44: S DDWX=$E($G(DDWX),1,30)
45: ;
46: D CUP(0,1) W $TR($J("",IOM)," ","=")
47: I DDWRAP S DX=2 X IOXY W "[ WRAP ]"
48: S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
49: S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >"
50: S DX=61 X IOXY W "[ <PF1>H=Help ]"
51: ;
52: D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM)
53: I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
54: . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<"
55: I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
56: . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">"
57: Q
58: ;
59: SV ;Called from DDWT1
60: D SAVE
61: I DDWRW+DDWA>DDWCNT D
62: . D POS(DDWCNT-DDWA,"E","RN")
63: E D POS(DDWRW,DDWC)
64: Q
65: ;
66: SAVE ;Save document
67: N DDWI,DDWLMEM,DDWLSTB,DDWX
68: D MSG^DDW("Saving text ...") H .5
69: S DDWCNT=0
70: K @DDWDIC
71: ;
72: F DDWI=1:1:DDWA D
73: . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI))
74: . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
75: . E S @DDWDIC@(DDWCNT)=DDWX
76: ;
77: S DDWLMEM=999
78: F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB Q:^TMP("DDW1",$J,DDWI)'?." "
79: I DDWI'>DDWSTB S DDWLSTB=DDWI
80: E D
81: . F DDWI=DDWMR:-1:0 Q:'DDWI Q:DDWL(DDWI)'?." "
82: . S DDWLMEM=DDWI
83: ;
84: F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D
85: . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI))
86: . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
87: . E S @DDWDIC@(DDWCNT)=DDWX
88: ;
89: I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D
90: . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI))
91: . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
92: . E S @DDWDIC@(DDWCNT)=DDWX
93: ;
94: S DWLC=DDWCNT,DWHD=U
95: I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U
96: D MSG^DDW()
97: Q
98: ;
99: POS(R,C,F) ;Pos cursor based on char pos C
100: N DDWX
101: S:$G(C)="E" C=$L($G(DDWL(R)))+1
102: S:$G(F)["N" DDWN=$G(DDWL(R))
103: S:$G(F)["R" DDWRW=R,DDWC=C
104: ;
105: S DDWX=C-DDWOFS
106: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
107: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
108: Q
109: ;
110: CUP(Y,X) ;Cursor positioning
111: S DY=IOTM+Y-2,DX=X-1 X IOXY
112: Q
113: ;
114: MIN(X,Y) ;Return the minimum of X and Y
115: Q $S(X<Y:X,1:Y)
116: ;
117: NTS(X) ;Change "" to " "
118: Q $S(X="":" ",1:X)
119: ;
120: TR(X,F) ;Strip trailing blanks
121: ;If F["B" return " " if X=""
122: I $G(X)]"" D
123: . N I
124: . F I=$L(X):-1:0 Q:$E(X,I)'=" "
125: . S X=$E(X,1,I)
126: I X="",$G(F)["B" S X=" "
127: Q X
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDW1.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman