SDUL4 ;ALB/MJK - Screen Malipulation Utilities ; 12/1/91
;;5.3;Scheduling;;Aug 13, 1993
;
NEXT ; -- display next screen (NX)
N SDULSTO,I,LN
I SDULBG+SDUL("LINES")>SDULCNT W *7 G NEXTQ
S SDULBG=SDULBG+SDUL("LINES")
S SDULSTO=SDULST
I SDULCC D LST,SCROLL D
.S DX=0,DY=SDUL("BM")-1 X IOXY
.S I=SDULSTO+1 F LN=1:1:SDUL("LINES") W !,$G(@SDULAR@(+$$GET(I),0)) S I=I+1
.S SDULBCK="" D PLUS,RESET
D PGUPD
NEXTQ D FINISH Q
;
PREV ; -- display previous screen (BU)
N I,LN,X,Y,SDULBGO
I SDULBG=1 W *7 G PREVQ
S Y=SDULBG-SDUL("LINES")
S SDULBGO=SDULBG,SDULBG=$S(Y<1:1,1:Y)
I SDULCC D LST,SCROLL D
.S DX=0,DY=SDUL("TM")-1
.S I=SDULBGO-1 F LN=1:1:SDUL("LINES") D IOXY W $G(@SDULAR@(+$$GET(I),0)) Q:I=1 S I=I-1
.S SDULBCK="" D PLUS,RESET
D PGUPD
PREVQ D FINISH Q
;
FIRST ; -- display first screen (FS)
I SDULBG=1 W *7 G FIRSTQ
S SDULBG=1
I SDULCC D LST,PAINT
D PGUPD
FIRSTQ D FINISH Q
;
LAST ; -- display last screen (LS)
N Y,I
I SDULCNT'>SDUL("LINES") W *7 G LASTQ
; first line of the last screen :=
; (# of full screens less 1 if last screen is also full) x # lines per screen) + 1 line
S Y=(((SDULCNT\SDUL("LINES"))-'(SDULCNT#SDUL("LINES")))*SDUL("LINES"))+1
I Y=SDULBG W *7 G LASTQ
S SDULBG=Y
I SDULCC D LST,PAINT
D PGUPD
LASTQ D FINISH Q
;
UP ; -- display last screen (UP)
N Y
S Y=SDULBG-1
I Y<1 W *7 G UPQ
S SDULBG=Y D LST
I SDULCC D SCROLL S DX=0,DY=SDUL("TM")-1 D IOXY W $G(@SDULAR@(+$$GET(SDULBG),0)) D PLUS,RESET
D PGUPD
UPQ D FINISH Q
;
DOWN ; -- display next line (DN)
N Y
S Y=SDULST+1
I Y>SDULCNT W *7 G DOWNQ
S SDULBG=SDULBG+1,SDULST=Y
I SDULCC D SCROLL S DX=0,DY=SDUL("BM")-1 X IOXY W !,$G(@SDULAR@(+$$GET(SDULST),0)) D PLUS,RESET
D PGUPD
DOWNQ D FINISH Q
;
FINISH ; -- finish action
S SDULBCK=$S(SDULCC:"",1:"R")
Q
;
PAINT ;
N I,LN,X D SCROLL
I $E(IOST,1,4)="C-VT" S DX=0,DY=SDUL("TM")-1 X IOXY W *27,*91,SDUL("LINES"),*77
S I=SDULBG F LN=1:1:SDUL("LINES") S DX=0,DY=SDUL("TM")+LN-2 D IOXY W $G(@SDULAR@(+$$GET(I),0)) S I=I+1
S SDULBCK="" D PLUS,RESET
Q
;
IOXY ; -- position cursor ; insert line ; cr
W ! X IOXY W IOIL,$C(13)
Q
;
RE ; -- re-display current screen (RE)
D REFRESH^SDUL S SDULBCK=""
Q
;
RESET ; -- reset scrolling region to bottom of screen
S DX=0,DY=SDUL("BM")+1 X IOXY W IOEDEOP
S IOTM=SDUL("BM")+2,IOBM=IOSL W IOSC W @IOSTBM W IORC
D UND($$LOWER^SDUL1($$NOW^SDUL1),31,1,21,0)
I $D(SDULBCK) S DX=0,DY=SDUL("BM") X IOXY
Q
;
SCROLL ; -- set scrolling region to list area
S IOTM=SDUL("TM"),IOBM=SDUL("BM") W IOSC W @IOSTBM W IORC
Q
;
LST ; -- compute last line on screen
N I
S I=SDULBG+SDUL("LINES")-1,SDULST=$S($D(@SDULAR@(+$$GET(I),0)):I,1:SDULCNT)
Q
;
GET(LNUM) ; -- get actual line number (may be different if indexed)
Q $S(SDUL(0)["I":$G(@SDULIDX@(LNUM)),1:LNUM)
;
PLUS ; -- add plus indicators to screen
N UP,DN
S UP=(SDULBG'=1),DN=$S('$D(SDULST):0,SDUL(0)["I":$O(@SDULIDX@(+SDULST))>0,1:$O(@SDULAR@(+SDULST))>0)
I UP'=SDULUP S SDULUP=UP D UND($S(UP:"+",1:" "),1,SDUL("TM")-1,1)
I DN'=SDULDN S SDULDN=DN D UND($S(DN:"+",1:" "),1,SDUL("BM")+1,1)
Q
;
PGUPD ; -- update page var and screen
N P
S P=$$PAGE(SDULBG,SDUL("LINES")) G PGUPDQ:P=SDULPGE
S SDULPGE=P
D:SDULCC UND($J(P,3),71,1,3,0)
PGUPDQ Q
;
PAGE(BEG,LINES) ; -- calc page #
Q (BEG\LINES)+((BEG#LINES)>0)
;
UND(STR,X,Y,LEN,ERASE) ;
W IOUON,$C(13) D INSTR^SDUL1(STR,X,Y,LEN,+$G(ERASE)) W $C(13),IOUOFF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDUL4 3499 printed Apr 09, 2024@21:50:56 Page 2
SDUL4 ;ALB/MJK - Screen Malipulation Utilities ; 12/1/91
+1 ;;5.3;Scheduling;;Aug 13, 1993
+2 ;
NEXT ; -- display next screen (NX)
+1 NEW SDULSTO,I,LN
+2 IF SDULBG+SDUL("LINES")>SDULCNT
WRITE *7
GOTO NEXTQ
+3 SET SDULBG=SDULBG+SDUL("LINES")
+4 SET SDULSTO=SDULST
+5 IF SDULCC
DO LST
DO SCROLL
Begin DoDot:1
+6 SET DX=0
SET DY=SDUL("BM")-1
XECUTE IOXY
+7 SET I=SDULSTO+1
FOR LN=1:1:SDUL("LINES")
WRITE !,$GET(@SDULAR@(+$$GET(I),0))
SET I=I+1
+8 SET SDULBCK=""
DO PLUS
DO RESET
End DoDot:1
+9 DO PGUPD
NEXTQ DO FINISH
QUIT
+1 ;
PREV ; -- display previous screen (BU)
+1 NEW I,LN,X,Y,SDULBGO
+2 IF SDULBG=1
WRITE *7
GOTO PREVQ
+3 SET Y=SDULBG-SDUL("LINES")
+4 SET SDULBGO=SDULBG
SET SDULBG=$SELECT(Y<1:1,1:Y)
+5 IF SDULCC
DO LST
DO SCROLL
Begin DoDot:1
+6 SET DX=0
SET DY=SDUL("TM")-1
+7 SET I=SDULBGO-1
FOR LN=1:1:SDUL("LINES")
DO IOXY
WRITE $GET(@SDULAR@(+$$GET(I),0))
if I=1
QUIT
SET I=I-1
+8 SET SDULBCK=""
DO PLUS
DO RESET
End DoDot:1
+9 DO PGUPD
PREVQ DO FINISH
QUIT
+1 ;
FIRST ; -- display first screen (FS)
+1 IF SDULBG=1
WRITE *7
GOTO FIRSTQ
+2 SET SDULBG=1
+3 IF SDULCC
DO LST
DO PAINT
+4 DO PGUPD
FIRSTQ DO FINISH
QUIT
+1 ;
LAST ; -- display last screen (LS)
+1 NEW Y,I
+2 IF SDULCNT'>SDUL("LINES")
WRITE *7
GOTO LASTQ
+3 ; first line of the last screen :=
+4 ; (# of full screens less 1 if last screen is also full) x # lines per screen) + 1 line
+5 SET Y=(((SDULCNT\SDUL("LINES"))-'(SDULCNT#SDUL("LINES")))*SDUL("LINES"))+1
+6 IF Y=SDULBG
WRITE *7
GOTO LASTQ
+7 SET SDULBG=Y
+8 IF SDULCC
DO LST
DO PAINT
+9 DO PGUPD
LASTQ DO FINISH
QUIT
+1 ;
UP ; -- display last screen (UP)
+1 NEW Y
+2 SET Y=SDULBG-1
+3 IF Y<1
WRITE *7
GOTO UPQ
+4 SET SDULBG=Y
DO LST
+5 IF SDULCC
DO SCROLL
SET DX=0
SET DY=SDUL("TM")-1
DO IOXY
WRITE $GET(@SDULAR@(+$$GET(SDULBG),0))
DO PLUS
DO RESET
+6 DO PGUPD
UPQ DO FINISH
QUIT
+1 ;
DOWN ; -- display next line (DN)
+1 NEW Y
+2 SET Y=SDULST+1
+3 IF Y>SDULCNT
WRITE *7
GOTO DOWNQ
+4 SET SDULBG=SDULBG+1
SET SDULST=Y
+5 IF SDULCC
DO SCROLL
SET DX=0
SET DY=SDUL("BM")-1
XECUTE IOXY
WRITE !,$GET(@SDULAR@(+$$GET(SDULST),0))
DO PLUS
DO RESET
+6 DO PGUPD
DOWNQ DO FINISH
QUIT
+1 ;
FINISH ; -- finish action
+1 SET SDULBCK=$SELECT(SDULCC:"",1:"R")
+2 QUIT
+3 ;
PAINT ;
+1 NEW I,LN,X
DO SCROLL
+2 IF $EXTRACT(IOST,1,4)="C-VT"
SET DX=0
SET DY=SDUL("TM")-1
XECUTE IOXY
WRITE *27,*91,SDUL("LINES"),*77
+3 SET I=SDULBG
FOR LN=1:1:SDUL("LINES")
SET DX=0
SET DY=SDUL("TM")+LN-2
DO IOXY
WRITE $GET(@SDULAR@(+$$GET(I),0))
SET I=I+1
+4 SET SDULBCK=""
DO PLUS
DO RESET
+5 QUIT
+6 ;
IOXY ; -- position cursor ; insert line ; cr
+1 WRITE !
XECUTE IOXY
WRITE IOIL,$CHAR(13)
+2 QUIT
+3 ;
RE ; -- re-display current screen (RE)
+1 DO REFRESH^SDUL
SET SDULBCK=""
+2 QUIT
+3 ;
RESET ; -- reset scrolling region to bottom of screen
+1 SET DX=0
SET DY=SDUL("BM")+1
XECUTE IOXY
WRITE IOEDEOP
+2 SET IOTM=SDUL("BM")+2
SET IOBM=IOSL
WRITE IOSC
WRITE @IOSTBM
WRITE IORC
+3 DO UND($$LOWER^SDUL1($$NOW^SDUL1),31,1,21,0)
+4 IF $DATA(SDULBCK)
SET DX=0
SET DY=SDUL("BM")
XECUTE IOXY
+5 QUIT
+6 ;
SCROLL ; -- set scrolling region to list area
+1 SET IOTM=SDUL("TM")
SET IOBM=SDUL("BM")
WRITE IOSC
WRITE @IOSTBM
WRITE IORC
+2 QUIT
+3 ;
LST ; -- compute last line on screen
+1 NEW I
+2 SET I=SDULBG+SDUL("LINES")-1
SET SDULST=$SELECT($DATA(@SDULAR@(+$$GET(I),0)):I,1:SDULCNT)
+3 QUIT
+4 ;
GET(LNUM) ; -- get actual line number (may be different if indexed)
+1 QUIT $SELECT(SDUL(0)["I":$GET(@SDULIDX@(LNUM)),1:LNUM)
+2 ;
PLUS ; -- add plus indicators to screen
+1 NEW UP,DN
+2 SET UP=(SDULBG'=1)
SET DN=$SELECT('$DATA(SDULST):0,SDUL(0)["I":$ORDER(@SDULIDX@(+SDULST))>0,1:$ORDER(@SDULAR@(+SDULST))>0)
+3 IF UP'=SDULUP
SET SDULUP=UP
DO UND($SELECT(UP:"+",1:" "),1,SDUL("TM")-1,1)
+4 IF DN'=SDULDN
SET SDULDN=DN
DO UND($SELECT(DN:"+",1:" "),1,SDUL("BM")+1,1)
+5 QUIT
+6 ;
PGUPD ; -- update page var and screen
+1 NEW P
+2 SET P=$$PAGE(SDULBG,SDUL("LINES"))
if P=SDULPGE
GOTO PGUPDQ
+3 SET SDULPGE=P
+4 if SDULCC
DO UND($JUSTIFY(P,3),71,1,3,0)
PGUPDQ QUIT
+1 ;
PAGE(BEG,LINES) ; -- calc page #
+1 QUIT (BEG\LINES)+((BEG#LINES)>0)
+2 ;
UND(STR,X,Y,LEN,ERASE) ;
+1 WRITE IOUON,$CHAR(13)
DO INSTR^SDUL1(STR,X,Y,LEN,+$GET(ERASE))
WRITE $CHAR(13),IOUOFF
+2 QUIT
