Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BZSMBAN

BZSMBAN.m

Go to the documentation of this file. 
  1. BZSMBAN ;IHS/BZSM/EDE - OPTION HEADERS [ 03/27/2003  3:38 PM ]
  1.  ;;1.0;TUCSON AREA OFFICE W/O;;MAR 14, 2003
  1.  ;
  1.  ;****** Send this routine with each new patch with **n** in piece
  1.  ;****** 3 so the patch level can be displayed as part of the
  1.  ;****** menu header.
  1.  ;
  1. HDR ;EP - Screen header.
  1.  D:'$D(BZSASFCD) SETVARS ;   set variables if 1st time thru
  1.  Q:$G(BZSQUIT)  ;            quit if fatal error
  1.  ; make sure reverse video hasn't been lost
  1.  I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  S BZSMT=$P($G(XQY0),U,2)
  1.  S:BZSMT="" BZSMT="TAO Write Off Old Bills Main Menu"
  1.  S BZSPNV=BZSPNM_" "_BZSVER
  1.  ; if unable to set reverse video use " instead, F must=0 
  1.  NEW A,D,F,I,L,N,R,V
  1.  S F=0
  1.  W @IOF ;                    reverse video on/off must not wrap
  1.  I IORVON'="""" S A=$X W IORVON,IORVOFF S D=$X S:D>A F=D-A ;compute length of revvideo
  1.  S L=18,R=61,D=R-L+1,N=R-L-1
  1.  W !,$$CTR($$REPEAT^XLFSTR("*",D)),!
  1.  W ?L,"*",$$CTR(BZSPNV,N),?R,"*",!
  1.  W ?L,"*",$$CTR($$LOC(),N),?R,"*",!
  1.  W ?L,"*",?(L+(((R-L)-$L(BZSMT))\2)),IORVON,BZSMT,IORVOFF,?R+F,"*",!
  1.  W $$CTR($$REPEAT^XLFSTR("*",D)),!
  1.  K BZSMT,BZSPNV,BZSNULL
  1.  Q
  1.  ;
  1. SETVARS ;EP - SET PACKAGE VARIABLES
  1.  S:'$D(U) U="^" ;                insure U is correct
  1.  ; set form feed, set to null if IOF not available
  1.  D:'$D(IOF) HOME^%ZIS ;          make sure screen vars there
  1.  S BZSNULL=""
  1.  I '$D(IOF) S IOF="BZSNULL" ;    write null if no form feed
  1.  ; check site Kernel variables
  1.  I '$D(DUZ(2)) D  S BZSQUIT=1 Q
  1.  .  W !!,"DUZ(2) has not been set by the KERNEL.",!
  1.  .  W "Please contact your System Support person.",!!
  1.  .  Q
  1.  ; insure site exists
  1.  I '$D(^DIC(4,DUZ(2),0)) D  S BZSQUIT=1 Q
  1.  .  W !!,"The DUZ(2) site does not exist.  DUZ(2)="_DUZ(2),!
  1.  .  W "Please contact your System Support person.",!!
  1.  .  Q
  1.  S BZSSITE=DUZ(2) ;                save site IEN
  1.  ; get site name
  1.  S BZSSTNM=$P(^DIC(4,DUZ(2),0),U)
  1.  ; set asufac code
  1.  S BZSASFCD=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  ; check fileman access
  1.  I $G(DUZ(0))'["V",$G(DUZ(0))'["@" D  S BZSQUIT=1 Q
  1.  .  W !!,"You do not have the appropriate FileMan access.",!
  1.  .  W "Please contact your System Support person.",!!
  1.  .  Q
  1.  ; set BZSTOP to highest level option
  1.  I $G(XQY0)'="",$G(BZSTOP)="" S BZSTOP=XQY0
  1.  ; set package version and package name
  1.  S (BZSPNM,BZSVER)=""
  1.  NEW Y
  1.  S Y=$O(^DIC(9.4,"C","BZSM",""))
  1.  I Y D
  1.  .  S BZSVER=$G(^DIC(9.4,Y,"VERSION"))
  1.  .  Q:BZSVER=""
  1.  .  S BZSVER="V"_BZSVER
  1.  .  S BZSPNM=$P($G(^DIC(9.4,Y,0)),U) ;get package name
  1.  .  Q
  1.  ; add patch level to version
  1.  S X=$T(+2),X=$P(X,";;",2),X=$P(X,";",3),X=$P(X,"**",2),X=$P(X,",",$L(X,","))
  1.  S:X]"" BZSVER=BZSVER_"P"_X
  1.  ; insure package name
  1.  S:$G(BZSPNM)="" BZSPNM="TUCSON AREA OFFICE WRITE OFF"
  1.  ; set reverse video
  1.  I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  I $G(IORVON)="" S (IORVON,IORVOFF)="""" ;use " if no reverse video
  1.  ; set right margin if it isn't set already
  1.  S:'$D(IOM) IOM=80 ;               default margin to 80 if unknown
  1.  Q
  1.  ;
  1.  ;==========
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. LJRF(X,Y,Z) ;EP - left justify X in a field Y wide, right filling with Z.
  1.  NEW L,M
  1.  I $L(X)'<Y Q $E(X,1,Y-1)_Z
  1.  S L=Y-$L(X)
  1.  S $P(M,Z,L)=Z
  1.  Q X_M
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;==========
  1.  ;
  1. BOHDR ; BACK OUT HEADER
  1.  ; this entry point allows an option to display the header of
  1.  ; a menu being backed into from a selected item that is a run
  1.  ; routine.  option file header field help indicates the header
  1.  ; for a menu option should be re-executed when being backed
  1.  ; into from a selected item but it only works if the selected
  1.  ; item is a menu.
  1.  ;
  1.  NEW XQY0
  1.  S XQY0=$P($G(XQSV),U,3,4) ;              get parent menu
  1.  S:XQY0="" XQY0="^Parent Menu Unknown" ;  default if xqsv not there
  1.  D HDR
  1.  Q