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

ACRFAS.m

Go to the documentation of this file.
  1. 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
  1. ;;ROUTINE USED TO ENTER AND EDIT AREA OFFICE SPECIFIC DEFAULT DATA
  1. EN D EN1
  1. D:'$D(ACRQUIT) SYSCHK
  1. EXIT K ACRQUIT
  1. Q
  1. EN1 ;
  1. W @IOF
  1. W !?20,"AREA SYSTEM SETUP"
  1. W !
  1. D AREA
  1. Q:$D(ACRQUIT)
  1. I '$D(^ACRSYS(ACRADA,0)) D
  1. .S X=ACRADA
  1. .S DIC="^ACRSYS("
  1. .S DIC(0)="L"
  1. .D FILE^ACRFDIC
  1. S DA=ACRADA
  1. S DIE="^ACRSYS("
  1. S DR="[ACR SYSTEMS DEF]"
  1. D DDS^ACRFDIC
  1. I $D(ACRSCREN) K ACRSCREN D
  1. .F ACRDA=16,27,31,20,35,1,15,18,25,26,28,30,34,44 Q:$D(ACRQUIT) D
  1. ..S DA=ACRDA
  1. ..S ACR=$P($T(@DA),";;",2)
  1. ..S ACRPC=$P($T(@DA),";;",3)
  1. ..S DIC="^VA(200,"
  1. ..S DIC(0)="AEMQ"
  1. ..S DIC("A")=ACR_": "
  1. ..;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
  1. ..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
  1. ..D DIC^ACRFDIC
  1. ..Q:$D(ACRQUIT)!$D(ACROUT)
  1. ..I +Y>0 D
  1. ...S ACRDAX=+Y
  1. ...I $D(^VA(200,+Y,0)),'$D(^ACRAPL("AC",+Y,ACRDA)) D
  1. ....S X=+Y
  1. ....S DIC="^ACRAPL("
  1. ....S DIC(0)="L"
  1. ....S DIC("DR")=".02////"_ACRDA
  1. ....D FILE^ACRFDIC
  1. ...I ACRDAX>0 D
  1. ....S X=ACRDA
  1. ....S DA=ACRADA
  1. ....S DIE="^ACRSYS("
  1. ....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)
  1. ....S DR=DR_"////"_ACRDAX
  1. ....D DIE^ACRFDIC
  1. Q:$D(ACROUT)
  1. K ACRQUIT
  1. S DA=ACRADA
  1. S DIE="^ACRSYS("
  1. S DR="[ACR SYSTEMS DEF-2]"
  1. D DDS^ACRFDIC
  1. I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
  1. I $D(^ACRPO(1,0))&$D(^ACRPO(2,0)) D SUPER Q
  1. F ACRI=1,2,3 Q:$D(ACRQUIT) D
  1. .I '$D(^AUTTPRG(ACRI,0)) D
  1. ..S X="AREA "_$S(ACRI=1:"PROCURMENT AND CONTRACTING",ACRI=2:"FINANCE OFFICE",1:"PROPERTY AND SUPPLY")
  1. ..S DINUM=ACRI
  1. ..S DIC="^AUTTPRG("
  1. ..S DIC(0)="L"
  1. ..D FILE^ACRFDIC
  1. .W !!?25,"Enter Data for Area "
  1. .W $S(ACRI=1:"Procurement",ACRI=2:"Finance",1:"Property and Supply")
  1. .W " Department."
  1. .W !?25,"------------------------------------------"
  1. .S DA=ACRI
  1. .S DIE="^AUTTPRG("
  1. .S DR="[ACR PROGRAM]"
  1. .W !
  1. .D DDS^ACRFDIC
  1. .Q:'$D(ACRSCREN)
  1. .K ACRSCREN
  1. .D DIE^ACRFDIC
  1. Q:$D(ACROUT)
  1. SUPER ;ENTER NAMES OF AREA CONTRACT OFFICER AND PURCHASING SUPERVISOR
  1. I $D(^ACRPO(1,0)),$P(^(0),U,3)&$P(^(0),U,11) Q
  1. K ACRQUIT
  1. F ACRI=1,2 Q:$D(ACRQUIT) D
  1. .W !!?25,"Enter name of the Area "
  1. .W $S(ACRI=1:"Contract Officer.",1:"Purchasing Supervisor.")
  1. .W !?25,"------------------------------------------"
  1. .S DIC="^ACRPA("
  1. .S DIC(0)="AELMQZ"
  1. .S DIC("A")=$S(ACRI=1:"Area Contract Officer..: ",1:"Area Purchasing Supervisor: ")
  1. .D DIC^ACRFDIC
  1. .Q:+Y<1
  1. .S DA=+Y
  1. .S DIE="^ACRPA("
  1. .S DR=".02T"
  1. .D DIE^ACRFDIC
  1. Q
  1. DHR ;EP;TO DISPLAY AND EDIT SYSTEMS DHR INTERFACE INFO
  1. F D DHR1 Q:$D(ACRQUIT)!$D(ACROUT)
  1. K ACRQUIT,ACROUT
  1. Q
  1. DHR1 W @IOF
  1. W !?20,"DHR INTERFACE SUMMARY"
  1. W !!
  1. N DXS,DIP
  1. S D0=1
  1. D ^ACRPDHR
  1. S DIR(0)="YO"
  1. S DIR("A")="Edit this data"
  1. W !
  1. D DIR^ACRFDIC
  1. I $G(Y)'=1 S ACRQUIT="" Q
  1. S DA=1
  1. S DIE="^ACRSYS("
  1. S DR="[ACR SYSTEMS DHR SETUP]"
  1. D DDS^ACRFDIC
  1. Q:'$D(ACRSCREN)
  1. K ACRSCREN
  1. W !
  1. D DIE^ACRFDIC
  1. Q
  1. 31 ;;AREA PROPERTY CLEARANCE..;;11
  1. 20 ;;AREA PROPERTY MANAGEMENT.;;3
  1. 35 ;;AREA SUPPLY OFFICER......;;14
  1. 1 ;;AREA CONTRACT OFFICER....;;4
  1. 15 ;;AREA FINANCE OFFICER.....;;5
  1. 16 ;;AREA INFO SYSTEMS COORD..;;1
  1. 27 ;;AREA TELECOMMUNICATION...;;2
  1. 30 ;;AREA ADP SECURITY OFFICER;;10
  1. 34 ;;AREA M&M OFFICER.........;;12
  1. 18 ;;HQ OIRM..................;;6
  1. 25 ;;HQ TELECOMMUNICATIONS....;;7
  1. 26 ;;HQ DIV ADMIN SERVICES....;;8
  1. 28 ;;HQ PROPERTY MANAGEMENT...;;9
  1. 44 ;;DIR HQ OPERATIONS........;;15
  1. ;;
  1. SYSCHK ;EP;TO ENSURE AREA SETUP IS COMPLETE
  1. I '$D(^ACRSYS(ACRADA,0))!'$D(^ACRSYS(ACRADA,"DT"))!$G(^ACRSYS(ACRADA,"DT"))="" D Q
  1. .W !!,*7,*7,"AREA SYSTEM SETUP must be completed before you proceed with any ARMS functions."
  1. S ACRX=$G(^ACRSYS(ACRADA,"DT"))
  1. F ACRI=1:1:18 I $P(ACRX,U,ACRI)="" D SC1
  1. I $D(ACRQUIT) D
  1. .W !!,*7,*7,"You must complete this data befor you proceed with any ARMS functions."
  1. .D PAUSE^ACRFWARN
  1. Q
  1. SC1 W !!,*7,*7,@ACRON,$P($T(MD+ACRI),";;",2),@ACROF," data is missing."
  1. S ACRQUIT=""
  1. Q
  1. AREA ;EP;TO SELECT AREA SETUP
  1. K ACRADA
  1. S DIC="^ACRSYS("
  1. S DIC(0)=$S('$D(DIC(0))#2:"AELMQZ",1:DIC(0))
  1. S DIC("A")="Setup for which AREA OFFICE: "
  1. S DIC("B")=$P(^AUTTAREA(+^ACRSYS(1,0),0),U)
  1. W !
  1. D DIC^ACRFDIC
  1. I $D(ACRQUIT)!$D(ACROUT)!(+Y<1) S ACRQUIT="" Q
  1. S ACRADA=+Y
  1. Q
  1. MD ;MISSING DATA HEADINGS
  1. ;;AREA INFO SYSTEMS COORD
  1. ;;AREA TELECOMMUNICATION
  1. ;;AREA PROPERTY MANAGEMENT
  1. ;;AREA CONTRACT OFFICER
  1. ;;AREA FINANCE OFFICER
  1. ;;HQ OIRM
  1. ;;HQ TELECOMMUNICATIONS
  1. ;;HQ DIV ADMIN SERVICES
  1. ;;HQ PROPERTY MANAGEMENT
  1. ;;AREA ADP SECURITY OFFICER
  1. ;;AREA PROPERTY CLEARANCE
  1. ;;AREA M&M OFFICER
  1. ;;STANDARD MILEAGE RATE
  1. ;;AREA SUPPLY OFFICER
  1. ;;DIR HQ OPERATIONS
  1. ;;ATM SERVICE CHARGE RATE
  1. ;;DAILY PHONE CALL AMOUNT
  1. ;;AIRLINE TICKET CHARGED TO GOVT CC
  1. ;;EXCEED ESTIMATE BY PERCENT
  1. ;;EXCEED ESTIMATE BY MAXIMUM AMOUNT
  1. ;;CONUS LODGING
  1. ;;CONUS PERDIEM