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

ACRFDFLT.m

Go to the documentation of this file. 
  1. ACRFDFLT ;IHS/OIRM/DSD/THL,AEF - EDIT VARIOUS DEFAULTS;  [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;;ENTRY POINTS TO EDIT DEFAULT DATA
  1. CAND ;EP;TO EDIT CAN NO. DEFAULTS
  1.  F  D CAND1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. CAND1 ;EP;SELECT A CAN NUMBER
  1.  W @IOF
  1.  W !!?22,"EDIT CAN NO. DEFAULTS"
  1.  W !
  1.  S DIC="^ACRCAN("
  1.  S DIC(0)="AELMQZ"
  1.  S DIC("A")="COMMON ACCOUNTING NO: "
  1.  W !?21,"|=======|"
  1.  D DIC^ACRFDIC
  1.  I U[$E(X)!(+Y<1) S ACRQUIT="" Q
  1.  S ACRCANDA=+Y
  1.  I $P(Y,U,3) D DUP
  1.  F  D CAND2 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. CAND2 ;EDIT CAN NUMBER DEFAULTS
  1.  K ^TMP("ACRDCC",$J)
  1.  W @IOF
  1.  W !?10,"Which CAN DEFAULTS for CAN ",$P(^AUTTCAN(ACRCANDA,0),U)
  1.  S DIR(0)="SO^1:Requisition Defaults;2:Purchase Order Defaults;3:Travel Order/Voucher Defaults;4:Training Request Defaults"
  1.  S DIR("?")="Enter the number to indicate which set of DEFAULT values you want to edit."
  1.  D DIR^ACRFDIC
  1.  I $D(ACRQUIT)!$D(ACROUT)!($G(Y)<1) S ACRFDNCA=$P(^AUTTCAN(ACRCANDA,0),U) D CANCHK^ACRFEA1 S ACRQUIT="" Q
  1.  S DR="[ACR CAN "_$S(Y=1:"REQUISITION",Y=2:"PO",Y=3:"TRAVEL",Y=4:"TRAINING")_" DEFAULTS]"
  1.  N ACRD,ACRD1
  1.  K ACRFR,ACRTO
  1.  S DA=ACRCANDA
  1.  S DIE="^ACRCAN("
  1.  S ACR0=^ACRCAN(DA,0)
  1.  S ACRD=$G(^ACRCAN(DA,"DFLT"))
  1.  S ACRD1=$G(^ACRCAN(DA,"DFLT1"))
  1.  S ACRD2=$G(^ACRCAN(DA,"DFLT2"))
  1.  D DDS^ACRFDIC
  1.  I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
  1.  D:$D(^TMP("ACRDCC",$J)) EN2^ACRFDCC
  1.  K ^TMP("ACRDCC",$J)
  1.  Q
  1. PCAND ;EP;TO PRINT CAN NO. DEFAULTS
  1.  D PCEXIT
  1.  F  D PC Q:$D(ACRQUIT)!$D(ACROUT)
  1. PCEXIT K ACRQUIT,ACRCANDA,ACRQUIT,ACROUT,ACRGREF,ACRRTN,ACRJ
  1.  Q
  1. PC S DIR(0)="SO^1:Print for Single CAN;2:Print for All CAN's;3:Print for Selected CAN(s)"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)!($G(Y)<1)
  1.  I Y=1 D PC1 Q
  1.  I Y=2 D PC2 Q
  1.  I Y=3 D PC3 Q
  1.  Q
  1. PC1 K ACRCANDA
  1.  D PCAND1
  1.  Q:'$G(ACRCANDA)
  1.  D PCAND2
  1.  Q
  1. PC2 S DIR(0)="YO"
  1.  S DIR("A")="you want to print CAN DEFAULTS for all of these"
  1.  S DIR("A",1)="There are "_$P($G(^ACRCAN(0)),U,4)_" CAN's on file.  Are you certain"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$G(Y)'=1
  1.  S ACRRTN="PCPRINT^ACRFDFLT"
  1.  S ACRGREF="^ACRCAN"
  1.  D PCAND2
  1.  Q
  1. PC3 K ^TMP("ACRCANDF"),ACRRTN
  1.  F ACRJ=1:1 D PCAND11 Q:$D(ACRQUIT)!$D(ACROUT)!'$G(ACRCANDA)  S ^TMP("ACRCANDF",$J,ACRCANDA)=""
  1.  Q:'$D(^TMP("ACRCANDF"))
  1.  S ACRRTN="PCPRINT^ACRFDFLT"
  1.  S ACRGREF="^TMP(""ACRCANDF"")"
  1.  D PCAND2
  1.  Q
  1. PCAND1 ;EP;SELECT A CAN NUMBER
  1.  W @IOF
  1. PCAND11 W !!?22,"PRINT CAN NO. DEFAULTS"
  1.  W !
  1.  S DIC="^ACRCAN("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="COMMON ACCOUNTING NO: "
  1.  S:$G(ACRJ)>1 DIC("A")="Select another "_DIC("A")
  1.  W:'$G(ACRJ) !?21,"|=======|"
  1.  D DIC^ACRFDIC
  1.  I U[$E(X)!(+Y<1) S ACRQUIT="" Q
  1.  S ACRCANDA=+Y
  1.  Q
  1. PCAND2 ;EP;PRINT CAN NUMBER DEFAULTS
  1.  S ZTDESC="ARMS CAN DEFAULT SUMMARY"
  1.  S ZTSAVE("ACR*")=""
  1.  S ACRRTN=$S($D(ACRRTN):ACRRTN,1:"PCAND3^ACRFDFLT")
  1.  D ^ACRFZIS
  1.  Q
  1. PCAND3 ;EP;TO PRINT CAN DEFAULTS
  1.  S D0=ACRCANDA
  1.  D ^ACRPCAN
  1.  W @IOF
  1.  Q
  1. PCPRINT ;EP;TO PRINT ALL CAN DEFAULTS
  1.  N ACRCANDA
  1.  S ACRCANDA=0
  1.  F  S ACRCANDA=$O(@ACRGREF@(ACRCANDA)) Q:'ACRCANDA!$D(ACRQUIT)!$D(ACROUT)  D PCAND3
  1.  Q
  1. PD ;EP;TO ENTER/UPDATE PER DIEM CITY
  1.  S ACRHEAD="EDIT PER DIEM CITY"
  1.  S ACRDIC="^ACRPD"
  1.  S ACRDIC("A")="PER DIEM CITY.......: "
  1.  S ACRDR="[ACR PER DIEM]"
  1.  S ACRDIR("A")="Edit Per Diem City Info"
  1.  S ACRRTN="^ACRPPC"
  1.  D GEN
  1.  Q
  1. EMP ;EP;TO ENTER/UPDATE EMPLOYEE DATA
  1.  S ACRHEAD="EDIT AN EMPLOYEE"
  1.  S ACRDIC="^ATAEMP"
  1.  S ACRDIC("A")="EMPLOYEE............: "
  1.  S ACRDR="[ACR EMPLOYEE-2]"
  1.  S ACRDIR("A")="Edit Employee Data"
  1.  S ACRRTN="^ACREMP"
  1.  D GEN
  1.  Q
  1. PRG ;EP;TO ENTER/EDIT AN OFFICE/DIVISION/DEPARTMENT
  1.  S ACRHEAD="EDIT DEPARTMENT"
  1.  S ACRDIC="^AUTTPRG"
  1.  S ACRDIC("A")="DEPARTMENT NAME.....: "
  1.  S ACRDR="[ACR PROGRAM]"
  1.  S ACRDIR("A")="Edit Department Information"
  1.  S ACRRTN="^ACRPPRG"
  1.  D GEN
  1.  Q
  1. CAN ;EP;EDIT CAN NO.
  1.  W @IOF
  1.  W !?22,"EDIT COMMON ACCOUNTING NUMBERS"
  1.  F  D CAN1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. CAN1 S DIC(0)="AEMLQZ"
  1.  S DIC="^AUTTCAN("
  1.  S DIC("A")="CAN NO..............: "
  1.  W !!?21,"|=======|"
  1.  D DIC^ACRFDIC
  1.  I U[$E(X)!(+Y<1) S ACRQUIT="" Q
  1.  S DA=+Y
  1.  S DR=".01COMMON ACCOUNTING NO;.19M&M CAN............."
  1.  S DIE="^AUTTCAN("
  1.  D DIE^ACRFDIC
  1.  Q
  1. DUP ;DUPLCATE CAN DEFAULTS FROM AN EXISTING CAN
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Duplicate CAN Default data from an"
  1.  S DIR("A")="Existing CAN"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!$D(ACROUT)
  1.  Q:$G(Y)'=1
  1.  S DIC="^ACRCAN("
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select Existing CAN.: "
  1.  S DIC("S")="I +Y'=ACRCANDA"
  1.  W !?21,"|=======|"
  1.  D DIC^ACRFDIC
  1.  I U[$E(X)!(+Y<1) S ACRQUIT="" Q
  1.  S ACRCAN2=+Y
  1.  S %X="^ACRCAN("_+Y_","
  1.  S %Y="^ACRCAN("_ACRCANDA_","
  1.  D %XY^%RCR
  1.  S $P(^ACRCAN(ACRCANDA,0),U)=ACRCANDA
  1.  S DA=ACRCANDA
  1.  S DIK="^ACRCAN("
  1.  D IX1^ACRFDIC
  1.  W !!,"All data from CAN NO.: ",$P(^AUTTCAN(ACRCAN2,0),U)
  1.  W !,"has been duplicated in CAN NO.: ",$P(^AUTTCAN(ACRCANDA,0),U),"."
  1.  W !!,"You may now edit data for CAN NO.: ",$P(^AUTTCAN(ACRCANDA,0),U)
  1.  W !
  1.  K ACRCAN2
  1.  Q
  1. GEN ;EP;TO PROCESS TABLE EDITS
  1.  F  D G1 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT,ACRD0,ACRDA,ACRTX
  1.  Q
  1. G1 ;SELECT FILE ENTRY
  1.  W @IOF
  1.  W !?22,ACRHEAD
  1.  W !
  1.  S DIC=ACRDIC_"("
  1.  S DIC(0)="AELMQZ"
  1.  S:DIC["AUTTOBJC" DIC(0)="AEMQZ"
  1.  S DIC("DR")=""
  1.  S DIC("A")=ACRDIC("A")
  1.  D DIC^ACRFDIC
  1.  I U[$E($G(X))!(+Y<1) S ACRQUIT="" Q
  1.  I ACRDIC="^ACRPD",+Y<10000 D  Q
  1.  .S ACRD0=+Y
  1.  .D GDISP
  1.  .W !!,"This PER DIEM information can only be changed by Headquarters"
  1.  .D PAUSE^ACRFWARN
  1.  .S ACRQUIT=""
  1.  N ACRY
  1.  S (ACRD0,ACRDA)=+Y
  1.  S ACRY=$P(Y,U,3)
  1. G3 F  D G2 Q:$D(ACRQUIT)!$D(ACROUT)
  1.  K ACRQUIT
  1.  Q
  1. G2 ;EDIT FILE ENTRY
  1.  S DA=ACRDA
  1.  S DIE=ACRDIC_"("
  1.  S DR=ACRDR
  1.  D DDS^ACRFDIC
  1.  I '$D(ACRSCREN) D  Q
  1.  .I ACRDIC["AUTTOBJC" D OBJC1
  1.  .I ACRDIC["AUTTPRG" D
  1.  ..W @IOF
  1.  ..W !,"Additional information for: ",$P(^AUTTPRG(ACRDA,0),U),!
  1.  ..D G32
  1.  .S ACRQUIT=""
  1.  K ACRSCREN
  1.  S ACRY=""
  1.  D GDISP
  1.  S DIR(0)="YO"
  1.  S DIR("B")="NO"
  1.  S DIR("A")=ACRDIR("A")
  1.  W !
  1.  D DIR^ACRFDIC
  1.  I Y'=1 S ACRQUIT="" Q
  1. G31 S DA=ACRDA
  1.  S DIE=ACRDIC_"("
  1.  S DR=ACRDR
  1.  W !
  1.  D DIE^ACRFDIC
  1.  D OBJC1:ACRDIC["AUTTOBJC"
  1. G32 I ACRDIC["AUTTPRG" D
  1.  .I '$D(^ACRDEPT(ACRDA,0)) D
  1.  ..S (X,DINUM)=ACRDA
  1.  ..S DIC="^ACRDEPT("
  1.  ..S DIC(0)="L"
  1.  ..D FILE^ACRFDIC
  1.  .S DA=ACRDA
  1.  .S DIE="^ACRDEPT("
  1.  .S DR=".02T;W !!?22,""Enter the name of a PURCHASING AGENT for this DEPARTMENT"";W !?22,""ONLY if you want ALL requisitions originated by this"";W !?22,""departemnt assigned to this PURCHASING AGENT"";.03T"
  1.  .D DIE^ACRFDIC
  1.  K ACRTX
  1.  Q
  1. GDISP ;DISPLAY ENTRY DATA
  1.  W @IOF
  1.  W ?22,ACRHEAD
  1.  W !!
  1.  N DXS,DIP,DC,DN
  1.  S D0=ACRD0
  1.  D @ACRRTN
  1.  Q
  1. OBJC1 ;EDIT TRANSACTION TYPES FOR THIS OBJECT CODE
  1.  D GDISP
  1.  D OBJC2
  1.  S ACRLBTX=""
  1.  D DISPLAY^ACRFTXTP
  1.  K ACRLBTX
  1.  S DIR(0)="LO^1:"_ACRJ
  1.  S DIR("A")="Add which ARMS TRANSACTION TYPES for this OBJECT CODE"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:$D(ACRQUIT)!'+Y
  1.  S ACRTX=Y
  1.  F ACRJ=1:1 S ACRX=$P(ACRTX,",",ACRJ) Q:ACRX=""  D
  1.  .S DA(1)=+ACRTX(ACRX)
  1.  .S DIC="^ACRTXTYP("_DA(1)_",10,"
  1.  .S DIC(0)="L",(X,DINUM)=ACRDA
  1.  .S:'$D(^ACRTXTYP(DA(1),10,0)) ^ACRTXTYP(DA(1),10,0)="^9002194.1001P"
  1.  .I '$D(^ACRTXTYP(DA(1),10,X,0)) D FILE^ACRFDIC
  1.  K ACRTX
  1.  Q
  1. OBJC2 S DIR(0)="YO"
  1.  S DIR("A")="Delete an ARMS TRANSACTION TYPE from this OBJECT CODE"
  1.  S DIR("B")="NO"
  1.  N X
  1.  S (ACRJ,X)=0
  1.  F  S X=$O(ACRTX(X)) Q:'X  S ACRJ=ACRJ+1
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:Y'=1
  1.  S DIR(0)="LO^1:"_ACRJ
  1.  S DIR("A")="Which one(s)"
  1.  W !
  1.  D DIR^ACRFDIC
  1.  Q:'+Y
  1.  S ACRTX=Y
  1.  F ACRJ=1:1 S ACRX=$P(ACRTX,",",ACRJ) Q:'ACRX  D
  1.  .I $D(ACRTX(ACRX)),+ACRTX(ACRX) D
  1.  ..S DA(1)=+ACRTX(ACRX)
  1.  ..S DA=ACRDA
  1.  ..S DIK="^ACRTXTYP("_DA(1)_",10,"
  1.  ..D DIK^ACRFDIC
  1.  Q