PRCRIA10.m

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 ---PRCRIA10   3050     printed  Mar 13, 2025@21:21:48                                                                                                                                                                                                    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