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