PRCRIA10 ;TPA/RAK/WASH IRMFO - Header/Footer Boxes ;8/27/96 15:37
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
FTRBOX(FOOTER,CENTER,VALUE) ;Footer box
;--------------------------------------------------------------------
; FOOTER - Text for footer. if none then will default to
; "Press RETURN to continue, '^' to quit".
; CENTER - If not zero then center text.
; VALUE - Value returned to calling rouine.
; "" - if iom or ioxy are not defined
; 0 - if an uparrow '^' is entered
; 1 - if return is entered
;
; ****************** WARNING **********************
; * this subroutine xecutes the variable "IOXY" *
; * to move around the screen - be sure to W @IOF *
; * to clear screen and set $y to zero *
; *************************************************
;--------------------------------------------------------------------
N DIR S VALUE="" Q:'$G(IOM)!($G(IOXY)']"")
; *** for MSM ***
I ^%ZOSF("OS")["MSM" S X=0 X ^%ZOSF("RM")
S FOOTER=$G(FOOTER),CENTER=+$G(CENTER)
I FOOTER']"" S FOOTER="Press RETURN to continue, '^' to quit"
I CENTER S FOOTER=$J(" ",(IOM-$L(FOOTER)/2))_FOOTER
S DX=0,DY=22 X IOXY W $$REPEAT^XLFSTR("_",IOM)
; *** for MSM ***
I ^%ZOSF("OS")["MSM" S X=IOM X ^%ZOSF("RM")
K DIR S DIR(0)="EA",DIR("A")=FOOTER D ^DIR S VALUE=Y
Q
HDRBOX(HEADER,TEXT) ;Header box
;--------------------------------------------------------------------
; HEADER() - Text array to be centered and highlighted at top of box.
; TEXT() - Additional text array to be left justified.
;
; ****************** WARNING **********************
; * this subroutine xecutes the variable "IOXY" *
; * to move around the screen - be sure to W @IOF *
; * to clear screen and set $y to zero *
; *************************************************
;--------------------------------------------------------------------
Q:'$D(HEADER)&('$D(TEXT))
I $G(HEADER)]"",($D(HEADER)=1) S HEADER(1)=HEADER
I $D(TEXT)=1 S TEXT(1)=TEXT
N IOBLC,IOBRC,IOBT,IOG1,IOG0,IOHL,IOLT,IOMT,IORT,IOTLC,IOTRC
N IOTT,IOVL,IORVON,IORVOFF,I,LEN,X
S X="IORVON;IORVOFF" D ENDR^%ZISS,GSET^%ZISS
; *** for MSM ***
I ^%ZOSF("OS")["MSM" S X=0 X ^%ZOSF("RM")
S:$G(IOHL)']"" IOHL="-"
S:$G(IOVL)']"" IOVL="|"
F I="IOBLC","IOBRC","IOG0","IOG1","IOTLC","IOTRC" S @I=$G(@$G(I))
W @IOF,IOG1,IOTLC F I=1:1:(IOM-2) W IOHL
W IOTRC S DY=$Y,I=""
F S I=$O(HEADER(I)) Q:I="" S LEN=$L(HEADER(I)) D
.S DX=0,DY=DY+1 X IOXY W IOVL S DX=(IOM-LEN\2) X IOXY
.W IOG0,IORVON,HEADER(I),IORVOFF,IOG1 S DX=IOM X IOXY W IOVL
S I="" F S I=$O(TEXT(I)) Q:I="" S LEN=$L(TEXT(I)) D
.S DX=0,DY=DY+1 X IOXY W IOVL,IOG0,TEXT(I),IOG1
.S DX=IOM X IOXY W IOVL
S DX=0,DY=DY+1 X IOXY W IOBLC F I=1:1:(IOM-2) W IOHL
S DX=IOM X IOXY W IOBRC
W IOG0
; *** for MSM ***
I ^%ZOSF("OS")["MSM" S X=IOM X ^%ZOSF("RM")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCRIA10 3050 printed Nov 22, 2024@17:27:04 Page 2
PRCRIA10 ;TPA/RAK/WASH IRMFO - Header/Footer Boxes ;8/27/96 15:37
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
FTRBOX(FOOTER,CENTER,VALUE) ;Footer box
+1 ;--------------------------------------------------------------------
+2 ; FOOTER - Text for footer. if none then will default to
+3 ; "Press RETURN to continue, '^' to quit".
+4 ; CENTER - If not zero then center text.
+5 ; VALUE - Value returned to calling rouine.
+6 ; "" - if iom or ioxy are not defined
+7 ; 0 - if an uparrow '^' is entered
+8 ; 1 - if return is entered
+9 ;
+10 ; ****************** WARNING **********************
+11 ; * this subroutine xecutes the variable "IOXY" *
+12 ; * to move around the screen - be sure to W @IOF *
+13 ; * to clear screen and set $y to zero *
+14 ; *************************************************
+15 ;--------------------------------------------------------------------
+16 NEW DIR
SET VALUE=""
if '$GET(IOM)!($GET(IOXY)']"")
QUIT
+17 ; *** for MSM ***
+18 IF ^%ZOSF("OS")["MSM"
SET X=0
XECUTE ^%ZOSF("RM")
+19 SET FOOTER=$GET(FOOTER)
SET CENTER=+$GET(CENTER)
+20 IF FOOTER']""
SET FOOTER="Press RETURN to continue, '^' to quit"
+21 IF CENTER
SET FOOTER=$JUSTIFY(" ",(IOM-$LENGTH(FOOTER)/2))_FOOTER
+22 SET DX=0
SET DY=22
XECUTE IOXY
WRITE $$REPEAT^XLFSTR("_",IOM)
+23 ; *** for MSM ***
+24 IF ^%ZOSF("OS")["MSM"
SET X=IOM
XECUTE ^%ZOSF("RM")
+25 KILL DIR
SET DIR(0)="EA"
SET DIR("A")=FOOTER
DO ^DIR
SET VALUE=Y
+26 QUIT
HDRBOX(HEADER,TEXT) ;Header box
+1 ;--------------------------------------------------------------------
+2 ; HEADER() - Text array to be centered and highlighted at top of box.
+3 ; TEXT() - Additional text array to be left justified.
+4 ;
+5 ; ****************** WARNING **********************
+6 ; * this subroutine xecutes the variable "IOXY" *
+7 ; * to move around the screen - be sure to W @IOF *
+8 ; * to clear screen and set $y to zero *
+9 ; *************************************************
+10 ;--------------------------------------------------------------------
+11 if '$DATA(HEADER)&('$DATA(TEXT))
QUIT
+12 IF $GET(HEADER)]""
IF ($DATA(HEADER)=1)
SET HEADER(1)=HEADER
+13 IF $DATA(TEXT)=1
SET TEXT(1)=TEXT
+14 NEW IOBLC,IOBRC,IOBT,IOG1,IOG0,IOHL,IOLT,IOMT,IORT,IOTLC,IOTRC
+15 NEW IOTT,IOVL,IORVON,IORVOFF,I,LEN,X
+16 SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
DO GSET^%ZISS
+17 ; *** for MSM ***
+18 IF ^%ZOSF("OS")["MSM"
SET X=0
XECUTE ^%ZOSF("RM")
+19 if $GET(IOHL)']""
SET IOHL="-"
+20 if $GET(IOVL)']""
SET IOVL="|"
+21 FOR I="IOBLC","IOBRC","IOG0","IOG1","IOTLC","IOTRC"
SET @I=$GET(@$GET(I))
+22 WRITE @IOF,IOG1,IOTLC
FOR I=1:1:(IOM-2)
WRITE IOHL
+23 WRITE IOTRC
SET DY=$Y
SET I=""
+24 FOR
SET I=$ORDER(HEADER(I))
if I=""
QUIT
SET LEN=$LENGTH(HEADER(I))
Begin DoDot:1
+25 SET DX=0
SET DY=DY+1
XECUTE IOXY
WRITE IOVL
SET DX=(IOM-LEN\2)
XECUTE IOXY
+26 WRITE IOG0,IORVON,HEADER(I),IORVOFF,IOG1
SET DX=IOM
XECUTE IOXY
WRITE IOVL
End DoDot:1
+27 SET I=""
FOR
SET I=$ORDER(TEXT(I))
if I=""
QUIT
SET LEN=$LENGTH(TEXT(I))
Begin DoDot:1
+28 SET DX=0
SET DY=DY+1
XECUTE IOXY
WRITE IOVL,IOG0,TEXT(I),IOG1
+29 SET DX=IOM
XECUTE IOXY
WRITE IOVL
End DoDot:1
+30 SET DX=0
SET DY=DY+1
XECUTE IOXY
WRITE IOBLC
FOR I=1:1:(IOM-2)
WRITE IOHL
+31 SET DX=IOM
XECUTE IOXY
WRITE IOBRC
+32 WRITE IOG0
+33 ; *** for MSM ***
+34 IF ^%ZOSF("OS")["MSM"
SET X=IOM
XECUTE ^%ZOSF("RM")
+35 QUIT
