DDBRS ;SFISC/DCL-SET UP SPLIT SCREEN ;NOV 04, 1996@13:55
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
TB(IOTM,IOBM,TA) ;Set Top and Bottom Margins in Target Array
;pass IOTM, IOBM and TA all by reference **
N I,X
I (((IOBM-IOTM)+1)#2) S IOBM=IOBM-1
S TA(0,"IOTM")=IOTM
S TA(0,"IOBM")=IOBM
ETA S X=((IOBM+1)-(IOTM-1)\2)-2
S TA(1,"IOTM")=IOTM
S TA(1,"IOBM")=IOTM+X
S TA(2,"IOBM")=IOBM
S TA(2,"IOTM")=IOBM-X
ETB D
.N IOTM,IOBM
.F I=+$G(I):1:2 S IOTM=TA(I,"IOTM"),IOBM=TA(I,"IOBM") D
..S TA(I,"DDBSY")=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM)
..S TA(I,"DDBSRL")=(IOBM-IOTM)+1
..Q
.Q
Q
;
ENTB(TA,DDBLD) ;called to reset DDBSY and DDBSRL for resizing split screen
;TA PASSED BY REFERENCE
N I
S I=1
D ETB
F I=1,2 S TA(I,"DDBTPG")=TA(I,"DDBTL")\TA(I,"DDBSRL")+(TA(I,"DDBTL")#TA(I,"DDBSRL")'<1)
F I="DDBTPG","DDBSY","DDBSRL" S @I=TA(TA,I)
I DDBLD<0 S TA(1,"DDBL")=TA(1,"DDBL")-$S(TA(1,"DDBL")>0:1,1:0) Q
S TA(1,"DDBL")=TA(1,"DDBL")+$S(TA(1,"DDBL")<TA(1,"DDBTL"):1,1:0) Q
Q
;
INIT(SUB,TA) ;Finish saving variables for TA pass TA by reference **
N I G:$G(SUB)]"" SUB
F SUB=1,2 D SUB
Q
SUB F I="DDBSRL","DDBHDR","DDBHDRC","DDBTL","DDBSA","DDBSF","DDBST","DDBZN","DDBDM","DDBC","DDBPSA","DDBRPE","DDBPMSG","DDBTPG" S TA(SUB,I)=@I
S TA(SUB,"DDBL")=+$G(DDBL)
Q
;
SR(X,Y,ARRAY) ;Save, Restore, Array - Pass Array by reference **
D INIT(X,.ARRAY)
S X=""
F S X=$O(ARRAY(Y,X)) Q:X="" S @X=ARRAY(Y,X)
S ARRAY=Y ;* * active array * *
Q
;
FULL(TA) ;Full Screen
;TA passed by reference
I TA=1 S DDBL=DDBL+(DDBSRL+2)
N I,X
F I="IOBM","IOTM","DDBSY","DDBSRL" S @I=TA(0,I)
S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
S I=1 D ETA
W @IOSTBM
S TA=0 ;* * active array * *
S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL
D PSR^DDBR0(1)
Q
;
SPLIT ;Split Screen
N I
F I="IOBM","IOTM","DDBSY","DDBSRL" S @I=DDBRSA(2,I)
S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
S I=1
D INIT("",.DDBRSA)
W @IOSTBM
S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL
D PSR^DDBR0(1)
D SR(2,1,.DDBRSA)
W @IOSTBM
S DDBL=DDBL-(DDBSRL+2),DDBRSA(1,"DDBL")=DDBL
S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL
D PSR^DDBR0(1)
Q
;
;;NOTE: DDBRSA=0 - full screen
;; DDBRSA=1 - top of split screen
;; DDBRSA=2 - bottom of split screen
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDBRS 2623 printed Dec 13, 2024@02:41:54 Page 2
DDBRS ;SFISC/DCL-SET UP SPLIT SCREEN ;NOV 04, 1996@13:55
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
TB(IOTM,IOBM,TA) ;Set Top and Bottom Margins in Target Array
+1 ;pass IOTM, IOBM and TA all by reference **
+2 NEW I,X
+3 IF (((IOBM-IOTM)+1)#2)
SET IOBM=IOBM-1
+4 SET TA(0,"IOTM")=IOTM
+5 SET TA(0,"IOBM")=IOBM
ETA SET X=((IOBM+1)-(IOTM-1)\2)-2
+1 SET TA(1,"IOTM")=IOTM
+2 SET TA(1,"IOBM")=IOTM+X
+3 SET TA(2,"IOBM")=IOBM
+4 SET TA(2,"IOTM")=IOBM-X
ETB Begin DoDot:1
+1 NEW IOTM,IOBM
+2 FOR I=+$GET(I):1:2
SET IOTM=TA(I,"IOTM")
SET IOBM=TA(I,"IOBM")
Begin DoDot:2
+3 SET TA(I,"DDBSY")=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM)
+4 SET TA(I,"DDBSRL")=(IOBM-IOTM)+1
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
ENTB(TA,DDBLD) ;called to reset DDBSY and DDBSRL for resizing split screen
+1 ;TA PASSED BY REFERENCE
+2 NEW I
+3 SET I=1
+4 DO ETB
+5 FOR I=1,2
SET TA(I,"DDBTPG")=TA(I,"DDBTL")\TA(I,"DDBSRL")+(TA(I,"DDBTL")#TA(I,"DDBSRL")'<1)
+6 FOR I="DDBTPG","DDBSY","DDBSRL"
SET @I=TA(TA,I)
+7 IF DDBLD<0
SET TA(1,"DDBL")=TA(1,"DDBL")-$SELECT(TA(1,"DDBL")>0:1,1:0)
QUIT
+8 SET TA(1,"DDBL")=TA(1,"DDBL")+$SELECT(TA(1,"DDBL")<TA(1,"DDBTL"):1,1:0)
QUIT
+9 QUIT
+10 ;
INIT(SUB,TA) ;Finish saving variables for TA pass TA by reference **
+1 NEW I
if $GET(SUB)]""
GOTO SUB
+2 FOR SUB=1,2
DO SUB
+3 QUIT
SUB FOR I="DDBSRL","DDBHDR","DDBHDRC","DDBTL","DDBSA","DDBSF","DDBST","DDBZN","DDBDM","DDBC","DDBPSA","DDBRPE","DDBPMSG","DDBTPG"
SET TA(SUB,I)=@I
+1 SET TA(SUB,"DDBL")=+$GET(DDBL)
+2 QUIT
+3 ;
SR(X,Y,ARRAY) ;Save, Restore, Array - Pass Array by reference **
+1 DO INIT(X,.ARRAY)
+2 SET X=""
+3 FOR
SET X=$ORDER(ARRAY(Y,X))
if X=""
QUIT
SET @X=ARRAY(Y,X)
+4 ;* * active array * *
SET ARRAY=Y
+5 QUIT
+6 ;
FULL(TA) ;Full Screen
+1 ;TA passed by reference
+2 IF TA=1
SET DDBL=DDBL+(DDBSRL+2)
+3 NEW I,X
+4 FOR I="IOBM","IOTM","DDBSY","DDBSRL"
SET @I=TA(0,I)
+5 SET DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
+6 SET I=1
DO ETA
+7 WRITE @IOSTBM
+8 ;* * active array * *
SET TA=0
+9 SET DDBL=$GET(DDBL,0)
if DDBL<0
SET DDBL=0
if DDBL>DDBTL
SET DDBL=DDBTL
+10 DO PSR^DDBR0(1)
+11 QUIT
+12 ;
SPLIT ;Split Screen
+1 NEW I
+2 FOR I="IOBM","IOTM","DDBSY","DDBSRL"
SET @I=DDBRSA(2,I)
+3 SET DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
+4 SET I=1
+5 DO INIT("",.DDBRSA)
+6 WRITE @IOSTBM
+7 SET DDBL=$GET(DDBL,0)
if DDBL<0
SET DDBL=0
if DDBL>DDBTL
SET DDBL=DDBTL
+8 DO PSR^DDBR0(1)
+9 DO SR(2,1,.DDBRSA)
+10 WRITE @IOSTBM
+11 SET DDBL=DDBL-(DDBSRL+2)
SET DDBRSA(1,"DDBL")=DDBL
+12 SET DDBL=$GET(DDBL,0)
if DDBL<0
SET DDBL=0
if DDBL>DDBTL
SET DDBL=DDBTL
+13 DO PSR^DDBR0(1)
+14 QUIT
+15 ;
+16 ;;NOTE: DDBRSA=0 - full screen
+17 ;; DDBRSA=1 - top of split screen
+18 ;; DDBRSA=2 - bottom of split screen
