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