BUDBAN.m

BUDBAN ; IHS/CMI/LAB - Banner routine for UDS package ;

 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 ;

 ;Writes all menu banners.

EP ;EP

V ; GET VERSION

 S BUD("VERSION")="",BUD("VERSION")=$O(^DIC(9.4,"C","BUD",BUD("VERSION"))),BUD("VERSION")=^DIC(9.4,BUD("VERSION"),"VERSION")

 I $G(BUDTEXT)="" S BUDTEXT="TEXT",BUDLINE=3 G PRINT

 S BUDTEXT="TEXT"_BUDTEXT

 F BUDJ=1:1 S BUDX=$T(@BUDTEXT+BUDJ),BUDX=$P(BUDX,";;",2) Q:BUDX="QUIT"!(BUDX="")  S BUDLINE=BUDJ

PRINT W:$D(IOF) @IOF

 F BUDJ=1:1:BUDLINE S BUDX=$T(@BUDTEXT+BUDJ),BUDX=$P(BUDX,";;",2) W !?80-$L(BUDX)\2,BUDX K BUDX

 S X=$P(^DIC(4,DUZ(2),0),U)

 W !?80-$L(X)/2,X

 W !?80-(8+$L(BUD("VERSION")))/2,"Version ",BUD("VERSION")

XIT ;

 K DIC,DA,X,Y,%Y,%,BUDJ,BUDX,BUDTEXT,BUDLINE

 Q

TEXT ;uds

 ;;********************************************

 ;;**     RPMS UNIFORM DATA SYSTEM (UDS)     **

 ;;********************************************

 ;;QUIT

TEXTR ;

 ;;**************************************

 ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 ;;**            Reports               **

 ;;**************************************

 ;;QUIT

TEXTM ;manager utilities

 ;;**************************************

 ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 ;;**        Manager Utilities         **

 ;;**************************************

 ;;QUIT

TEXTL ;;

 ;;**************************************

 ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 ;;**             User Lists           **

 ;;**************************************

 ;;QUIT

BUDBAN    ; IHS/CMI/LAB - Banner routine for UDS package ;

 +1       ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50

 +2       ;

 +3       ;Writes all menu banners.

EP        ;EP

V         ; GET VERSION

 +1        SET BUD("VERSION")=""

           SET BUD("VERSION")=$ORDER(^DIC(9.4,"C","BUD",BUD("VERSION")))

           SET BUD("VERSION")=^DIC(9.4,BUD("VERSION"),"VERSION")

 +2        IF $GET(BUDTEXT)=""

               SET BUDTEXT="TEXT"

               SET BUDLINE=3

               GOTO PRINT

 +3        SET BUDTEXT="TEXT"_BUDTEXT

 +4        FOR BUDJ=1:1

               SET BUDX=$TEXT(@BUDTEXT+BUDJ)

               SET BUDX=$PIECE(BUDX,";;",2)

               IF BUDX="QUIT"!(BUDX="")

                   QUIT 

               SET BUDLINE=BUDJ

PRINT      IF $DATA(IOF)

               WRITE @IOF

 +1        FOR BUDJ=1:1:BUDLINE

               SET BUDX=$TEXT(@BUDTEXT+BUDJ)

               SET BUDX=$PIECE(BUDX,";;",2)

               WRITE !?80-$LENGTH(BUDX)\2,BUDX

               KILL BUDX

 +2        SET X=$PIECE(^DIC(4,DUZ(2),0),U)

 +3        WRITE !?80-$LENGTH(X)/2,X

 +4        WRITE !?80-(8+$LENGTH(BUD("VERSION")))/2,"Version ",BUD("VERSION")

XIT       ;

 +1        KILL DIC,DA,X,Y,%Y,%,BUDJ,BUDX,BUDTEXT,BUDLINE

 +2        QUIT 

TEXT      ;uds

 +1       ;;********************************************

 +2       ;;**     RPMS UNIFORM DATA SYSTEM (UDS)     **

 +3       ;;********************************************

 +4       ;;QUIT

TEXTR     ;

 +1       ;;**************************************

 +2       ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 +3       ;;**            Reports               **

 +4       ;;**************************************

 +5       ;;QUIT

TEXTM     ;manager utilities

 +1       ;;**************************************

 +2       ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 +3       ;;**        Manager Utilities         **

 +4       ;;**************************************

 +5       ;;QUIT

TEXTL     ;;

 +1       ;;**************************************

 +2       ;;**  RPMS UNIFORM DATA SYSTEM (UDS)  **

 +3       ;;**             User Lists           **

 +4       ;;**************************************

 +5       ;;QUIT