VALM40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ;01/31/2001 14:45
;;1.0;List Manager;**6**;Aug 13, 1993
FIND ; -- find text in list
N START,BEG,VALMOUT,VALMHIT,X,Y,DIR,DIRUT
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 I $D(DIRUT) D FINISH^VALM4 Q
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 WAIT^VALM1 S VALMOUT="" Q
. I VALMHIT,BEG=1,VALMHIT=VALMCNT D WAIT^VALM1 S VALMOUT="" Q
. I 'VALMHIT!(VALMHIT=VALMCNT),BEG'=1 D Q
. . I '$$BEG S VALMOUT="" Q
. . S FINISH=BEG-1,(BEG,START)=1
. N DIR,X,Y,DIRUT
. W ! S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Find Next '"_VALMFIND_"'"
. D ^DIR I 'Y S VALMOUT="" Q
. S START=VALMHIT+1
D FINISH^VALM4
Q
BEG() ; -- ask if ok to start from top
W !!,"<<< End of list >>>"
N DIR,X,Y,DIRUT
S DIR(0)="Y",DIR("A")="Do you want to start at the beginning of the list",DIR("B")="Yes"
D ^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 $$UP^XLFSTR(@VALMAR@(I,0))[$$UP^XLFSTR(VALMFIND) S VALMHIT=I Q
I 'VALMHIT W $C(7),!!,"Text not found." Q
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
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 Q
S Y=@VALMAR@(LINE,0),LEN=$L(TEXT),POS=0,FIRST=""
F S POS=$F($$UP^XLFSTR(Y),$$UP^XLFSTR(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)
Q
UP ; -- display last screen (UP)
D START^VALM4
N Y S Y=VALMBG-1 I Y<1 W $C(7) D FINISH^VALM4 Q
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
D FINISH^VALM4
Q
DOWN ; -- display next line (DN)
D START^VALM4
N Y S Y=VALMLST+1 I Y>VALMCNT W $C(7) D FINISH^VALM4 Q
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
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 $C(7) D FINISH^VALM4 Q
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
D FINISH^VALM4
Q
LEFT(VALMNOD) ; -- move view to left
D START^VALM4
N MOVE,LM
S MOVE=$P($P(VALMNOD,U,4),"=",3),LM=VALM("FIXED")+1
I VALMLFT=LM W $C(7) D FINISH^VALM4 Q
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
D FINISH^VALM4
Q
GOTO ; -- go to page #
N Y,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
. N DIR,X,Y,DIRUT
. S DIR(0)="NA^1:"_PAGE,DIR("A")="Go to Page (1-"_PAGE_"): "
. W ! D ^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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALM40 4427 printed Jan 18, 2025@03:11:18 Page 2
VALM40 ;ALB/MJK - Screen Malipulation Utilities (cont.) ;01/31/2001 14:45
+1 ;;1.0;List Manager;**6**;Aug 13, 1993
FIND ; -- find text in list
+1 NEW START,BEG,VALMOUT,VALMHIT,X,Y,DIR,DIRUT
+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
IF $DATA(DIRUT)
DO FINISH^VALM4
QUIT
+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 WAIT^VALM1
SET VALMOUT=""
QUIT
+8 IF VALMHIT
IF BEG=1
IF VALMHIT=VALMCNT
DO WAIT^VALM1
SET VALMOUT=""
QUIT
+9 IF 'VALMHIT!(VALMHIT=VALMCNT)
IF BEG'=1
Begin DoDot:2
+10 IF '$$BEG
SET VALMOUT=""
QUIT
+11 SET FINISH=BEG-1
SET (BEG,START)=1
End DoDot:2
QUIT
+12 NEW DIR,X,Y,DIRUT
+13 WRITE !
SET DIR(0)="Y"
SET DIR("B")="Yes"
SET DIR("A")="Find Next '"_VALMFIND_"'"
+14 DO ^DIR
IF 'Y
SET VALMOUT=""
QUIT
+15 SET START=VALMHIT+1
End DoDot:1
if VALMHIT
DO SELECT^VALM10(VALMHIT,0)
if $DATA(VALMOUT)
QUIT
+16 DO FINISH^VALM4
+17 QUIT
BEG() ; -- ask if ok to start from top
+1 WRITE !!,"<<< End of list >>>"
+2 NEW DIR,X,Y,DIRUT
+3 SET DIR(0)="Y"
SET DIR("A")="Do you want to start at the beginning of the list"
SET DIR("B")="Yes"
+4 DO ^DIR
+5 QUIT Y
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 NEW Y,X,L,CNT
+4 SET VALMHIT=""
SET CNT=0
+5 SET VALMBCK=""
if VALMCC
DO RESET^VALM4
WRITE !,"...searching for '"_VALMFIND_"'"
+6 FOR I=START:1:FINISH
SET CNT=CNT+1
if '(CNT#100)
WRITE "."
IF $$UP^XLFSTR(@VALMAR@(I,0))[$$UP^XLFSTR(VALMFIND)
SET VALMHIT=I
QUIT
+7 IF 'VALMHIT
WRITE $CHAR(7),!!,"Text not found."
QUIT
+8 IF VALMCC
Begin DoDot:1
+9 IF VALMHIT<VALMBG!(VALMHIT>VALMLST)
SET VALMBG=VALMHIT
DO LST^VALM4
DO PAINT^VALM4
+10 DO UPD(VALMHIT,VALMFIND)
End DoDot:1
+11 DO PGUPD^VALM4
+12 IF 'VALMCC
SET VALMBG=VALMHIT
DO REFRESH^VALM
+13 QUIT
UPD(LINE,TEXT) ; -- set/unset video attribute on text
+1 ; input: LINE := number of line
+2 ; TEXT := chars to set attribute on
+3 NEW LEN,POS,FIRST
+4 DO SELECT^VALM10(.LINE,1)
+5 IF 'VALMCC
QUIT
+6 SET Y=@VALMAR@(LINE,0)
SET LEN=$LENGTH(TEXT)
SET POS=0
SET FIRST=""
+7 FOR
SET POS=$FIND($$UP^XLFSTR(Y),$$UP^XLFSTR(TEXT),POS)
if 'POS
QUIT
Begin DoDot:1
+8 if 'FIRST
SET FIRST=POS-LEN
+9 DO CNTRL^VALM10(.LINE,POS-LEN,.LEN,.IORVON,IORVOFF_IOINHI)
End DoDot:1
+10 IF FIRST
Begin DoDot:1
+11 IF FIRST'>VALM("FIXED")
QUIT
+12 IF FIRST<VALMLFT
DO LEFT("^^^="_(VALMLFT-FIRST))
QUIT
+13 IF FIRST'>((VALMWD-VALM("FIXED"))+VALMLFT)
QUIT
+14 DO RIGHT("^^^="_(FIRST-VALMLFT))
End DoDot:1
+15 DO WRITE^VALM10(.LINE)
+16 QUIT
UP ; -- display last screen (UP)
+1 DO START^VALM4
+2 NEW Y
SET Y=VALMBG-1
IF Y<1
WRITE $CHAR(7)
DO FINISH^VALM4
QUIT
+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
+6 DO FINISH^VALM4
+7 QUIT
DOWN ; -- display next line (DN)
+1 DO START^VALM4
+2 NEW Y
SET Y=VALMLST+1
IF Y>VALMCNT
WRITE $CHAR(7)
DO FINISH^VALM4
QUIT
+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
+6 DO FINISH^VALM4
+7 QUIT
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 $CHAR(7)
DO FINISH^VALM4
QUIT
+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
+12 DO FINISH^VALM4
+13 QUIT
LEFT(VALMNOD) ; -- move view 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 $CHAR(7)
DO FINISH^VALM4
QUIT
+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
+12 DO FINISH^VALM4
+13 QUIT
GOTO ; -- go to page #
+1 NEW Y,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 NEW DIR,X,Y,DIRUT
+11 SET DIR(0)="NA^1:"_PAGE
SET DIR("A")="Go to Page (1-"_PAGE_"): "
+12 WRITE !
DO ^DIR
SET PAGE=+Y
End DoDot:1
+13 IF PAGE
Begin DoDot:1
+14 SET LINE=((PAGE-1)*VALM("LINES"))+1
+15 IF LINE=VALMBG
SET VALMSG="Your selection is the current screen."
QUIT
+16 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
