| [613] | 1 | PRCRIA10 ;TPA/RAK/WASH IRMFO - Header/Footer Boxes ;8/27/96 15:37
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | FTRBOX(FOOTER,CENTER,VALUE) ;Footer box
|
|---|
| 5 | ;--------------------------------------------------------------------
|
|---|
| 6 | ; FOOTER - Text for footer. if none then will default to
|
|---|
| 7 | ; "Press RETURN to continue, '^' to quit".
|
|---|
| 8 | ; CENTER - If not zero then center text.
|
|---|
| 9 | ; VALUE - Value returned to calling rouine.
|
|---|
| 10 | ; "" - if iom or ioxy are not defined
|
|---|
| 11 | ; 0 - if an uparrow '^' is entered
|
|---|
| 12 | ; 1 - if return is entered
|
|---|
| 13 | ;
|
|---|
| 14 | ; ****************** WARNING **********************
|
|---|
| 15 | ; * this subroutine xecutes the variable "IOXY" *
|
|---|
| 16 | ; * to move around the screen - be sure to W @IOF *
|
|---|
| 17 | ; * to clear screen and set $y to zero *
|
|---|
| 18 | ; *************************************************
|
|---|
| 19 | ;--------------------------------------------------------------------
|
|---|
| 20 | N DIR S VALUE="" Q:'$G(IOM)!($G(IOXY)']"")
|
|---|
| 21 | ; *** for MSM ***
|
|---|
| 22 | I ^%ZOSF("OS")["MSM" S X=0 X ^%ZOSF("RM")
|
|---|
| 23 | S FOOTER=$G(FOOTER),CENTER=+$G(CENTER)
|
|---|
| 24 | I FOOTER']"" S FOOTER="Press RETURN to continue, '^' to quit"
|
|---|
| 25 | I CENTER S FOOTER=$J(" ",(IOM-$L(FOOTER)/2))_FOOTER
|
|---|
| 26 | S DX=0,DY=22 X IOXY W $$REPEAT^XLFSTR("_",IOM)
|
|---|
| 27 | ; *** for MSM ***
|
|---|
| 28 | I ^%ZOSF("OS")["MSM" S X=IOM X ^%ZOSF("RM")
|
|---|
| 29 | K DIR S DIR(0)="EA",DIR("A")=FOOTER D ^DIR S VALUE=Y
|
|---|
| 30 | Q
|
|---|
| 31 | HDRBOX(HEADER,TEXT) ;Header box
|
|---|
| 32 | ;--------------------------------------------------------------------
|
|---|
| 33 | ; HEADER() - Text array to be centered and highlighted at top of box.
|
|---|
| 34 | ; TEXT() - Additional text array to be left justified.
|
|---|
| 35 | ;
|
|---|
| 36 | ; ****************** WARNING **********************
|
|---|
| 37 | ; * this subroutine xecutes the variable "IOXY" *
|
|---|
| 38 | ; * to move around the screen - be sure to W @IOF *
|
|---|
| 39 | ; * to clear screen and set $y to zero *
|
|---|
| 40 | ; *************************************************
|
|---|
| 41 | ;--------------------------------------------------------------------
|
|---|
| 42 | Q:'$D(HEADER)&('$D(TEXT))
|
|---|
| 43 | I $G(HEADER)]"",($D(HEADER)=1) S HEADER(1)=HEADER
|
|---|
| 44 | I $D(TEXT)=1 S TEXT(1)=TEXT
|
|---|
| 45 | N IOBLC,IOBRC,IOBT,IOG1,IOG0,IOHL,IOLT,IOMT,IORT,IOTLC,IOTRC
|
|---|
| 46 | N IOTT,IOVL,IORVON,IORVOFF,I,LEN,X
|
|---|
| 47 | S X="IORVON;IORVOFF" D ENDR^%ZISS,GSET^%ZISS
|
|---|
| 48 | ; *** for MSM ***
|
|---|
| 49 | I ^%ZOSF("OS")["MSM" S X=0 X ^%ZOSF("RM")
|
|---|
| 50 | S:$G(IOHL)']"" IOHL="-"
|
|---|
| 51 | S:$G(IOVL)']"" IOVL="|"
|
|---|
| 52 | F I="IOBLC","IOBRC","IOG0","IOG1","IOTLC","IOTRC" S @I=$G(@$G(I))
|
|---|
| 53 | W @IOF,IOG1,IOTLC F I=1:1:(IOM-2) W IOHL
|
|---|
| 54 | W IOTRC S DY=$Y,I=""
|
|---|
| 55 | F S I=$O(HEADER(I)) Q:I="" S LEN=$L(HEADER(I)) D
|
|---|
| 56 | .S DX=0,DY=DY+1 X IOXY W IOVL S DX=(IOM-LEN\2) X IOXY
|
|---|
| 57 | .W IOG0,IORVON,HEADER(I),IORVOFF,IOG1 S DX=IOM X IOXY W IOVL
|
|---|
| 58 | S I="" F S I=$O(TEXT(I)) Q:I="" S LEN=$L(TEXT(I)) D
|
|---|
| 59 | .S DX=0,DY=DY+1 X IOXY W IOVL,IOG0,TEXT(I),IOG1
|
|---|
| 60 | .S DX=IOM X IOXY W IOVL
|
|---|
| 61 | S DX=0,DY=DY+1 X IOXY W IOBLC F I=1:1:(IOM-2) W IOHL
|
|---|
| 62 | S DX=IOM X IOXY W IOBRC
|
|---|
| 63 | W IOG0
|
|---|
| 64 | ; *** for MSM ***
|
|---|
| 65 | I ^%ZOSF("OS")["MSM" S X=IOM X ^%ZOSF("RM")
|
|---|
| 66 | Q
|
|---|
