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