SDUL40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ; 12/1/91
;;5.3;Scheduling;;Aug 13, 1993
;
FIND ; -- find text in list
N START,BEG,SDQUIT,SDULHIT
S DIR(0)="F^2:50",DIR("A")="Search for" S:$D(SDULFIND) DIR("B")=SDULFIND
S DIR("?")="Enter from two to fifty characters."
D ^DIR K DIR I "^"[Y G FINDQ
S SDULFIND=Y,(BEG,START)=SDULBG,FINISH=SDULCNT
F D SEARCH(START,FINISH) D D:SDULHIT UPD(SDULHIT,SDULFIND,"") Q:$D(SDQUIT)
.I 'SDULHIT,BEG=1 D PAUSE^SDUL1 S SDQUIT="" Q
.I SDULHIT,BEG=1,SDULHIT=SDULCNT D PAUSE^SDUL1 S SDQUIT="" Q
.I 'SDULHIT!(SDULHIT=SDULCNT),BEG'=1,$$BEG S FINISH=BEG-1,(BEG,START)=1 Q
.I 'SDULHIT!(SDULHIT=SDULCNT),BEG'=1 S SDQUIT="" Q
.W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Find Next '"_SDULFIND_"'" D ^DIR K DIR
.I Y S START=SDULHIT+1 Q
.S SDQUIT=""
FINDQ D FINISH^SDUL4 Q
;
BEG() ; -- ask if ok to start from top
W !!,"<<< End of list >>>"
S DIR(0)="Y",DIR("A")="Do you want to start at the beginning of the list",DIR("B")="Yes"
D ^DIR K DIR
Q Y
;
SEARCH(START,FINISH) ; -- search to end or first hit
; input: START := line to start search on
; FINISH := line to end search on
;
N Y,X,L,CNT
S SDULHIT="",CNT=0
S SDULBCK="" D:SDULCC RESET^SDUL4 W !,"...searching for '"_SDULFIND_"'"
F I=START:1:FINISH S CNT=CNT+1 W:'(CNT#100) "." I $$UPPER^SDUL1(@SDULAR@(I,0))[$$UPPER^SDUL1(SDULFIND) S SDULHIT=I Q
I 'SDULHIT W *7,!!,"Text not found." G SEARCHQ
I SDULCC D
.I SDULHIT<SDULBG!(SDULHIT>SDULST) S SDULBG=SDULHIT D LST^SDUL4,PAINT^SDUL4
.D UPD(SDULHIT,SDULFIND,"REV")
D PGUPD^SDUL4
I 'SDULCC S SDULBG=SDULHIT D REFRESH^SDUL
SEARCHQ Q
;
UPD(LINE,TEXT,ATTR) ; -- set/unset video attribute on text
; input: LINE := number of line
; TEXT := chars to set attribute on
; ATTR := attribute to use
;
N ATTRON,ATTROFF,Y,LEN,POS
I 'SDULCC G UPDQ
S Y=@SDULAR@(LINE,0),LEN=$L(TEXT),POS=0,(ATTRON,ATTROFF)=""
I ATTR="REV" S ATTRON=IORVON,ATTROFF=IORVOFF
F S POS=$F($$UPPER^SDUL1(Y),$$UPPER^SDUL1(TEXT),POS) Q:'POS D INSTR^SDUL1(ATTRON_$E(Y,POS-LEN,POS-1)_ATTROFF,POS-LEN,SDUL("TM")+(LINE-SDULBG),LEN,0)
UPDQ Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUL40 2161 printed Apr 09, 2024@21:59:45 Page 2
SDUL40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ; 12/1/91
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 ;
FIND ; -- find text in list
+1 NEW START,BEG,SDQUIT,SDULHIT
+2 SET DIR(0)="F^2:50"
SET DIR("A")="Search for"
if $DATA(SDULFIND)
SET DIR("B")=SDULFIND
+3 SET DIR("?")="Enter from two to fifty characters."
+4 DO ^DIR
KILL DIR
IF "^"[Y
GOTO FINDQ
+5 SET SDULFIND=Y
SET (BEG,START)=SDULBG
SET FINISH=SDULCNT
+6 FOR
DO SEARCH(START,FINISH)
Begin DoDot:1
+7 IF 'SDULHIT
IF BEG=1
DO PAUSE^SDUL1
SET SDQUIT=""
QUIT
+8 IF SDULHIT
IF BEG=1
IF SDULHIT=SDULCNT
DO PAUSE^SDUL1
SET SDQUIT=""
QUIT
+9 IF 'SDULHIT!(SDULHIT=SDULCNT)
IF BEG'=1
IF $$BEG
SET FINISH=BEG-1
SET (BEG,START)=1
QUIT
+10 IF 'SDULHIT!(SDULHIT=SDULCNT)
IF BEG'=1
SET SDQUIT=""
QUIT
+11 WRITE !
SET DIR(0)="Y"
SET DIR("B")="Yes"
SET DIR("A")="Find Next '"_SDULFIND_"'"
DO ^DIR
KILL DIR
+12 IF Y
SET START=SDULHIT+1
QUIT
+13 SET SDQUIT=""
End DoDot:1
if SDULHIT
DO UPD(SDULHIT,SDULFIND,"")
if $DATA(SDQUIT)
QUIT
FINDQ DO FINISH^SDUL4
QUIT
+1 ;
BEG() ; -- ask if ok to start from top
+1 WRITE !!,"<<< End of list >>>"
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to start at the beginning of the list"
SET DIR("B")="Yes"
+3 DO ^DIR
KILL DIR
+4 QUIT Y
+5 ;
SEARCH(START,FINISH) ; -- search to end or first hit
+1 ; input: START := line to start search on
+2 ; FINISH := line to end search on
+3 ;
+4 NEW Y,X,L,CNT
+5 SET SDULHIT=""
SET CNT=0
+6 SET SDULBCK=""
if SDULCC
DO RESET^SDUL4
WRITE !,"...searching for '"_SDULFIND_"'"
+7 FOR I=START:1:FINISH
SET CNT=CNT+1
if '(CNT#100)
WRITE "."
IF $$UPPER^SDUL1(@SDULAR@(I,0))[$$UPPER^SDUL1(SDULFIND)
SET SDULHIT=I
QUIT
+8 IF 'SDULHIT
WRITE *7,!!,"Text not found."
GOTO SEARCHQ
+9 IF SDULCC
Begin DoDot:1
+10 IF SDULHIT<SDULBG!(SDULHIT>SDULST)
SET SDULBG=SDULHIT
DO LST^SDUL4
DO PAINT^SDUL4
+11 DO UPD(SDULHIT,SDULFIND,"REV")
End DoDot:1
+12 DO PGUPD^SDUL4
+13 IF 'SDULCC
SET SDULBG=SDULHIT
DO REFRESH^SDUL
SEARCHQ QUIT
+1 ;
UPD(LINE,TEXT,ATTR) ; -- set/unset video attribute on text
+1 ; input: LINE := number of line
+2 ; TEXT := chars to set attribute on
+3 ; ATTR := attribute to use
+4 ;
+5 NEW ATTRON,ATTROFF,Y,LEN,POS
+6 IF 'SDULCC
GOTO UPDQ
+7 SET Y=@SDULAR@(LINE,0)
SET LEN=$LENGTH(TEXT)
SET POS=0
SET (ATTRON,ATTROFF)=""
+8 IF ATTR="REV"
SET ATTRON=IORVON
SET ATTROFF=IORVOFF
+9 FOR
SET POS=$FIND($$UPPER^SDUL1(Y),$$UPPER^SDUL1(TEXT),POS)
if 'POS
QUIT
DO INSTR^SDUL1(ATTRON_$EXTRACT(Y,POS-LEN,POS-1)_ATTROFF,POS-LEN,SDUL("TM")+(LINE-SDULBG),LEN,0)
UPDQ QUIT
+1 ;
