ACRFEA41 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 02/02/2005 10:23 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
;;ACRFEA4 CON'T
EDIT ;EP;
Q:$D(ACROUT)
F D E1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACRE1,ACRE2,ACRE
D EXCEED^ACRFWARN,SYNC^ACRFCIS
Q
E1 D E1^ACRFEA4D
D RESP^ACRFEA4
;S DIR("A")=" Which one(s)",DIR(0)="LO^1:"_ACREND K ACREND ;ACR*2.1*16.07 IM10095
S DIR("A")=" Which one(s)" ;ACR*2.1*16.07 IM10095
S DIR(0)="LO^1:"_$G(ACREND) ;ACR*2.1*16.07 IM10095
K ACREND ;ACR*2.1*16.07 IM10095
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(+Y<1)
S ACRE2=Y
N ACRE3
F ACRE3=1:1 S ACRE1=$P(ACRE2,",",ACRE3) Q:ACRE1="" D Q:$D(ACROUT)
.I ACRREFX=130 S ACRE1=$S(ACRE1=1:1,ACRE1=2:3,ACRE1=3:14,ACRE1=4:4,ACRE1=5:25,ACRE1=6:5,ACRE1=7:6,ACRE1=8:11,ACRE1=9:19,ACRE1=10:21,ACRE1=11:15,1:1)
.I ACRREFX=148 S ACRE1=$S(ACRE1=1:1,ACRE1=2:2,ACRE1=3:3,ACRE1=4:4,ACRE1=5:5,ACRE1=6:6,ACRE1=7:11,ACRE1=8:21,ACRE1=9:26,ACRE1=10:$S($$ACSREQ^ACRFTO(ACRDOCDA)'=1:15,1:28),ACRE1=11:15,1:1)
.I ACRREFX=600 S ACRE1=$S(ACRE1=1:4,ACRE1=2:25,ACRE1=3:5,ACRE1=4:6,ACRE1=5:11,ACRE1=6:14,ACRE1=7:21,ACRE1=8:24,ACRE1=9:15,1:4)
.I ACRREFX=103!(ACRREFX=349)!(ACRREFX=326) D
..I ACRE1=1 Q
..I ACRE1=2 S ACRE1=99 Q
..I ACRE1=3 S ACRE1=4 Q
..I ACRE1=4 S ACRE1=5 Q
..I ACRE1=5 S ACRE1=6 Q
..I ACRE1=6 S ACRE1=7 Q
..I ACRE1=7 S ACRE1=8 Q
..I ACRE1=8 S ACRE1=11 Q
..I ACRE1=9 S ACRE1=12 Q
..I ACRE1=10 S ACRE1=3 Q
..I ACRE1=11 S ACRE1=13 Q
..I ACRE1=12 S ACRE1=16 Q
..I ACRE1=13 S ACRE1=17 Q
..I ACRE1=14 S ACRE1=20 Q
..I ACRE1=15 S ACRE1=23 Q
..I ACRE1=16 S ACRE1=22 Q
..I ACRE1=17 S ACRE1=27 Q
..I ACRE1=18 S ACRE1=$S($G(ACRPOT)>2500:18,1:15) Q
..I ACRE1=19 S ACRE1=15
.I ACRREFX=116 D
..S:ACRE1=14 ACRE1=15
..S:ACRE1=13&($G(ACRPOT)'>2500) ACRE1=15
..S:ACRE1=13&($G(ACRPOT)>2500) ACRE1=18
..S:ACRE1=12 ACRE1=21
..S:ACRE1=11 ACRE1=20
..S:ACRE1=10 ACRE1=11
.S ACRE1=+ACRE1
.D @ACRE1 K ACRQUIT
Q
1 I ACRREF=103,$E($P($G(ACRDOC0),U,2),9,10)'="BP" D
.D CC^ACRFEA43
.I $P(^ACRDOC(ACRDOCDA,0),U,4)=35 D
..S DA=ACRDOCDA
..S DIE="^ACRDOC("
..S DR=".13///116"
..D DIE^ACRFDIC
..S DA=ACRDOCDA
..S DIE="^ACROBL("
..S DR=".1///116"
..D DIE^ACRFDIC
..S (ACRREF,ACRREFX)=116
..D SETDOC^ACRFEA1
I ACRREF=349!(ACRREF=326) D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR=".24T"
.W !
.D DIE^ACRFDIC
F D ACRDIE^ACRFEA2 Q:$D(ACRQUIT)!$D(ACROUT)!$D(ACRREV)!$D(ACROUT)
Q:ACRREF'=116&(ACRREF'=103)&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210)&(ACRREF'=148)
D ^ACRFEA43
Q
2 I $P(^ACRDOC(ACRDOCDA,0),U,19) D Q
.W !!,"The VENDOR is determined by the original BPA and cannot be changed."
.D PAUSE^ACRFWARN
.K ACRQUIT
D RV1^ACRFEA42
Q
3 D NJ^ACRFEA42
Q
4 D ^ACRFSS
Q
5 ;WHEN CREDIT CARD PURCHASE BEING SENT FOR APPROVAL BY PURCHASING AGENT
;SWITCH DOCUMENT IDENTITY BACK TO PURCHASE ORDER SO PURCHASING OFFICER
;APPROVAL SEQUENCE IS SELECTED
K ACRSWTCH
I ACRREF=116,$P($G(^ACROBL(ACRDOCDA,"APV")),U)="A",$P(^ACRDOC(ACRDOCDA,0),U,4)=35!($P(^(0),U,12)) D
.S (ACRREF,ACRREFX)=103
.S $P(ACRDOC0,U,13)=$O(^AUTTDOCR("B",103,0))
.S ACRSWTCH=""
I '$D(ACRPRCS),'$D(ACRREV),$D(^ACRSS("C",ACRDOCDA))!$D(^ACRSS("J",ACRDOCDA)) D APPROVE^ACRFEA21 I 1
E I '$D(ACRPRCS),'$D(ACRREV) D
.W !!,"Financial summary data missing for this request."
.W !,"Please ensure that the entire process is completed under 'Add/Edit'."
.D PAUSE^ACRFWARN
I $D(ACRSWTCH) S (ACRREF,ACRREFX)=116,$P(ACRDOC0,U,13)=$O(^AUTTDOCR("B",116,0)) K ACRSWTCH
Q
6 W !
D PR^ACRFEA42
Q
7 W !
D QD^ACRFEA42
Q
8 W !
D BP^ACRFEA42
Q
9 W !
D ATTACH^ACRFEA42
Q
11 W !
D RS^ACRFEA42
Q
12 W !
D ACCEPT^ACRFPO1
Q
13 W !
D ^ACRFVEND
Q
14 ;EP;
W !
D DESTIN^ACRFSS43
Q
15 W !
D RESP^ACRFRESP
Q
16 W !
D DOCSTAT^ACRFEA42
Q
17 W !
D ATTACH^ACRFPRC2
Q
18 W !
D ZIS^ACRFPCC
Q
19 D EN2^ACRFSS3
Q
20 D EN^ACRFSHIP
Q
21 D CANYO1^ACRFDEL
Q
22 Q
23 D ^ACRFPQT
Q
24 D TREPORT^ACRFTO
Q
25 D ^ACRFSS5
Q
26 D YES^ACRFTPAR
Q
27 D CHKLIST^ACRFPO3
Q
28 D ACS^ACRFTO
Q
99 D ^ACRFCIS
Q
ACRFEA41 ;IHS/OIRM/DSD/THL,AEF - EDIT FINANCIAL DATA; [ 02/02/2005 10:23 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**16**;NOV 05, 2001
+2 ;;ACRFEA4 CON'T
EDIT ;EP;
+1 IF $DATA(ACROUT)
QUIT
+2 FOR
DO E1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 KILL ACRQUIT,ACRE1,ACRE2,ACRE
+4 DO EXCEED^ACRFWARN
DO SYNC^ACRFCIS
+5 QUIT
E1 DO E1^ACRFEA4D
+1 DO RESP^ACRFEA4
+2 ;S DIR("A")=" Which one(s)",DIR(0)="LO^1:"_ACREND K ACREND ;ACR*2.1*16.07 IM10095
+3 ;ACR*2.1*16.07 IM10095
SET DIR("A")=" Which one(s)"
+4 ;ACR*2.1*16.07 IM10095
SET DIR(0)="LO^1:"_$GET(ACREND)
+5 ;ACR*2.1*16.07 IM10095
KILL ACREND
+6 WRITE !
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+Y<1)
QUIT
+9 SET ACRE2=Y
+10 NEW ACRE3
+11 FOR ACRE3=1:1
SET ACRE1=$PIECE(ACRE2,",",ACRE3)
IF ACRE1=""
QUIT
Begin DoDot:1
+12 IF ACRREFX=130
SET ACRE1=$SELECT(ACRE1=1:1,ACRE1=2:3,ACRE1=3:14,ACRE1=4:4,ACRE1=5:25,ACRE1=6:5,ACRE1=7:6,ACRE1=8:11,ACRE1=9:19,ACRE1=10:21,ACRE1=11:15,1:1)
+13 IF ACRREFX=148
SET ACRE1=$SELECT(ACRE1=1:1,ACRE1=2:2,ACRE1=3:3,ACRE1=4:4,ACRE1=5:5,ACRE1=6:6,ACRE1=7:11,ACRE1=8:21,ACRE1=9:26,ACRE1=10:$SELECT($$ACSREQ^ACRFTO(ACRDOCDA)'=1:15,1:28),ACRE1=11:15,1:1)
+14 IF ACRREFX=600
SET ACRE1=$SELECT(ACRE1=1:4,ACRE1=2:25,ACRE1=3:5,ACRE1=4:6,ACRE1=5:11,ACRE1=6:14,ACRE1=7:21,ACRE1=8:24,ACRE1=9:15,1:4)
+15 IF ACRREFX=103!(ACRREFX=349)!(ACRREFX=326)
Begin DoDot:2
+16 IF ACRE1=1
QUIT
+17 IF ACRE1=2
SET ACRE1=99
QUIT
+18 IF ACRE1=3
SET ACRE1=4
QUIT
+19 IF ACRE1=4
SET ACRE1=5
QUIT
+20 IF ACRE1=5
SET ACRE1=6
QUIT
+21 IF ACRE1=6
SET ACRE1=7
QUIT
+22 IF ACRE1=7
SET ACRE1=8
QUIT
+23 IF ACRE1=8
SET ACRE1=11
QUIT
+24 IF ACRE1=9
SET ACRE1=12
QUIT
+25 IF ACRE1=10
SET ACRE1=3
QUIT
+26 IF ACRE1=11
SET ACRE1=13
QUIT
+27 IF ACRE1=12
SET ACRE1=16
QUIT
+28 IF ACRE1=13
SET ACRE1=17
QUIT
+29 IF ACRE1=14
SET ACRE1=20
QUIT
+30 IF ACRE1=15
SET ACRE1=23
QUIT
+31 IF ACRE1=16
SET ACRE1=22
QUIT
+32 IF ACRE1=17
SET ACRE1=27
QUIT
+33 IF ACRE1=18
SET ACRE1=$SELECT($GET(ACRPOT)>2500:18,1:15)
QUIT
+34 IF ACRE1=19
SET ACRE1=15
End DoDot:2
+35 IF ACRREFX=116
Begin DoDot:2
+36 IF ACRE1=14
SET ACRE1=15
+37 IF ACRE1=13&($GET(ACRPOT)'>2500)
SET ACRE1=15
+38 IF ACRE1=13&($GET(ACRPOT)>2500)
SET ACRE1=18
+39 IF ACRE1=12
SET ACRE1=21
+40 IF ACRE1=11
SET ACRE1=20
+41 IF ACRE1=10
SET ACRE1=11
End DoDot:2
+42 SET ACRE1=+ACRE1
+43 DO @ACRE1
KILL ACRQUIT
End DoDot:1
IF $DATA(ACROUT)
QUIT
+44 QUIT
1 IF ACRREF=103
IF $EXTRACT($PIECE($GET(ACRDOC0),U,2),9,10)'="BP"
Begin DoDot:1
+1 DO CC^ACRFEA43
+2 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
Begin DoDot:2
+3 SET DA=ACRDOCDA
+4 SET DIE="^ACRDOC("
+5 SET DR=".13///116"
+6 DO DIE^ACRFDIC
+7 SET DA=ACRDOCDA
+8 SET DIE="^ACROBL("
+9 SET DR=".1///116"
+10 DO DIE^ACRFDIC
+11 SET (ACRREF,ACRREFX)=116
+12 DO SETDOC^ACRFEA1
End DoDot:2
End DoDot:1
+13 IF ACRREF=349!(ACRREF=326)
Begin DoDot:1
+14 SET DA=ACRDOCDA
+15 SET DIE="^ACRDOC("
+16 SET DR=".24T"
+17 WRITE !
+18 DO DIE^ACRFDIC
End DoDot:1
+19 FOR
DO ACRDIE^ACRFEA2
IF $DATA(ACRQUIT)!$DATA(ACROUT)!$DATA(ACRREV)!$DATA(ACROUT)
QUIT
+20 IF ACRREF'=116&(ACRREF'=103)&(ACRREF'=349)&(ACRREF'=326)&(ACRREF'=210)&(ACRREF'=148)
QUIT
+21 DO ^ACRFEA43
+22 QUIT
2 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,19)
Begin DoDot:1
+1 WRITE !!,"The VENDOR is determined by the original BPA and cannot be changed."
+2 DO PAUSE^ACRFWARN
+3 KILL ACRQUIT
End DoDot:1
QUIT
+4 DO RV1^ACRFEA42
+5 QUIT
3 DO NJ^ACRFEA42
+1 QUIT
4 DO ^ACRFSS
+1 QUIT
5 ;WHEN CREDIT CARD PURCHASE BEING SENT FOR APPROVAL BY PURCHASING AGENT
+1 ;SWITCH DOCUMENT IDENTITY BACK TO PURCHASE ORDER SO PURCHASING OFFICER
+2 ;APPROVAL SEQUENCE IS SELECTED
+3 KILL ACRSWTCH
+4 IF ACRREF=116
IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)="A"
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35!($PIECE(^(0),U,12))
Begin DoDot:1
+5 SET (ACRREF,ACRREFX)=103
+6 SET $PIECE(ACRDOC0,U,13)=$ORDER(^AUTTDOCR("B",103,0))
+7 SET ACRSWTCH=""
End DoDot:1
+8 IF '$DATA(ACRPRCS)
IF '$DATA(ACRREV)
IF $DATA(^ACRSS("C",ACRDOCDA))!$DATA(^ACRSS("J",ACRDOCDA))
DO APPROVE^ACRFEA21
IF 1
+9 IF '$TEST
IF '$DATA(ACRPRCS)
IF '$DATA(ACRREV)
Begin DoDot:1
+10 WRITE !!,"Financial summary data missing for this request."
+11 WRITE !,"Please ensure that the entire process is completed under 'Add/Edit'."
+12 DO PAUSE^ACRFWARN
End DoDot:1
+13 IF $DATA(ACRSWTCH)
SET (ACRREF,ACRREFX)=116
SET $PIECE(ACRDOC0,U,13)=$ORDER(^AUTTDOCR("B",116,0))
KILL ACRSWTCH
+14 QUIT
6 WRITE !
+1 DO PR^ACRFEA42
+2 QUIT
7 WRITE !
+1 DO QD^ACRFEA42
+2 QUIT
8 WRITE !
+1 DO BP^ACRFEA42
+2 QUIT
9 WRITE !
+1 DO ATTACH^ACRFEA42
+2 QUIT
11 WRITE !
+1 DO RS^ACRFEA42
+2 QUIT
12 WRITE !
+1 DO ACCEPT^ACRFPO1
+2 QUIT
13 WRITE !
+1 DO ^ACRFVEND
+2 QUIT
14 ;EP;
+1 WRITE !
+2 DO DESTIN^ACRFSS43
+3 QUIT
15 WRITE !
+1 DO RESP^ACRFRESP
+2 QUIT
16 WRITE !
+1 DO DOCSTAT^ACRFEA42
+2 QUIT
17 WRITE !
+1 DO ATTACH^ACRFPRC2
+2 QUIT
18 WRITE !
+1 DO ZIS^ACRFPCC
+2 QUIT
19 DO EN2^ACRFSS3
+1 QUIT
20 DO EN^ACRFSHIP
+1 QUIT
21 DO CANYO1^ACRFDEL
+1 QUIT
22 QUIT
23 DO ^ACRFPQT
+1 QUIT
24 DO TREPORT^ACRFTO
+1 QUIT
25 DO ^ACRFSS5
+1 QUIT
26 DO YES^ACRFTPAR
+1 QUIT
27 DO CHKLIST^ACRFPO3
+1 QUIT
28 DO ACS^ACRFTO
+1 QUIT
99 DO ^ACRFCIS
+1 QUIT
