ACRFMENU ;IHS/OIRM/DSD/THL,AEF - CONTROL HEADINGS AND MENUS; [ 12/13/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,20,21,22**;NOV 05, 2001
;;ROUTINE TO CONTROL HEADINGS AND MENUS
TITLE ;EP;TO DISPLAY TITLE
I $D(ACRNOFM) D ^XUSCLEAN Q ;ACR*2.1*22.03 IM22653
S ACRFINSS=""
S IOP="HOME"
D ^%ZIS
D HOME
D HEAD
EXIT K ACRX,ACRZ,ACRTRM
I $D(ACRY),ACRY]"" W !!?80-$L(ACRY)/2,ACRY
D ^ACRFEXIT
D NSV
Q
HEAD ;EP;TO DISPLAY HEADER
W @IOF
HEAD1 F ACRJ=0:1:4 D H1
D HDVS
I DUZ D
.;S ACRX=$P(^VA(200,DUZ,0),U) ;ACR*2.1*19.02 IM16848
.S ACRX=$$NAME2^ACRFUTL1(DUZ) ;ACR*2.1*19.02 IM16848
.S ACRX=$P($P(ACRX,",",2)," ")_" "_$P(ACRX,",")
.S ACRX="CURRENT USER: "_ACRX
.W !?80-$L(ACRX)\2,ACRX
.I $P(^VA(200,DUZ,0),U,4)'["A"&($P(^(0),U,4)'["@") D
..D WARNING^ACRFWARN
..W !!,"You do NOT have the correct FILE MANAGER ACCESS CODE to use ARMS."
..W !,"Contact the ARMS Manager at the Area Office immediately. DO NOT use"
..W !,"ARMS until you have been assigned the proper FILE MANAGER ACCESS CODE."
..D PAUSE^ACRFWARN
..S ACRNOFM="" ;ACR*2.1*22.03 IM22653
D:ACRON=""!(ACROF="") RV
Q
H1 S ACRX=$T(TEXT+ACRJ),ACRX=$P(ACRX,";;",2)
W !?80-$L(ACRX)\2,ACRX
Q
HDVS I $D(DUZ(2))#2,DUZ(2) S:$D(^DIC(4,DUZ(2),0)) ACRX=$P(^(0),U)
I $D(^DIC(9.4,"C","ACR")) D
.;BEGIN OLD CODE ACR*2.1*22.08 IM23060
.;S ACRZ=$O(^DIC(9.4,"C","ACR",0))
.;S ACRZ=$P(^DIC(9.4,ACRZ,"VERSION"),U)
.;BEGIN MOD TO DISPLAY PATCH # ON MENUS ACR*2.1*21.01 IM22090
.;S ACRPKG=$O(^DIC(9.4,"C","ACR",0))
.;S ACRPKG=$P($G(^DIC(9.4,ACRPKG,0)),U)
.;S ACRPATCH=$$LAST^XPDUTL(ACRPKG,ACRZ)
.;S ACRZ="VERSION "_ACRZ
.;S ACRZ="VERSION "_ACRZ_" PATCH "_$P(ACRPATCH,U)
.;K ACRPKG,ACRPATCH
.;END MOD TO DISPLAY PATCH # ON MENUS ACR*2.1*21.01 IM22090
.;I $E(IOST,1,2)="C-" W:$D(ACRZ) !?80-$L(ACRZ)\2,ACRZ
.;W:$D(ACRX) !?80-$L(ACRX)\2,ACRX
.;END OLD CODE ACR*2.1*22.08 IM23060
.;BEGIN NEW CODE ACR*2.1*22.08 IM23060
.N ACRLPAT
.S ACRLPAT=""
.D CURRENT^ACRFPAH
.I $E(IOST,1,2)="C-" W:$D(ACRZ) !?80-$L(ACRZ)\2,ACRZ
.W:$D(ACRX) !?80-$L(ACRX)\2,ACRX
;END NEW CODE ACR*2.1*22.08 IM23060
Q
MM ;EP
S ACRY="MANAGER MENU" G TITLE
EA ;EP
S ACRY="FUND DISTRIBUTION" G TITLE
OF ;EP
S ACRY="REQUESTS" G TITLE
FR ;EP
S ACRY="REPORTS" G TITLE
FM ;EP
S ACRY="USER MENU" G TITLE
SR ;EP
S ACRY="SYSTEM REPORTS" G TITLE
SF ;EP
S ACRY="STATUS OF FUNDS" G TITLE
SS ;EP
S ACRY="SYSTEM SETUP" G TITLE
SD ;EP
TM ;EP
S ACRY="TABLE MAINTENANCE" G TITLE
VM ;EP
S ACRY="VENDOR MENU" G TITLE ;ACR*2.1*20.14
PT ;EP
D PAUSE^ACRFWARN
PT1 ;EP
S ACRY="PRINT TABLE LISTS"
G TITLE
SU ;EP
S ACRY="UTILITIES" G TITLE
EDI ;EP
S ACRY="EDI SYSTEM MANAGEMENT" G TITLE
FQS ;EP
S ACRY="FINANCIAL QUERY SYSTEM" G TITLE
IRS ;EP
S ACRY="IRS 1099 MENU" G TITLE
DHR ;EP
S ACRY="DHR MANAGEMENT MENU" G TITLE
DHRM ;EP
S ACRY="DHR MANAGEMENT" G TITLE
DHRE ;EP
S ACRY="DHR ENTER/EDIT" G TITLE
DHRX ;EP
S ACRY="DHR EXPORT" G TITLE
ODD ;EP
S ACRY="OPEN DOCUMENT DOWNLOAD" G TITLE
YTF ;EP -- YOUR TRAVEL FORMS
;
;FOR FUTURE RELEASE
Q
NQ ;;
HOME ;EP;TO SET TERMINAL CONTROL VARIABLES
S ACRTRM=^%ZIS(2,IOST(0),5)
S ACRXY=$G(^%ZIS(2,IOST(0),"XY"))
S ACRON=$P(ACRTRM,U,4)
S ACROF=$P(ACRTRM,U,5)
D:ACRON=""!(ACROF="") RV
D ENS^%ZISS
Q
CLEAN ;EP;TO KILL SELECTD VARIABLES
K ACRON,ACROF,ACRZ,ACRY,ACRTRM,ACRFINSS,ACRPPO,ACRPTX,ACRREV,ACRRR,ACRSOF,ACRTRN,ACRBOX
Q
RV ;WARNING MESSAGE WHEN REVERSE VIDEO NOT DEFINED
W @IOF
W !?10,"WARNING WARNING WARNING WARNING WARNING"
W *7,*7
W !!,"Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the ARMS"
W !,"system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined."
W !,"This is the responsibility of the AREA OFFICE computer site manager."
W !!,"Please contact this individual for assistance. Let him/her know that you"
W !,"are logged in on device NO.: ",$I
D P1^ACRFWARN
Q
B1 ;EP;TO TURN BLINK ON
W:$D(IOBON)&$D(IOBOFF) IOBON
Q
B2 ;EP;TO TURN BLINK OFF
W:$D(IOBOFF) IOBOFF
Q
U1 ;EP;TO TURN UNDERLINE ON
W:$D(IOUON)&$D(IOUOFF) IOUON
Q
U2 ;EP;TO TURN UNDERLINE OFF
W:$D(IOUOFF) IOUOFF
Q
DASH(Z) ;EP;TO WRITE LINE OF DASHES
S:'$G(Z) Z=80
W !
W $$DASH1(Z)
Q ""
DASH1(Z) ;EP;TO WRITE DASHES WITHOUT LINE FEED
S:'$G(Z) Z=80
N I
F I=1:1:Z W "-"
Q ""
NSV ;EP;TO CHECK FOR SECURITY VIOLATIONS
N ACRLVL
S ACRLVL=$O(^ACRUAL("LVL",DUZ,0))
Q:ACRLVL=3!(ACRLVL=11)
N X
S X=0
F S X=$O(^ACRACC(3,"SEC","C",1,X)) Q:'X I $D(^VA(200,DUZ,51,X)) D Q
. S ACRDUZ=DUZ
.D KILLSEC^ACRFACC
.W !!,"You have ARMS ACCESS LEVEL ",ACRLVL
.W !,"However, somehow you have gotten access to secured functions"
.W !,"within ARMS which can only be accessed by someone with"
.W !,"ACESS LEVEL 10."
.W !!,"All your access to ARMS has been temporarily suspended."
.W !,"Please see your ARMS Manager to re-establish an appropriate"
.W !,"ACCESS LEVEL for yourself."
.D PAUSE^ACRFWARN
Q
TEXT ;;WARNING: RESTRICTED GOVERNMENT FINANCIAL DATA, UNAUTHORIZED
;;ENTRY INTO THIS SYSTEM OR USE OF THIS DATA IS A FEDERAL CRIME
;;****************************************************
;;** ADMINISTRATIVE RESOURCE MANAGEMENT SYSTEM **
;;****************************************************
ACRFMENU ;IHS/OIRM/DSD/THL,AEF - CONTROL HEADINGS AND MENUS; [ 12/13/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,20,21,22**;NOV 05, 2001
+2 ;;ROUTINE TO CONTROL HEADINGS AND MENUS
TITLE ;EP;TO DISPLAY TITLE
+1 ;ACR*2.1*22.03 IM22653
IF $DATA(ACRNOFM)
DO ^XUSCLEAN
QUIT
+2 SET ACRFINSS=""
+3 SET IOP="HOME"
+4 DO ^%ZIS
+5 DO HOME
+6 DO HEAD
EXIT KILL ACRX,ACRZ,ACRTRM
+1 IF $DATA(ACRY)
IF ACRY]""
WRITE !!?80-$LENGTH(ACRY)/2,ACRY
+2 DO ^ACRFEXIT
+3 DO NSV
+4 QUIT
HEAD ;EP;TO DISPLAY HEADER
+1 WRITE @IOF
HEAD1 FOR ACRJ=0:1:4
DO H1
+1 DO HDVS
+2 IF DUZ
Begin DoDot:1
+3 ;S ACRX=$P(^VA(200,DUZ,0),U) ;ACR*2.1*19.02 IM16848
+4 ;ACR*2.1*19.02 IM16848
SET ACRX=$$NAME2^ACRFUTL1(DUZ)
+5 SET ACRX=$PIECE($PIECE(ACRX,",",2)," ")_" "_$PIECE(ACRX,",")
+6 SET ACRX="CURRENT USER: "_ACRX
+7 WRITE !?80-$LENGTH(ACRX)\2,ACRX
+8 IF $PIECE(^VA(200,DUZ,0),U,4)'["A"&($PIECE(^(0),U,4)'["@")
Begin DoDot:2
+9 DO WARNING^ACRFWARN
+10 WRITE !!,"You do NOT have the correct FILE MANAGER ACCESS CODE to use ARMS."
+11 WRITE !,"Contact the ARMS Manager at the Area Office immediately. DO NOT use"
+12 WRITE !,"ARMS until you have been assigned the proper FILE MANAGER ACCESS CODE."
+13 DO PAUSE^ACRFWARN
+14 ;ACR*2.1*22.03 IM22653
SET ACRNOFM=""
End DoDot:2
End DoDot:1
+15 IF ACRON=""!(ACROF="")
DO RV
+16 QUIT
H1 SET ACRX=$TEXT(TEXT+ACRJ)
SET ACRX=$PIECE(ACRX,";;",2)
+1 WRITE !?80-$LENGTH(ACRX)\2,ACRX
+2 QUIT
HDVS IF $DATA(DUZ(2))#2
IF DUZ(2)
IF $DATA(^DIC(4,DUZ(2),0))
SET ACRX=$PIECE(^(0),U)
+1 IF $DATA(^DIC(9.4,"C","ACR"))
Begin DoDot:1
+2 ;BEGIN OLD CODE ACR*2.1*22.08 IM23060
+3 ;S ACRZ=$O(^DIC(9.4,"C","ACR",0))
+4 ;S ACRZ=$P(^DIC(9.4,ACRZ,"VERSION"),U)
+5 ;BEGIN MOD TO DISPLAY PATCH # ON MENUS ACR*2.1*21.01 IM22090
+6 ;S ACRPKG=$O(^DIC(9.4,"C","ACR",0))
+7 ;S ACRPKG=$P($G(^DIC(9.4,ACRPKG,0)),U)
+8 ;S ACRPATCH=$$LAST^XPDUTL(ACRPKG,ACRZ)
+9 ;S ACRZ="VERSION "_ACRZ
+10 ;S ACRZ="VERSION "_ACRZ_" PATCH "_$P(ACRPATCH,U)
+11 ;K ACRPKG,ACRPATCH
+12 ;END MOD TO DISPLAY PATCH # ON MENUS ACR*2.1*21.01 IM22090
+13 ;I $E(IOST,1,2)="C-" W:$D(ACRZ) !?80-$L(ACRZ)\2,ACRZ
+14 ;W:$D(ACRX) !?80-$L(ACRX)\2,ACRX
+15 ;END OLD CODE ACR*2.1*22.08 IM23060
+16 ;BEGIN NEW CODE ACR*2.1*22.08 IM23060
+17 NEW ACRLPAT
+18 SET ACRLPAT=""
+19 DO CURRENT^ACRFPAH
+20 IF $EXTRACT(IOST,1,2)="C-"
IF $DATA(ACRZ)
WRITE !?80-$LENGTH(ACRZ)\2,ACRZ
+21 IF $DATA(ACRX)
WRITE !?80-$LENGTH(ACRX)\2,ACRX
End DoDot:1
+22 ;END NEW CODE ACR*2.1*22.08 IM23060
+23 QUIT
MM ;EP
+1 SET ACRY="MANAGER MENU"
GOTO TITLE
EA ;EP
+1 SET ACRY="FUND DISTRIBUTION"
GOTO TITLE
OF ;EP
+1 SET ACRY="REQUESTS"
GOTO TITLE
FR ;EP
+1 SET ACRY="REPORTS"
GOTO TITLE
FM ;EP
+1 SET ACRY="USER MENU"
GOTO TITLE
SR ;EP
+1 SET ACRY="SYSTEM REPORTS"
GOTO TITLE
SF ;EP
+1 SET ACRY="STATUS OF FUNDS"
GOTO TITLE
SS ;EP
+1 SET ACRY="SYSTEM SETUP"
GOTO TITLE
SD ;EP
TM ;EP
+1 SET ACRY="TABLE MAINTENANCE"
GOTO TITLE
VM ;EP
+1 ;ACR*2.1*20.14
SET ACRY="VENDOR MENU"
GOTO TITLE
PT ;EP
+1 DO PAUSE^ACRFWARN
PT1 ;EP
+1 SET ACRY="PRINT TABLE LISTS"
+2 GOTO TITLE
SU ;EP
+1 SET ACRY="UTILITIES"
GOTO TITLE
EDI ;EP
+1 SET ACRY="EDI SYSTEM MANAGEMENT"
GOTO TITLE
FQS ;EP
+1 SET ACRY="FINANCIAL QUERY SYSTEM"
GOTO TITLE
IRS ;EP
+1 SET ACRY="IRS 1099 MENU"
GOTO TITLE
DHR ;EP
+1 SET ACRY="DHR MANAGEMENT MENU"
GOTO TITLE
DHRM ;EP
+1 SET ACRY="DHR MANAGEMENT"
GOTO TITLE
DHRE ;EP
+1 SET ACRY="DHR ENTER/EDIT"
GOTO TITLE
DHRX ;EP
+1 SET ACRY="DHR EXPORT"
GOTO TITLE
ODD ;EP
+1 SET ACRY="OPEN DOCUMENT DOWNLOAD"
GOTO TITLE
YTF ;EP -- YOUR TRAVEL FORMS
+1 ;
+2 ;FOR FUTURE RELEASE
+3 QUIT
NQ ;;
HOME ;EP;TO SET TERMINAL CONTROL VARIABLES
+1 SET ACRTRM=^%ZIS(2,IOST(0),5)
+2 SET ACRXY=$GET(^%ZIS(2,IOST(0),"XY"))
+3 SET ACRON=$PIECE(ACRTRM,U,4)
+4 SET ACROF=$PIECE(ACRTRM,U,5)
+5 IF ACRON=""!(ACROF="")
DO RV
+6 DO ENS^%ZISS
+7 QUIT
CLEAN ;EP;TO KILL SELECTD VARIABLES
+1 KILL ACRON,ACROF,ACRZ,ACRY,ACRTRM,ACRFINSS,ACRPPO,ACRPTX,ACRREV,ACRRR,ACRSOF,ACRTRN,ACRBOX
+2 QUIT
RV ;WARNING MESSAGE WHEN REVERSE VIDEO NOT DEFINED
+1 WRITE @IOF
+2 WRITE !?10,"WARNING WARNING WARNING WARNING WARNING"
+3 WRITE *7,*7
+4 WRITE !!,"Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the ARMS"
+5 WRITE !,"system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined."
+6 WRITE !,"This is the responsibility of the AREA OFFICE computer site manager."
+7 WRITE !!,"Please contact this individual for assistance. Let him/her know that you"
+8 WRITE !,"are logged in on device NO.: ",$IO
+9 DO P1^ACRFWARN
+10 QUIT
B1 ;EP;TO TURN BLINK ON
+1 IF $DATA(IOBON)&$DATA(IOBOFF)
WRITE IOBON
+2 QUIT
B2 ;EP;TO TURN BLINK OFF
+1 IF $DATA(IOBOFF)
WRITE IOBOFF
+2 QUIT
U1 ;EP;TO TURN UNDERLINE ON
+1 IF $DATA(IOUON)&$DATA(IOUOFF)
WRITE IOUON
+2 QUIT
U2 ;EP;TO TURN UNDERLINE OFF
+1 IF $DATA(IOUOFF)
WRITE IOUOFF
+2 QUIT
DASH(Z) ;EP;TO WRITE LINE OF DASHES
+1 IF '$GET(Z)
SET Z=80
+2 WRITE !
+3 WRITE $$DASH1(Z)
+4 QUIT ""
DASH1(Z) ;EP;TO WRITE DASHES WITHOUT LINE FEED
+1 IF '$GET(Z)
SET Z=80
+2 NEW I
+3 FOR I=1:1:Z
WRITE "-"
+4 QUIT ""
NSV ;EP;TO CHECK FOR SECURITY VIOLATIONS
+1 NEW ACRLVL
+2 SET ACRLVL=$ORDER(^ACRUAL("LVL",DUZ,0))
+3 IF ACRLVL=3!(ACRLVL=11)
QUIT
+4 NEW X
+5 SET X=0
+6 FOR
SET X=$ORDER(^ACRACC(3,"SEC","C",1,X))
IF 'X
QUIT
IF $DATA(^VA(200,DUZ,51,X))
Begin DoDot:1
+7 SET ACRDUZ=DUZ
+8 DO KILLSEC^ACRFACC
+9 WRITE !!,"You have ARMS ACCESS LEVEL ",ACRLVL
+10 WRITE !,"However, somehow you have gotten access to secured functions"
+11 WRITE !,"within ARMS which can only be accessed by someone with"
+12 WRITE !,"ACESS LEVEL 10."
+13 WRITE !!,"All your access to ARMS has been temporarily suspended."
+14 WRITE !,"Please see your ARMS Manager to re-establish an appropriate"
+15 WRITE !,"ACCESS LEVEL for yourself."
+16 DO PAUSE^ACRFWARN
End DoDot:1
QUIT
+17 QUIT
TEXT ;;WARNING: RESTRICTED GOVERNMENT FINANCIAL DATA, UNAUTHORIZED
+1 ;;ENTRY INTO THIS SYSTEM OR USE OF THIS DATA IS A FEDERAL CRIME
+2 ;;****************************************************
+3 ;;** ADMINISTRATIVE RESOURCE MANAGEMENT SYSTEM **
+4 ;;****************************************************
