ACRFAS ;IHS/OIRM/DSD/THL,AEF - UTILITY TO SET UP AREA SYSTEMS DATA; [ 09/22/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;ROUTINE USED TO ENTER AND EDIT AREA OFFICE SPECIFIC DEFAULT DATA
EN D EN1
D:'$D(ACRQUIT) SYSCHK
EXIT K ACRQUIT
Q
EN1 ;
W @IOF
W !?20,"AREA SYSTEM SETUP"
W !
D AREA
Q:$D(ACRQUIT)
I '$D(^ACRSYS(ACRADA,0)) D
.S X=ACRADA
.S DIC="^ACRSYS("
.S DIC(0)="L"
.D FILE^ACRFDIC
S DA=ACRADA
S DIE="^ACRSYS("
S DR="[ACR SYSTEMS DEF]"
D DDS^ACRFDIC
I $D(ACRSCREN) K ACRSCREN D
.F ACRDA=16,27,31,20,35,1,15,18,25,26,28,30,34,44 Q:$D(ACRQUIT) D
..S DA=ACRDA
..S ACR=$P($T(@DA),";;",2)
..S ACRPC=$P($T(@DA),";;",3)
..S DIC="^VA(200,"
..S DIC(0)="AEMQ"
..S DIC("A")=ACR_": "
..;I $D(^ACRSYS(ACRADA,"DT")),$P(^("DT"),U,ACRPC),$D(^VA(200,$P(^("DT"),U,ACRPC),0)) S DIC("B")=$P(^(0),U) ;ACR*2.1*19.02 IM16848
..I $D(^ACRSYS(ACRADA,"DT")),$P(^("DT"),U,ACRPC),$D(^VA(200,$P(^("DT"),U,ACRPC),0)) S DIC("B")=$$NAME2^ACRFUTL1($P(^ACRSYS(ACRADA,"DT"),U,ACRPC)) ;ACR*2.1*19.02 IM16848
..D DIC^ACRFDIC
..Q:$D(ACRQUIT)!$D(ACROUT)
..I +Y>0 D
...S ACRDAX=+Y
...I $D(^VA(200,+Y,0)),'$D(^ACRAPL("AC",+Y,ACRDA)) D
....S X=+Y
....S DIC="^ACRAPL("
....S DIC(0)="L"
....S DIC("DR")=".02////"_ACRDA
....D FILE^ACRFDIC
...I ACRDAX>0 D
....S X=ACRDA
....S DA=ACRADA
....S DIE="^ACRSYS("
....S DR=$S(X=16:1,X=27:2,X=31:11,X=20:3,X=35:14,X=1:4,X=15:5,X=18:6,X=25:7,X=26:8,X=28:9,X=30:10,X=34:12,X=44:15)
....S DR=DR_"////"_ACRDAX
....D DIE^ACRFDIC
Q:$D(ACROUT)
K ACRQUIT
S DA=ACRADA
S DIE="^ACRSYS("
S DR="[ACR SYSTEMS DEF-2]"
D DDS^ACRFDIC
I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
I $D(^ACRPO(1,0))&$D(^ACRPO(2,0)) D SUPER Q
F ACRI=1,2,3 Q:$D(ACRQUIT) D
.I '$D(^AUTTPRG(ACRI,0)) D
..S X="AREA "_$S(ACRI=1:"PROCURMENT AND CONTRACTING",ACRI=2:"FINANCE OFFICE",1:"PROPERTY AND SUPPLY")
..S DINUM=ACRI
..S DIC="^AUTTPRG("
..S DIC(0)="L"
..D FILE^ACRFDIC
.W !!?25,"Enter Data for Area "
.W $S(ACRI=1:"Procurement",ACRI=2:"Finance",1:"Property and Supply")
.W " Department."
.W !?25,"------------------------------------------"
.S DA=ACRI
.S DIE="^AUTTPRG("
.S DR="[ACR PROGRAM]"
.W !
.D DDS^ACRFDIC
.Q:'$D(ACRSCREN)
.K ACRSCREN
.D DIE^ACRFDIC
Q:$D(ACROUT)
SUPER ;ENTER NAMES OF AREA CONTRACT OFFICER AND PURCHASING SUPERVISOR
I $D(^ACRPO(1,0)),$P(^(0),U,3)&$P(^(0),U,11) Q
K ACRQUIT
F ACRI=1,2 Q:$D(ACRQUIT) D
.W !!?25,"Enter name of the Area "
.W $S(ACRI=1:"Contract Officer.",1:"Purchasing Supervisor.")
.W !?25,"------------------------------------------"
.S DIC="^ACRPA("
.S DIC(0)="AELMQZ"
.S DIC("A")=$S(ACRI=1:"Area Contract Officer..: ",1:"Area Purchasing Supervisor: ")
.D DIC^ACRFDIC
.Q:+Y<1
.S DA=+Y
.S DIE="^ACRPA("
.S DR=".02T"
.D DIE^ACRFDIC
Q
DHR ;EP;TO DISPLAY AND EDIT SYSTEMS DHR INTERFACE INFO
F D DHR1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACROUT
Q
DHR1 W @IOF
W !?20,"DHR INTERFACE SUMMARY"
W !!
N DXS,DIP
S D0=1
D ^ACRPDHR
S DIR(0)="YO"
S DIR("A")="Edit this data"
W !
D DIR^ACRFDIC
I $G(Y)'=1 S ACRQUIT="" Q
S DA=1
S DIE="^ACRSYS("
S DR="[ACR SYSTEMS DHR SETUP]"
D DDS^ACRFDIC
Q:'$D(ACRSCREN)
K ACRSCREN
W !
D DIE^ACRFDIC
Q
31 ;;AREA PROPERTY CLEARANCE..;;11
20 ;;AREA PROPERTY MANAGEMENT.;;3
35 ;;AREA SUPPLY OFFICER......;;14
1 ;;AREA CONTRACT OFFICER....;;4
15 ;;AREA FINANCE OFFICER.....;;5
16 ;;AREA INFO SYSTEMS COORD..;;1
27 ;;AREA TELECOMMUNICATION...;;2
30 ;;AREA ADP SECURITY OFFICER;;10
34 ;;AREA M&M OFFICER.........;;12
18 ;;HQ OIRM..................;;6
25 ;;HQ TELECOMMUNICATIONS....;;7
26 ;;HQ DIV ADMIN SERVICES....;;8
28 ;;HQ PROPERTY MANAGEMENT...;;9
44 ;;DIR HQ OPERATIONS........;;15
;;
SYSCHK ;EP;TO ENSURE AREA SETUP IS COMPLETE
I '$D(^ACRSYS(ACRADA,0))!'$D(^ACRSYS(ACRADA,"DT"))!$G(^ACRSYS(ACRADA,"DT"))="" D Q
.W !!,*7,*7,"AREA SYSTEM SETUP must be completed before you proceed with any ARMS functions."
S ACRX=$G(^ACRSYS(ACRADA,"DT"))
F ACRI=1:1:18 I $P(ACRX,U,ACRI)="" D SC1
I $D(ACRQUIT) D
.W !!,*7,*7,"You must complete this data befor you proceed with any ARMS functions."
.D PAUSE^ACRFWARN
Q
SC1 W !!,*7,*7,@ACRON,$P($T(MD+ACRI),";;",2),@ACROF," data is missing."
S ACRQUIT=""
Q
AREA ;EP;TO SELECT AREA SETUP
K ACRADA
S DIC="^ACRSYS("
S DIC(0)=$S('$D(DIC(0))#2:"AELMQZ",1:DIC(0))
S DIC("A")="Setup for which AREA OFFICE: "
S DIC("B")=$P(^AUTTAREA(+^ACRSYS(1,0),0),U)
W !
D DIC^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!(+Y<1) S ACRQUIT="" Q
S ACRADA=+Y
Q
MD ;MISSING DATA HEADINGS
;;AREA INFO SYSTEMS COORD
;;AREA TELECOMMUNICATION
;;AREA PROPERTY MANAGEMENT
;;AREA CONTRACT OFFICER
;;AREA FINANCE OFFICER
;;HQ OIRM
;;HQ TELECOMMUNICATIONS
;;HQ DIV ADMIN SERVICES
;;HQ PROPERTY MANAGEMENT
;;AREA ADP SECURITY OFFICER
;;AREA PROPERTY CLEARANCE
;;AREA M&M OFFICER
;;STANDARD MILEAGE RATE
;;AREA SUPPLY OFFICER
;;DIR HQ OPERATIONS
;;ATM SERVICE CHARGE RATE
;;DAILY PHONE CALL AMOUNT
;;AIRLINE TICKET CHARGED TO GOVT CC
;;EXCEED ESTIMATE BY PERCENT
;;EXCEED ESTIMATE BY MAXIMUM AMOUNT
;;CONUS LODGING
;;CONUS PERDIEM
ACRFAS ;IHS/OIRM/DSD/THL,AEF - UTILITY TO SET UP AREA SYSTEMS DATA; [ 09/22/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;ROUTINE USED TO ENTER AND EDIT AREA OFFICE SPECIFIC DEFAULT DATA
EN DO EN1
+1 IF '$DATA(ACRQUIT)
DO SYSCHK
EXIT KILL ACRQUIT
+1 QUIT
EN1 ;
+1 WRITE @IOF
+2 WRITE !?20,"AREA SYSTEM SETUP"
+3 WRITE !
+4 DO AREA
+5 IF $DATA(ACRQUIT)
QUIT
+6 IF '$DATA(^ACRSYS(ACRADA,0))
Begin DoDot:1
+7 SET X=ACRADA
+8 SET DIC="^ACRSYS("
+9 SET DIC(0)="L"
+10 DO FILE^ACRFDIC
End DoDot:1
+11 SET DA=ACRADA
+12 SET DIE="^ACRSYS("
+13 SET DR="[ACR SYSTEMS DEF]"
+14 DO DDS^ACRFDIC
+15 IF $DATA(ACRSCREN)
KILL ACRSCREN
Begin DoDot:1
+16 FOR ACRDA=16,27,31,20,35,1,15,18,25,26,28,30,34,44
IF $DATA(ACRQUIT)
QUIT
Begin DoDot:2
+17 SET DA=ACRDA
+18 SET ACR=$PIECE($TEXT(@DA),";;",2)
+19 SET ACRPC=$PIECE($TEXT(@DA),";;",3)
+20 SET DIC="^VA(200,"
+21 SET DIC(0)="AEMQ"
+22 SET DIC("A")=ACR_": "
+23 ;I $D(^ACRSYS(ACRADA,"DT")),$P(^("DT"),U,ACRPC),$D(^VA(200,$P(^("DT"),U,ACRPC),0)) S DIC("B")=$P(^(0),U) ;ACR*2.1*19.02 IM16848
+24 ;ACR*2.1*19.02 IM16848
IF $DATA(^ACRSYS(ACRADA,"DT"))
IF $PIECE(^("DT"),U,ACRPC)
IF $DATA(^VA(200,$PIECE(^("DT"),U,ACRPC),0))
SET DIC("B")=$$NAME2^ACRFUTL1($PIECE(^ACRSYS(ACRADA,"DT"),U,ACRPC))
+25 DO DIC^ACRFDIC
+26 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+27 IF +Y>0
Begin DoDot:3
+28 SET ACRDAX=+Y
+29 IF $DATA(^VA(200,+Y,0))
IF '$DATA(^ACRAPL("AC",+Y,ACRDA))
Begin DoDot:4
+30 SET X=+Y
+31 SET DIC="^ACRAPL("
+32 SET DIC(0)="L"
+33 SET DIC("DR")=".02////"_ACRDA
+34 DO FILE^ACRFDIC
End DoDot:4
+35 IF ACRDAX>0
Begin DoDot:4
+36 SET X=ACRDA
+37 SET DA=ACRADA
+38 SET DIE="^ACRSYS("
+39 SET DR=$SELECT(X=16:1,X=27:2,X=31:11,X=20:3,X=35:14,X=1:4,X=15:5,X=18:6,X=25:7,X=26:8,X=28:9,X=30:10,X=34:12,X=44:15)
+40 SET DR=DR_"////"_ACRDAX
+41 DO DIE^ACRFDIC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 IF $DATA(ACROUT)
QUIT
+43 KILL ACRQUIT
+44 SET DA=ACRADA
+45 SET DIE="^ACRSYS("
+46 SET DR="[ACR SYSTEMS DEF-2]"
+47 DO DDS^ACRFDIC
+48 IF $DATA(ACRSCREN)
KILL ACRSCREN
DO DIE^ACRFDIC
+49 IF $DATA(^ACRPO(1,0))&$DATA(^ACRPO(2,0))
DO SUPER
QUIT
+50 FOR ACRI=1,2,3
IF $DATA(ACRQUIT)
QUIT
Begin DoDot:1
+51 IF '$DATA(^AUTTPRG(ACRI,0))
Begin DoDot:2
+52 SET X="AREA "_$SELECT(ACRI=1:"PROCURMENT AND CONTRACTING",ACRI=2:"FINANCE OFFICE",1:"PROPERTY AND SUPPLY")
+53 SET DINUM=ACRI
+54 SET DIC="^AUTTPRG("
+55 SET DIC(0)="L"
+56 DO FILE^ACRFDIC
End DoDot:2
+57 WRITE !!?25,"Enter Data for Area "
+58 WRITE $SELECT(ACRI=1:"Procurement",ACRI=2:"Finance",1:"Property and Supply")
+59 WRITE " Department."
+60 WRITE !?25,"------------------------------------------"
+61 SET DA=ACRI
+62 SET DIE="^AUTTPRG("
+63 SET DR="[ACR PROGRAM]"
+64 WRITE !
+65 DO DDS^ACRFDIC
+66 IF '$DATA(ACRSCREN)
QUIT
+67 KILL ACRSCREN
+68 DO DIE^ACRFDIC
End DoDot:1
+69 IF $DATA(ACROUT)
QUIT
SUPER ;ENTER NAMES OF AREA CONTRACT OFFICER AND PURCHASING SUPERVISOR
+1 IF $DATA(^ACRPO(1,0))
IF $PIECE(^(0),U,3)&$PIECE(^(0),U,11)
QUIT
+2 KILL ACRQUIT
+3 FOR ACRI=1,2
IF $DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 WRITE !!?25,"Enter name of the Area "
+5 WRITE $SELECT(ACRI=1:"Contract Officer.",1:"Purchasing Supervisor.")
+6 WRITE !?25,"------------------------------------------"
+7 SET DIC="^ACRPA("
+8 SET DIC(0)="AELMQZ"
+9 SET DIC("A")=$SELECT(ACRI=1:"Area Contract Officer..: ",1:"Area Purchasing Supervisor: ")
+10 DO DIC^ACRFDIC
+11 IF +Y<1
QUIT
+12 SET DA=+Y
+13 SET DIE="^ACRPA("
+14 SET DR=".02T"
+15 DO DIE^ACRFDIC
End DoDot:1
+16 QUIT
DHR ;EP;TO DISPLAY AND EDIT SYSTEMS DHR INTERFACE INFO
+1 FOR
DO DHR1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT,ACROUT
+3 QUIT
DHR1 WRITE @IOF
+1 WRITE !?20,"DHR INTERFACE SUMMARY"
+2 WRITE !!
+3 NEW DXS,DIP
+4 SET D0=1
+5 DO ^ACRPDHR
+6 SET DIR(0)="YO"
+7 SET DIR("A")="Edit this data"
+8 WRITE !
+9 DO DIR^ACRFDIC
+10 IF $GET(Y)'=1
SET ACRQUIT=""
QUIT
+11 SET DA=1
+12 SET DIE="^ACRSYS("
+13 SET DR="[ACR SYSTEMS DHR SETUP]"
+14 DO DDS^ACRFDIC
+15 IF '$DATA(ACRSCREN)
QUIT
+16 KILL ACRSCREN
+17 WRITE !
+18 DO DIE^ACRFDIC
+19 QUIT
31 ;;AREA PROPERTY CLEARANCE..;;11
20 ;;AREA PROPERTY MANAGEMENT.;;3
35 ;;AREA SUPPLY OFFICER......;;14
1 ;;AREA CONTRACT OFFICER....;;4
15 ;;AREA FINANCE OFFICER.....;;5
16 ;;AREA INFO SYSTEMS COORD..;;1
27 ;;AREA TELECOMMUNICATION...;;2
30 ;;AREA ADP SECURITY OFFICER;;10
34 ;;AREA M&M OFFICER.........;;12
18 ;;HQ OIRM..................;;6
25 ;;HQ TELECOMMUNICATIONS....;;7
26 ;;HQ DIV ADMIN SERVICES....;;8
28 ;;HQ PROPERTY MANAGEMENT...;;9
44 ;;DIR HQ OPERATIONS........;;15
+1 ;;
SYSCHK ;EP;TO ENSURE AREA SETUP IS COMPLETE
+1 IF '$DATA(^ACRSYS(ACRADA,0))!'$DATA(^ACRSYS(ACRADA,"DT"))!$GET(^ACRSYS(ACRADA,"DT"))=""
Begin DoDot:1
+2 WRITE !!,*7,*7,"AREA SYSTEM SETUP must be completed before you proceed with any ARMS functions."
End DoDot:1
QUIT
+3 SET ACRX=$GET(^ACRSYS(ACRADA,"DT"))
+4 FOR ACRI=1:1:18
IF $PIECE(ACRX,U,ACRI)=""
DO SC1
+5 IF $DATA(ACRQUIT)
Begin DoDot:1
+6 WRITE !!,*7,*7,"You must complete this data befor you proceed with any ARMS functions."
+7 DO PAUSE^ACRFWARN
End DoDot:1
+8 QUIT
SC1 WRITE !!,*7,*7,@ACRON,$PIECE($TEXT(MD+ACRI),";;",2),@ACROF," data is missing."
+1 SET ACRQUIT=""
+2 QUIT
AREA ;EP;TO SELECT AREA SETUP
+1 KILL ACRADA
+2 SET DIC="^ACRSYS("
+3 SET DIC(0)=$SELECT('$DATA(DIC(0))#2:"AELMQZ",1:DIC(0))
+4 SET DIC("A")="Setup for which AREA OFFICE: "
+5 SET DIC("B")=$PIECE(^AUTTAREA(+^ACRSYS(1,0),0),U)
+6 WRITE !
+7 DO DIC^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+Y<1)
SET ACRQUIT=""
QUIT
+9 SET ACRADA=+Y
+10 QUIT
MD ;MISSING DATA HEADINGS
+1 ;;AREA INFO SYSTEMS COORD
+2 ;;AREA TELECOMMUNICATION
+3 ;;AREA PROPERTY MANAGEMENT
+4 ;;AREA CONTRACT OFFICER
+5 ;;AREA FINANCE OFFICER
+6 ;;HQ OIRM
+7 ;;HQ TELECOMMUNICATIONS
+8 ;;HQ DIV ADMIN SERVICES
+9 ;;HQ PROPERTY MANAGEMENT
+10 ;;AREA ADP SECURITY OFFICER
+11 ;;AREA PROPERTY CLEARANCE
+12 ;;AREA M&M OFFICER
+13 ;;STANDARD MILEAGE RATE
+14 ;;AREA SUPPLY OFFICER
+15 ;;DIR HQ OPERATIONS
+16 ;;ATM SERVICE CHARGE RATE
+17 ;;DAILY PHONE CALL AMOUNT
+18 ;;AIRLINE TICKET CHARGED TO GOVT CC
+19 ;;EXCEED ESTIMATE BY PERCENT
+20 ;;EXCEED ESTIMATE BY MAXIMUM AMOUNT
+21 ;;CONUS LODGING
+22 ;;CONUS PERDIEM
