ACRFDFL1 ;IHS/OIRM/DSD/THL,AEF - ACRFDFLT CON'T UTILITY ENTRY POINTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION ROUTINE FOR ACRFDFLT
OBJCODE ;EP;TO ADD/EDIT OBJECT CLASS CODES
N ACRDIR
S ACRHEAD="EDIT OBJECT CLASS CODES"
S ACRDIC="^AUTTOBJC"
S ACRDIC("A")="OBJECT CLASS CODE...: "
S ACRDR="[ACR OBJECT CODE]"
S ACRDIR("A")="Edit Object Class Code"
S ACRRTN="^ACRPOCC"
D GEN^ACRFDFLT
Q
HOTEL ;EP;TO ADD/EDIT HOTEL INFORMATION
N ACRDIR
S ACRHEAD="EDIT HOTEL NAME/PHONE NUMBER"
S ACRDIC="^ACRHOTEL"
S ACRDIC("A")="HOTEL...............: "
S ACRDR="[ACR HOTEL]"
S ACRDIR("A")="Edit Hotel Name"
S ACRRTN="^ACRPHOT"
D GEN^ACRFDFLT
Q
CAR ;EP;TO ADD/EDIT RENTAL CAR INFORMATION
N ACRDIR
S ACRHEAD="EDIT RENTAL CAR COMPANY NAME/PHONE NUMBER"
S ACRDIC="^ACRRCOMP"
S ACRDIC("A")="RENTAL CAR COMPANY..: "
S ACRDR="[ACR RENTAL CAR INFORMATION]"
S ACRDIR("A")="Edit Rental Car Information"
S ACRRTN="^ACRPCAR"
D GEN^ACRFDFLT
Q
AIR ;EP;TO ADD/EDIT AIRLINE INFORMATION
N ACRDIR
S ACRHEAD="EDIT AIRLINE COMPANY NAME/PHONE NUMBER"
S ACRDIC="^ACRACOMP"
S ACRDIC("A")="AIRLINE COMPANY.....: "
S ACRDR="[ACR AIRLINE COMPANY]"
S ACRDIR("A")="Edit Airline Company Information"
S ACRRTN="^ACRPAIR"
D GEN^ACRFDFLT
Q
FEDSTRIP ;EP;TO ADD/EDIT FEDSTRIP INFORMATION
N ACRDIR
S ACRHEAD="EDIT FEDSTRIP ACTIVITY CODES"
S ACRDIC="^ACRFSCD"
S ACRDIC("A")="FEDSTRIP LOCATION...: "
S ACRDR="[ACR FEDSTRIP LOCATION]"
S ACRDIR("A")="Edit FEDSTRIP Location Information"
S ACRRTN="^ACRPFSL"
D GEN^ACRFDFLT
Q
BA ;EP;TO ENTER/UPDATE BUDGET ACTIVITY
N ACRDIR
S ACRHEAD="EDIT BUDGET ACTIVITY"
S ACRDIC="^AUTTBA"
S ACRDIC("A")="BUDGET ACTIVITY.....: "
S ACRDR="[ACR BUDGET ACTIVITY]"
S ACRDIR("A")="Edit Budget Activity"
S ACRRTN="^ACRPBA"
D GEN^ACRFDFLT
Q
SA ;EP;TO ENTER/UPDATE SUB-ACTIVITY
N ACRDIR
S ACRHEAD="EDIT SUB-ACTIVITY"
S ACRDIC="^AUTTSA"
S ACRDIC("A")="SUB-ACTIVITY........: "
S ACRDR="[ACR SUB-ACTIVITY]"
S ACRDIR("A")="Edit Sub-Activity"
S ACRRTN="^ACRPSA"
D GEN^ACRFDFLT
Q
SSA ;EP;TO ENTER/UPDATE SUB-SUB-ACTIVITY
N ACRDIR
S ACRHEAD="EDIT SUB-SUB-ACTIVITY"
S ACRDIC="^AUTTSSA"
S ACRDIC("A")="SUB-SUB-ACTIVITY....: "
S ACRDR="[ACR SUB-SUB-ACTIVITY]"
S ACRDIR("A")="Edit Sub-Sub-Activity"
S ACRRTN="^ACRPSSA"
D GEN^ACRFDFLT
Q
ALLW ;EP;TO ENTER/UPDATE ALLOWANCE
N ACRDIR
S ACRHEAD="EDIT ALLOWANCE NUMBER"
S ACRDIC="^AUTTALLW"
S ACRDIC("A")="ALLOWANCE NUMBER....: "
S ACRDR="[ACR ALLOWANCE NUMBER]"
S ACRDIR("A")="Edit Allowance"
S ACRRTN="^ACRPALW"
D GEN^ACRFDFLT
Q
ACPT ;EP;TO ENTER/UPDATE ACCOUNTING POINT
N ACRDIR
S ACRHEAD="EDIT ACCOUNTING POINT"
S ACRDIC="^AUTTACPT"
S ACRDIC("A")="ACCOUNTING POINT....: "
S ACRDR=".01ACCOUNTING POINT....;1AREA OFFICE........."
S ACRDIR("A")="Edit Accounting Point"
S ACRRTN="^ACRPAPT"
D GEN^ACRFDFLT
Q
LOC ;EP;TO ADD/EDIT LOCATION CODES
N ACRDIR
S ACRHEAD="EDIT LOCATION CODES"
S ACRDIC="^AUTTLCOD"
S ACRDIC("A")="LOCATION CODE.......: "
S ACRDR="[ACR LOCATION CODE]"
S ACRDIR("A")="Edit Location Code"
S ACRRTN="^ACRPLCD"
D GEN^ACRFDFLT
Q
FSC ;EP;TO EDIT FEDERAL SUPPLY CLASS CODES
N ACRDIR
S ACRHEAD="EDIT FEDERAL SUPPLY CLASS CODE"
S ACRDIC="^ACRFSC"
S ACRDIC("A")="FEDERAL SUPPLY CODE.: "
S ACRDR="[ACR FEDERAL SUPPLY CLASSES]"
S ACRDIR("A")="Edit Federal Supply Code"
S ACRRTN="^ACRPFSC"
D GEN^ACRFDFLT
Q
OBJC ;EP;ALLOW USER TO ADD OBJECT CODES TO SPECIFIC TRANSACTION TYPES
W !!?4,"OBJECT CODE ",$P(^AUTTOBJC(ACRDA,0),U)," is used by the following ARMS TRANSACTION TYPES:"
W !?4,"NO. TRANSACTION TYPE"
W !?4,"--- ------------------------------"
K ACRTX
S (X,ACRJ)=0
F S X=$O(^ACRTXTYP("C",ACRDA,X)) Q:'X D
.S ACRJ=ACRJ+1
.S ACRTX(ACRJ)=X
.W !?4,ACRJ
.W ?9,$P(^ACRTXTYP(X,0),U)
Q
TC ;EP;TO EDIT PO TERMS AND CONDITIONS
W @IOF
W !?20,"Review/Edit Puchase Order TERMS & CONDITIONS"
W !!
S DA=1
S DIE="^ACRTC("
S DR="[ACR TERMS AND CONDITIONS]"
D DIE^ACRFDIC
Q
RESET ;EP;TO RESET CAN DEFAULTS FOR A DOCUMENT
S DIC="^ACRDOC("
S DIC(0)="AEMQZ"
S DIC("A")="RESET CAN Defaults for Document NO.: "
W !
D DIC^ACRFDIC
Q:+Y<1
S ACRDOCDA=+Y
W !!?10,$P(^ACRDOC(+Y,0),U),?$X+3,$P(^(0),U,2),?$X+3,$P(^(0),U,14)
S DIR(0)="YO"
S DIR("A",1)="Are you certain you want to RESET the"
S DIR("A")="CAN Default values for this document"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:+Y'=1
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="113100////"_$P(^ACRDOC(DA,"REQ"),U,10)
D DIE^ACRFDIC
Q
ACRFDFL1 ;IHS/OIRM/DSD/THL,AEF - ACRFDFLT CON'T UTILITY ENTRY POINTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION ROUTINE FOR ACRFDFLT
OBJCODE ;EP;TO ADD/EDIT OBJECT CLASS CODES
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT OBJECT CLASS CODES"
+3 SET ACRDIC="^AUTTOBJC"
+4 SET ACRDIC("A")="OBJECT CLASS CODE...: "
+5 SET ACRDR="[ACR OBJECT CODE]"
+6 SET ACRDIR("A")="Edit Object Class Code"
+7 SET ACRRTN="^ACRPOCC"
+8 DO GEN^ACRFDFLT
+9 QUIT
HOTEL ;EP;TO ADD/EDIT HOTEL INFORMATION
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT HOTEL NAME/PHONE NUMBER"
+3 SET ACRDIC="^ACRHOTEL"
+4 SET ACRDIC("A")="HOTEL...............: "
+5 SET ACRDR="[ACR HOTEL]"
+6 SET ACRDIR("A")="Edit Hotel Name"
+7 SET ACRRTN="^ACRPHOT"
+8 DO GEN^ACRFDFLT
+9 QUIT
CAR ;EP;TO ADD/EDIT RENTAL CAR INFORMATION
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT RENTAL CAR COMPANY NAME/PHONE NUMBER"
+3 SET ACRDIC="^ACRRCOMP"
+4 SET ACRDIC("A")="RENTAL CAR COMPANY..: "
+5 SET ACRDR="[ACR RENTAL CAR INFORMATION]"
+6 SET ACRDIR("A")="Edit Rental Car Information"
+7 SET ACRRTN="^ACRPCAR"
+8 DO GEN^ACRFDFLT
+9 QUIT
AIR ;EP;TO ADD/EDIT AIRLINE INFORMATION
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT AIRLINE COMPANY NAME/PHONE NUMBER"
+3 SET ACRDIC="^ACRACOMP"
+4 SET ACRDIC("A")="AIRLINE COMPANY.....: "
+5 SET ACRDR="[ACR AIRLINE COMPANY]"
+6 SET ACRDIR("A")="Edit Airline Company Information"
+7 SET ACRRTN="^ACRPAIR"
+8 DO GEN^ACRFDFLT
+9 QUIT
FEDSTRIP ;EP;TO ADD/EDIT FEDSTRIP INFORMATION
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT FEDSTRIP ACTIVITY CODES"
+3 SET ACRDIC="^ACRFSCD"
+4 SET ACRDIC("A")="FEDSTRIP LOCATION...: "
+5 SET ACRDR="[ACR FEDSTRIP LOCATION]"
+6 SET ACRDIR("A")="Edit FEDSTRIP Location Information"
+7 SET ACRRTN="^ACRPFSL"
+8 DO GEN^ACRFDFLT
+9 QUIT
BA ;EP;TO ENTER/UPDATE BUDGET ACTIVITY
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT BUDGET ACTIVITY"
+3 SET ACRDIC="^AUTTBA"
+4 SET ACRDIC("A")="BUDGET ACTIVITY.....: "
+5 SET ACRDR="[ACR BUDGET ACTIVITY]"
+6 SET ACRDIR("A")="Edit Budget Activity"
+7 SET ACRRTN="^ACRPBA"
+8 DO GEN^ACRFDFLT
+9 QUIT
SA ;EP;TO ENTER/UPDATE SUB-ACTIVITY
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT SUB-ACTIVITY"
+3 SET ACRDIC="^AUTTSA"
+4 SET ACRDIC("A")="SUB-ACTIVITY........: "
+5 SET ACRDR="[ACR SUB-ACTIVITY]"
+6 SET ACRDIR("A")="Edit Sub-Activity"
+7 SET ACRRTN="^ACRPSA"
+8 DO GEN^ACRFDFLT
+9 QUIT
SSA ;EP;TO ENTER/UPDATE SUB-SUB-ACTIVITY
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT SUB-SUB-ACTIVITY"
+3 SET ACRDIC="^AUTTSSA"
+4 SET ACRDIC("A")="SUB-SUB-ACTIVITY....: "
+5 SET ACRDR="[ACR SUB-SUB-ACTIVITY]"
+6 SET ACRDIR("A")="Edit Sub-Sub-Activity"
+7 SET ACRRTN="^ACRPSSA"
+8 DO GEN^ACRFDFLT
+9 QUIT
ALLW ;EP;TO ENTER/UPDATE ALLOWANCE
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT ALLOWANCE NUMBER"
+3 SET ACRDIC="^AUTTALLW"
+4 SET ACRDIC("A")="ALLOWANCE NUMBER....: "
+5 SET ACRDR="[ACR ALLOWANCE NUMBER]"
+6 SET ACRDIR("A")="Edit Allowance"
+7 SET ACRRTN="^ACRPALW"
+8 DO GEN^ACRFDFLT
+9 QUIT
ACPT ;EP;TO ENTER/UPDATE ACCOUNTING POINT
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT ACCOUNTING POINT"
+3 SET ACRDIC="^AUTTACPT"
+4 SET ACRDIC("A")="ACCOUNTING POINT....: "
+5 SET ACRDR=".01ACCOUNTING POINT....;1AREA OFFICE........."
+6 SET ACRDIR("A")="Edit Accounting Point"
+7 SET ACRRTN="^ACRPAPT"
+8 DO GEN^ACRFDFLT
+9 QUIT
LOC ;EP;TO ADD/EDIT LOCATION CODES
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT LOCATION CODES"
+3 SET ACRDIC="^AUTTLCOD"
+4 SET ACRDIC("A")="LOCATION CODE.......: "
+5 SET ACRDR="[ACR LOCATION CODE]"
+6 SET ACRDIR("A")="Edit Location Code"
+7 SET ACRRTN="^ACRPLCD"
+8 DO GEN^ACRFDFLT
+9 QUIT
FSC ;EP;TO EDIT FEDERAL SUPPLY CLASS CODES
+1 NEW ACRDIR
+2 SET ACRHEAD="EDIT FEDERAL SUPPLY CLASS CODE"
+3 SET ACRDIC="^ACRFSC"
+4 SET ACRDIC("A")="FEDERAL SUPPLY CODE.: "
+5 SET ACRDR="[ACR FEDERAL SUPPLY CLASSES]"
+6 SET ACRDIR("A")="Edit Federal Supply Code"
+7 SET ACRRTN="^ACRPFSC"
+8 DO GEN^ACRFDFLT
+9 QUIT
OBJC ;EP;ALLOW USER TO ADD OBJECT CODES TO SPECIFIC TRANSACTION TYPES
+1 WRITE !!?4,"OBJECT CODE ",$PIECE(^AUTTOBJC(ACRDA,0),U)," is used by the following ARMS TRANSACTION TYPES:"
+2 WRITE !?4,"NO. TRANSACTION TYPE"
+3 WRITE !?4,"--- ------------------------------"
+4 KILL ACRTX
+5 SET (X,ACRJ)=0
+6 FOR
SET X=$ORDER(^ACRTXTYP("C",ACRDA,X))
IF 'X
QUIT
Begin DoDot:1
+7 SET ACRJ=ACRJ+1
+8 SET ACRTX(ACRJ)=X
+9 WRITE !?4,ACRJ
+10 WRITE ?9,$PIECE(^ACRTXTYP(X,0),U)
End DoDot:1
+11 QUIT
TC ;EP;TO EDIT PO TERMS AND CONDITIONS
+1 WRITE @IOF
+2 WRITE !?20,"Review/Edit Puchase Order TERMS & CONDITIONS"
+3 WRITE !!
+4 SET DA=1
+5 SET DIE="^ACRTC("
+6 SET DR="[ACR TERMS AND CONDITIONS]"
+7 DO DIE^ACRFDIC
+8 QUIT
RESET ;EP;TO RESET CAN DEFAULTS FOR A DOCUMENT
+1 SET DIC="^ACRDOC("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="RESET CAN Defaults for Document NO.: "
+4 WRITE !
+5 DO DIC^ACRFDIC
+6 IF +Y<1
QUIT
+7 SET ACRDOCDA=+Y
+8 WRITE !!?10,$PIECE(^ACRDOC(+Y,0),U),?$X+3,$PIECE(^(0),U,2),?$X+3,$PIECE(^(0),U,14)
+9 SET DIR(0)="YO"
+10 SET DIR("A",1)="Are you certain you want to RESET the"
+11 SET DIR("A")="CAN Default values for this document"
+12 SET DIR("B")="NO"
+13 WRITE !
+14 DO DIR^ACRFDIC
+15 IF +Y'=1
QUIT
+16 SET DA=ACRDOCDA
+17 SET DIE="^ACRDOC("
+18 SET DR="113100////"_$PIECE(^ACRDOC(DA,"REQ"),U,10)
+19 DO DIE^ACRFDIC
+20 QUIT
