SDUL40.m

SDUL40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ; 12/1/91

 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 ;

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

 ;

SDUL40    ;ALB/MJK - Screen Malipulation Utilities (cont.) ; 12/1/91

 +1       ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21

 +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       ;