- 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
