File:  [Coherent Logic Development] / freem_fileman / USER / DDWF.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DDWF	;SFISC/MKO-FIND, REPLACE ;08:31 AM  22 Jun 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
NEXT	;Find next occurrence of same text
	N DDWT
	G:$G(DDWFIND)="" FIND
	S DDWT=DDWFIND
	D FINDT(DDWT,$G(DDWFIND(1)))
	Q
	;
FIND	;Prompt and find text
	N DDWCOD,DDWF,DDWT
	D ASK^DDWG(3,"Find What: ",30,$G(DDWFIND),"","",.DDWT,.DDWCOD)
	Q:DDWT=""
	D FINDT(DDWT,$P($G(DDWCOD),U)="U")
	Q
	;
FINDT(DDWT,DDWBACK)	;Find DDWT
	D:$D(DDWMARK) UNMARK^DDW7
	S DDWFIND=DDWT,DDWT=$$UC(DDWT)
	I $G(DDWBACK) D
	. S DDWFIND(1)=1 D LOOKB
	E  K DDWFIND(1) D LOOK
	Q
	;
LOOK	;Look in arrays
	N DDWF,DDWI,DDWX
	S DDWF=$F($$UC(DDWL(DDWRW)),DDWT,DDWC)
	I DDWF D REPOS(DDWRW+DDWA,DDWF) Q
	;
	F DDWI=DDWRW+1:1:DDWMR D  Q:DDWF
	. S DDWX=$F($$UC(DDWL(DDWI)),DDWT)
	. I DDWX D REPOS(DDWI+DDWA,DDWX) S DDWF=1
	Q:DDWF
	;
	D MSG^DDW("Searching ...")
	F DDWI=DDWSTB:-1:1 D  Q:DDWF
	. S DDWX=$F($$UC(^TMP("DDW1",$J,DDWI)),DDWT)
	. I DDWX D
	.. D MSG^DDW()
	.. D REPOS(DDWA+DDWMR+DDWSTB-DDWI+1,DDWX)
	.. S DDWF=1
	Q:DDWF
	;
	D MSG^DDW("Text not found.") H 2
	D MSG^DDW(),CUP(DDWRW,DDWC)
	F  R *DDWX:0 E  Q
	Q
	;
LOOKB	;Look backward in arrays
	N DDWF,DDWI,DDWX
	S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-1),DDWT)
	I DDWF=DDWC S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-$L(DDWT)-1),DDWT)
	I DDWF D REPOS(DDWRW+DDWA,DDWF) Q
	;
	F DDWI=DDWRW-1:-1:1 D  Q:DDWF
	. S DDWX=$$RF($$UC(DDWL(DDWI)),DDWT)
	. I DDWX D REPOS(DDWI+DDWA,DDWX) S DDWF=1
	Q:DDWF
	;
	D MSG^DDW("Searching ...")
	F DDWI=DDWA:-1:1 D  Q:DDWF
	. S DDWX=$$RF($$UC(^TMP("DDW",$J,DDWI)),DDWT)
	. I DDWX D
	.. D MSG^DDW()
	.. D REPOS(DDWI,DDWX)
	.. S DDWF=1
	Q:DDWF
	;
	D MSG^DDW("Text not found.") H 2
	D MSG^DDW(),CUP(DDWRW,DDWC)
	F  R *DDWX:0 E  Q
	Q
	;
REPOS(DDWY,DDWX)	;Define DDWMARK, paint if on screen
	S DDWMARK=DDWY_U_(DDWX-$L(DDWT))_U_DDWY_U_(DDWX-1)
	I DDWY-DDWA>0,DDWY-DDWA'>DDWMR,DDWX-DDWOFS>0,DDWX-DDWOFS'>IOM D
	. D PAINT^DDW7(DDWMARK,1)
	. D POS(DDWY-DDWA,DDWX,"RN")
	E  D LINE^DDWG(DDWY,DDWX)
	D IND^DDW7(1)
	Q
	;
UC(X)	;Return uppercase of X
	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
	;
RF(X,T)	;Find last occurrence of T in X
	N Y
	Q:X'[T 0
	S Y=1 F  S Y=$F(X,T,Y) Q:'$F(X,T,Y)
	Q Y
	;
CUP(Y,X)	;Cursor positioning
	S DY=IOTM+Y-2,DX=X-1 X IOXY
	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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>