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
