source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDUL40.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SDUL40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ; 12/1/91
2 ;;5.3;Scheduling;;Aug 13, 1993
3 ;
4FIND ; -- find text in list
5 N START,BEG,SDQUIT,SDULHIT
6 S DIR(0)="F^2:50",DIR("A")="Search for" S:$D(SDULFIND) DIR("B")=SDULFIND
7 S DIR("?")="Enter from two to fifty characters."
8 D ^DIR K DIR I "^"[Y G FINDQ
9 S SDULFIND=Y,(BEG,START)=SDULBG,FINISH=SDULCNT
10 F D SEARCH(START,FINISH) D D:SDULHIT UPD(SDULHIT,SDULFIND,"") Q:$D(SDQUIT)
11 .I 'SDULHIT,BEG=1 D PAUSE^SDUL1 S SDQUIT="" Q
12 .I SDULHIT,BEG=1,SDULHIT=SDULCNT D PAUSE^SDUL1 S SDQUIT="" Q
13 .I 'SDULHIT!(SDULHIT=SDULCNT),BEG'=1,$$BEG S FINISH=BEG-1,(BEG,START)=1 Q
14 .I 'SDULHIT!(SDULHIT=SDULCNT),BEG'=1 S SDQUIT="" Q
15 .W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Find Next '"_SDULFIND_"'" D ^DIR K DIR
16 .I Y S START=SDULHIT+1 Q
17 .S SDQUIT=""
18FINDQ D FINISH^SDUL4 Q
19 ;
20BEG() ; -- ask if ok to start from top
21 W !!,"<<< End of list >>>"
22 S DIR(0)="Y",DIR("A")="Do you want to start at the beginning of the list",DIR("B")="Yes"
23 D ^DIR K DIR
24 Q Y
25 ;
26SEARCH(START,FINISH) ; -- search to end or first hit
27 ; input: START := line to start search on
28 ; FINISH := line to end search on
29 ;
30 N Y,X,L,CNT
31 S SDULHIT="",CNT=0
32 S SDULBCK="" D:SDULCC RESET^SDUL4 W !,"...searching for '"_SDULFIND_"'"
33 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
34 I 'SDULHIT W *7,!!,"Text not found." G SEARCHQ
35 I SDULCC D
36 .I SDULHIT<SDULBG!(SDULHIT>SDULST) S SDULBG=SDULHIT D LST^SDUL4,PAINT^SDUL4
37 .D UPD(SDULHIT,SDULFIND,"REV")
38 D PGUPD^SDUL4
39 I 'SDULCC S SDULBG=SDULHIT D REFRESH^SDUL
40SEARCHQ Q
41 ;
42UPD(LINE,TEXT,ATTR) ; -- set/unset video attribute on text
43 ; input: LINE := number of line
44 ; TEXT := chars to set attribute on
45 ; ATTR := attribute to use
46 ;
47 N ATTRON,ATTROFF,Y,LEN,POS
48 I 'SDULCC G UPDQ
49 S Y=@SDULAR@(LINE,0),LEN=$L(TEXT),POS=0,(ATTRON,ATTROFF)=""
50 I ATTR="REV" S ATTRON=IORVON,ATTROFF=IORVOFF
51 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)
52UPDQ Q
53 ;
Note: See TracBrowser for help on using the repository browser.