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