- 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 ;;****************************************************