Return to DDW1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDW1	;SFISC/PD KELTZ-LOAD, SAVE ;06:12 PM  13 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;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 ^TMP("DDW1",$J,DDWSTB)=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
	;
	F DDWI=1:1:DDWMR D
	. S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
	. 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()
	I DDWRW="B" D
	. D BOT^DDW3
	E  D LINE^DDWG(DDWRW,DDWC)
	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(XMSUB),DIC["^XMB" D
	. S DDWX=XMSUB
	. F  Q:DDWX'["~U~"  S DDWX=$P(DDWX,"~U~")_U_$P(DDWX,"~U~",2,999)
	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
	;
SV	;Called from DDWT1
	D SAVE
	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
	;
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