- 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 Feb 19, 2025@00:28:17 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