VALM40.m

VALM40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ;11:25 PM  11 Dec 1992 [ 07/24/98  9:29 AM ]

 ;;1;List Manager;**1002**;Aug 13, 1993

 ;IHS/ANMC/LJF 5/6/97 IHS PATCH #1002

 ;  -- changed "find next" prompt to "stop here"

 ;

FIND ; -- find text in list

 N START,BEG,VALMOUT,VALMHIT

 S DIR(0)="F^2:50",DIR("A")="Search for" S:$D(VALMFIND) DIR("B")=VALMFIND

 S DIR("?")="Enter from two to fifty characters."

 D ^DIR K DIR I "^"[Y G FINDQ

 S VALMFIND=Y,(BEG,START)=VALMBG,FINISH=VALMCNT

 F  D SEARCH(START,FINISH) D  D:VALMHIT SELECT^VALM10(VALMHIT,0) Q:$D(VALMOUT)

 .I 'VALMHIT,BEG=1 D PAUSE^VALM1 S VALMOUT="" Q

 .I VALMHIT,BEG=1,VALMHIT=VALMCNT D PAUSE^VALM1 S VALMOUT="" Q

 .I 'VALMHIT!(VALMHIT=VALMCNT),BEG'=1,$$BEG S FINISH=BEG-1,(BEG,START)=1 Q

 .I 'VALMHIT!(VALMHIT=VALMCNT),BEG'=1 S VALMOUT="" Q

 .;W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Find Next '"_VALMFIND_"'" D ^DIR K DIR ;IHS PATCH #1002

 .;I Y S START=VALMHIT+1 Q ;IHS PATCH #1002

 .W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Stop Here" D ^DIR K DIR ;IHS PATCH #1002

 .I 'Y S START=VALMHIT+1 Q  ;IHS PATCH #1002

 .S VALMOUT=""

FINDQ D FINISH^VALM4 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 VALMHIT="",CNT=0

 S VALMBCK="" D:VALMCC RESET^VALM4 W !,"...searching for '"_VALMFIND_"'"

 F I=START:1:FINISH S CNT=CNT+1 W:'(CNT#100) "." I $$UPPER^VALM1(@VALMAR@(I,0))[$$UPPER^VALM1(VALMFIND) S VALMHIT=I Q

 I 'VALMHIT W *7,!!,"Text not found." G SEARCHQ

 I VALMCC D

 .I VALMHIT<VALMBG!(VALMHIT>VALMLST) S VALMBG=VALMHIT D LST^VALM4,PAINT^VALM4

 .D UPD(VALMHIT,VALMFIND)

 D PGUPD^VALM4

 I 'VALMCC S VALMBG=VALMHIT D REFRESH^VALM

SEARCHQ Q

 ;

UPD(LINE,TEXT) ; -- set/unset video attribute on text

 ;  input:    LINE := number of line

 ;            TEXT := chars to set attribute on

 ;

 N LEN,POS,FIRST

 D SELECT^VALM10(.LINE,1)

 I 'VALMCC G UPDQ

 S Y=@VALMAR@(LINE,0),LEN=$L(TEXT),POS=0,FIRST=""

 F  S POS=$F($$UPPER^VALM1(Y),$$UPPER^VALM1(TEXT),POS) Q:'POS  D

 .S:'FIRST FIRST=POS-LEN

 .D CNTRL^VALM10(.LINE,POS-LEN,.LEN,.IORVON,IORVOFF_IOINHI)

 I FIRST D

 .I FIRST'>VALM("FIXED") Q

 .I FIRST<VALMLFT D LEFT("^^^="_(VALMLFT-FIRST)) Q

 .I FIRST'>((VALMWD-VALM("FIXED"))+VALMLFT) Q

 .D RIGHT("^^^="_(FIRST-VALMLFT))

 D WRITE^VALM10(.LINE)

UPDQ Q

 ;

UP ; -- display last screen (UP)

 D START^VALM4

 N Y S Y=VALMBG-1 I Y<1 W *7 G UPQ

 S VALMBG=Y D LST^VALM4

 I VALMCC S DY=VALM("TM")-1 D SCROLL^VALM4,IOIL^VALM4(0,.DY),WRITE^VALM4(VALMBG,0,1,.DY),PLUS^VALM4,RESET^VALM4

 D PGUPD^VALM4

UPQ D FINISH^VALM4 Q

 ;

DOWN ; -- display next line (DN)

 D START^VALM4

 N Y S Y=VALMLST+1 I Y>VALMCNT W *7 G DOWNQ

 S VALMBG=VALMBG+1,VALMLST=Y

 I VALMCC S DY=VALM("BM")-1 D SCROLL^VALM4,IOXY^VALM4(0,.DY),WRITE^VALM4(VALMLST,1,1,.DY),PLUS^VALM4,RESET^VALM4

 D PGUPD^VALM4

DOWNQ D FINISH^VALM4 Q

 ;

RIGHT(VALMNOD) ; -- move view to right

 D START^VALM4

 N MOVE,RM

 S MOVE=$P($P(VALMNOD,U,4),"=",3),RM=VALM("RM")-VALMWD+VALM("FIXED")

 I VALMLFT=RM W *7 G RIGHTQ

 I MOVE?1">".E D

 .S VALMLFT=RM

 E  D

 .S MOVE=$S(MOVE:+MOVE,1:VALMWD-VALM("FIXED"))

 .I (VALMLFT+MOVE)>RM S VALMLFT=RM Q

 .S VALMLFT=VALMLFT+MOVE

 I VALMCC S:VALMWD'<$L($G(VALMHDR(VALM("TM")-3))) VALMBCK="P" D REFRESH^VALM

RIGHTQ D FINISH^VALM4 Q

 ;

LEFT(VALMNOD) ; -- move veiw to left

 D START^VALM4

 N MOVE,LM

 S MOVE=$P($P(VALMNOD,U,4),"=",3),LM=VALM("FIXED")+1

 I VALMLFT=LM W *7 G LEFTQ

 I MOVE?1"<".E D

 .S VALMLFT=LM

 E  D

 .S MOVE=$S(MOVE:+MOVE,1:VALMWD-VALM("FIXED"))

 .S:(VALMLFT-MOVE)<LM MOVE=VALMLFT-VALM("FIXED")-1

 .S VALMLFT=VALMLFT-MOVE

 I VALMCC S:VALMWD'<$L($G(VALMHDR(VALM("TM")-3))) VALMBCK="P" D REFRESH^VALM

LEFTQ D FINISH^VALM4 Q

 ;

GOTO ; -- go to page #

 N Y,DIR,PAGE,LINE

 S PAGE=$$PAGE^VALM4(VALMCNT,VALM("LINES"))

 I PAGE=1 S VALMSG="This list only contains 1 page." G GOTOQ

 S Y=+$P($P(XQORNOD(0),U,4),"=",3)

 I Y D  I $G(VALMSG)]"" G GOTOQ

 .I Y>PAGE S VALMSG="Too large. Page #"_Y_" does not exist." Q

 .I Y<1 S VALMSG="Negative page numbers do not exist." Q

 .S PAGE=Y

 I 'Y D

 .S DIR(0)="NA^1:"_PAGE,DIR("A")="Go to Page (1-"_PAGE_"): "

 .W ! D ^DIR K DIR S PAGE=+Y

 I PAGE D

 .S LINE=((PAGE-1)*VALM("LINES"))+1

 .I LINE=VALMBG S VALMSG="Your selection is the current screen." Q

 .I LINE'=VALMBG S VALMBG=LINE D:VALMCC LST^VALM4,PAINT^VALM4 D PGUPD^VALM4

GOTOQ I $G(VALMSG)]"" S VALMSG=$C(7)_VALMSG

 D FINISH^VALM4

 Q

VALM40    ;ALB/MJK - Screen Malipulation Utilities (cont.) ;11:25 PM  11 Dec 1992 [ 07/24/98  9:29 AM ]

 +1       ;;1;List Manager;**1002**;Aug 13, 1993

 +2       ;IHS/ANMC/LJF 5/6/97 IHS PATCH #1002

 +3       ;  -- changed "find next" prompt to "stop here"

 +4       ;

FIND      ; -- find text in list

 +1        NEW START,BEG,VALMOUT,VALMHIT

 +2        SET DIR(0)="F^2:50"

           SET DIR("A")="Search for"

           IF $DATA(VALMFIND)

               SET DIR("B")=VALMFIND

 +3        SET DIR("?")="Enter from two to fifty characters."

 +4        DO ^DIR

           KILL DIR

           IF "^"[Y

               GOTO FINDQ

 +5        SET VALMFIND=Y

           SET (BEG,START)=VALMBG

           SET FINISH=VALMCNT

 +6        FOR 

               DO SEARCH(START,FINISH)

               Begin DoDot:1

 +7                IF 'VALMHIT

                       IF BEG=1

                           DO PAUSE^VALM1

                           SET VALMOUT=""

                           QUIT 

 +8                IF VALMHIT

                       IF BEG=1

                           IF VALMHIT=VALMCNT

                               DO PAUSE^VALM1

                               SET VALMOUT=""

                               QUIT 

 +9                IF 'VALMHIT!(VALMHIT=VALMCNT)

                       IF BEG'=1

                           IF $$BEG

                               SET FINISH=BEG-1

                               SET (BEG,START)=1

                               QUIT 

 +10               IF 'VALMHIT!(VALMHIT=VALMCNT)

                       IF BEG'=1

                           SET VALMOUT=""

                           QUIT 

 +11      ;W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Find Next '"_VALMFIND_"'" D ^DIR K DIR ;IHS PATCH #1002

 +12      ;I Y S START=VALMHIT+1 Q ;IHS PATCH #1002

 +13      ;IHS PATCH #1002

                   WRITE !

                   SET DIR(0)="Y"

                   SET DIR("B")="Yes"

                   SET DIR("A")="Stop Here"

                   DO ^DIR

                   KILL DIR

 +14      ;IHS PATCH #1002

                   IF 'Y

                       SET START=VALMHIT+1

                       QUIT 

 +15               SET VALMOUT=""

               End DoDot:1

               IF VALMHIT

                   DO SELECT^VALM10(VALMHIT,0)

               IF $DATA(VALMOUT)

                   QUIT 

FINDQ      DO FINISH^VALM4

           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 VALMHIT=""

           SET CNT=0

 +6        SET VALMBCK=""

           IF VALMCC

               DO RESET^VALM4

           WRITE !,"...searching for '"_VALMFIND_"'"

 +7        FOR I=START:1:FINISH

               SET CNT=CNT+1

               IF '(CNT#100)

                   WRITE "."

               IF $$UPPER^VALM1(@VALMAR@(I,0))[$$UPPER^VALM1(VALMFIND)

                   SET VALMHIT=I

                   QUIT 

 +8        IF 'VALMHIT

               WRITE *7,!!,"Text not found."

               GOTO SEARCHQ

 +9        IF VALMCC

               Begin DoDot:1

 +10               IF VALMHIT<VALMBG!(VALMHIT>VALMLST)

                       SET VALMBG=VALMHIT

                       DO LST^VALM4

                       DO PAINT^VALM4

 +11               DO UPD(VALMHIT,VALMFIND)

               End DoDot:1

 +12       DO PGUPD^VALM4

 +13       IF 'VALMCC

               SET VALMBG=VALMHIT

               DO REFRESH^VALM

SEARCHQ    QUIT 

 +1       ;

UPD(LINE,TEXT) ; -- set/unset video attribute on text

 +1       ;  input:    LINE := number of line

 +2       ;            TEXT := chars to set attribute on

 +3       ;

 +4        NEW LEN,POS,FIRST

 +5        DO SELECT^VALM10(.LINE,1)

 +6        IF 'VALMCC

               GOTO UPDQ

 +7        SET Y=@VALMAR@(LINE,0)

           SET LEN=$LENGTH(TEXT)

           SET POS=0

           SET FIRST=""

 +8        FOR 

               SET POS=$FIND($$UPPER^VALM1(Y),$$UPPER^VALM1(TEXT),POS)

               IF 'POS

                   QUIT 

               Begin DoDot:1

 +9                IF 'FIRST

                       SET FIRST=POS-LEN

 +10               DO CNTRL^VALM10(.LINE,POS-LEN,.LEN,.IORVON,IORVOFF_IOINHI)

               End DoDot:1

 +11       IF FIRST

               Begin DoDot:1

 +12               IF FIRST'>VALM("FIXED")

                       QUIT 

 +13               IF FIRST<VALMLFT

                       DO LEFT("^^^="_(VALMLFT-FIRST))

                       QUIT 

 +14               IF FIRST'>((VALMWD-VALM("FIXED"))+VALMLFT)

                       QUIT 

 +15               DO RIGHT("^^^="_(FIRST-VALMLFT))

               End DoDot:1

 +16       DO WRITE^VALM10(.LINE)

UPDQ       QUIT 

 +1       ;

UP        ; -- display last screen (UP)

 +1        DO START^VALM4

 +2        NEW Y

           SET Y=VALMBG-1

           IF Y<1

               WRITE *7

               GOTO UPQ

 +3        SET VALMBG=Y

           DO LST^VALM4

 +4        IF VALMCC

               SET DY=VALM("TM")-1

               DO SCROLL^VALM4

               DO IOIL^VALM4(0,.DY)

               DO WRITE^VALM4(VALMBG,0,1,.DY)

               DO PLUS^VALM4

               DO RESET^VALM4

 +5        DO PGUPD^VALM4

UPQ        DO FINISH^VALM4

           QUIT 

 +1       ;

DOWN      ; -- display next line (DN)

 +1        DO START^VALM4

 +2        NEW Y

           SET Y=VALMLST+1

           IF Y>VALMCNT

               WRITE *7

               GOTO DOWNQ

 +3        SET VALMBG=VALMBG+1

           SET VALMLST=Y

 +4        IF VALMCC

               SET DY=VALM("BM")-1

               DO SCROLL^VALM4

               DO IOXY^VALM4(0,.DY)

               DO WRITE^VALM4(VALMLST,1,1,.DY)

               DO PLUS^VALM4

               DO RESET^VALM4

 +5        DO PGUPD^VALM4

DOWNQ      DO FINISH^VALM4

           QUIT 

 +1       ;

RIGHT(VALMNOD) ; -- move view to right

 +1        DO START^VALM4

 +2        NEW MOVE,RM

 +3        SET MOVE=$PIECE($PIECE(VALMNOD,U,4),"=",3)

           SET RM=VALM("RM")-VALMWD+VALM("FIXED")

 +4        IF VALMLFT=RM

               WRITE *7

               GOTO RIGHTQ

 +5        IF MOVE?1">".E

               Begin DoDot:1

 +6                SET VALMLFT=RM

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                SET MOVE=$SELECT(MOVE:+MOVE,1:VALMWD-VALM("FIXED"))

 +9                IF (VALMLFT+MOVE)>RM

                       SET VALMLFT=RM

                       QUIT 

 +10               SET VALMLFT=VALMLFT+MOVE

               End DoDot:1

 +11       IF VALMCC

               IF VALMWD'<$LENGTH($GET(VALMHDR(VALM("TM")-3)))

                   SET VALMBCK="P"

               DO REFRESH^VALM

RIGHTQ     DO FINISH^VALM4

           QUIT 

 +1       ;

LEFT(VALMNOD) ; -- move veiw to left

 +1        DO START^VALM4

 +2        NEW MOVE,LM

 +3        SET MOVE=$PIECE($PIECE(VALMNOD,U,4),"=",3)

           SET LM=VALM("FIXED")+1

 +4        IF VALMLFT=LM

               WRITE *7

               GOTO LEFTQ

 +5        IF MOVE?1"<".E

               Begin DoDot:1

 +6                SET VALMLFT=LM

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                SET MOVE=$SELECT(MOVE:+MOVE,1:VALMWD-VALM("FIXED"))

 +9                IF (VALMLFT-MOVE)<LM

                       SET MOVE=VALMLFT-VALM("FIXED")-1

 +10               SET VALMLFT=VALMLFT-MOVE

               End DoDot:1

 +11       IF VALMCC

               IF VALMWD'<$LENGTH($GET(VALMHDR(VALM("TM")-3)))

                   SET VALMBCK="P"

               DO REFRESH^VALM

LEFTQ      DO FINISH^VALM4

           QUIT 

 +1       ;

GOTO      ; -- go to page #

 +1        NEW Y,DIR,PAGE,LINE

 +2        SET PAGE=$$PAGE^VALM4(VALMCNT,VALM("LINES"))

 +3        IF PAGE=1

               SET VALMSG="This list only contains 1 page."

               GOTO GOTOQ

 +4        SET Y=+$PIECE($PIECE(XQORNOD(0),U,4),"=",3)

 +5        IF Y

               Begin DoDot:1

 +6                IF Y>PAGE

                       SET VALMSG="Too large. Page #"_Y_" does not exist."

                       QUIT 

 +7                IF Y<1

                       SET VALMSG="Negative page numbers do not exist."

                       QUIT 

 +8                SET PAGE=Y

               End DoDot:1

               IF $GET(VALMSG)]""

                   GOTO GOTOQ

 +9        IF 'Y

               Begin DoDot:1

 +10               SET DIR(0)="NA^1:"_PAGE

                   SET DIR("A")="Go to Page (1-"_PAGE_"): "

 +11               WRITE !

                   DO ^DIR

                   KILL DIR

                   SET PAGE=+Y

               End DoDot:1

 +12       IF PAGE

               Begin DoDot:1

 +13               SET LINE=((PAGE-1)*VALM("LINES"))+1

 +14               IF LINE=VALMBG

                       SET VALMSG="Your selection is the current screen."

                       QUIT 

 +15               IF LINE'=VALMBG

                       SET VALMBG=LINE

                       IF VALMCC

                           DO LST^VALM4

                           DO PAINT^VALM4

                       DO PGUPD^VALM4

               End DoDot:1

GOTOQ      IF $GET(VALMSG)]""

               SET VALMSG=$CHAR(7)_VALMSG

 +1        DO FINISH^VALM4

 +2        QUIT