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

ACRFMENU.m

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