PRCFFU12 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS CONT ;6/13/94 14:34
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
; Allows Fiscal to edit Cost Center and BOCs prior to PO obligation
PO ; PO Correction
; Fiscal cannot edit if FCP is a Special Fund Control Point (2)
N CCEDIT,BOCEDIT,ESHEDIT D PROMPT
S (CCEDIT,BOCEDIT,ESHEDIT)=0
Q:'Y!($D(DIRUT))
I Y D
.I +$P(PCP,"^",2)=2 D MSG7 Q
.I +$P(PCP,"^",2)<2!(+$P(PCP,"^",2)>2) D CCEDIT,SAEDIT
I (CCEDIT=0)&(BOCEDIT=0)&(ESHEDIT=1) S PRCHPO=PRCFA("PODA") D MSG1,^PRCHSF
QUIT
;
CCEDIT ; Cost Center edit
S CCEDIT=0,OLDCC=$P(PO(0),U,5)
W !! N MSG S MSG(1)="...now editing the Cost Center...",MSG(2)="" D EN^DDIOL(.MSG)
S DA=PRCFA("PODA"),DR="2;",DIE="^PRC(442," D ^DIE K DIE,DR
S NEWCC=X I OLDCC'=NEWCC S (FISCEDIT,CCEDIT)=1,PO(0)=^PRC(442,DA,0)
Q
SAEDIT ; BOC Edit
D ESHEDIT
S BOCEDIT=0
W !! N MSG S MSG(1)="...now editing the line item BOCs...",MSG(2)="" D EN^DDIOL(.MSG)
K DIR S DIR(0)="Y",DIR("A")="Do you wish to assign the same BOC to ALL items",DIR("B")="NO"
D ^DIR K DIR W !!
G:Y ALLITEMS
K DIR S DIR(0)="Y",DIR("A")="Do you wish to edit specific line items",DIR("B")="YES"
D ^DIR K DIR
G:Y ONEITEM
I 'Y!($D(DIRUT)) D MSG6 Q
Q
ONEITEM ; Edit BOC for one item
S BOCEDIT=0
S DIC("A")="Select ITEM: ",DA(1)=PRCFA("PODA"),DIC="^PRC(442,"_DA(1)_",2,",DIC(0)="AEQMZ" D ^DIC K DIC("A")
I Y<0 S:X["^" PRCFOUT="" S (PRCHPO,DA)=PRCFA("PODA"),(FISCEDIT,BOCEDIT)=1 D MSG1,^PRCHSF S PO(0)=^PRC(442,PRCFA("PODA"),0) S %=$S($D(PRCFOUT):-1,1:1) Q
S DA=+Y,DIE=DIC,DR=3.5 D ^DIE S DIC("A")="Select Next ITEM: ",(D0,DA)=PRCFA("PODA") G ONEITEM
ALLITEMS ; Edit BOCs for all items
S BOCEDIT=0
S DIC=420.2,DIC(0)="AQEMNZ" D ^DIC I Y<0 D MSG6 Q
S SA=+Y I $P(PO(0),"^",5)="" D MSG2 G OUT3^PRCFFMO1
S SA=$P(Y(0),U) I '$D(^PRCD(420.1,$P(PO(0),"^",5),1,+SA)) W $C(7) D MSG3 G ALLITEMS
I 'Y!($D(DIRUT)) W !! D MSG21 G OUT^PRCFFMO1
D MSG4 I 'Y!($D(DIRUT)) D MSG6 Q
D MSG5 S ITEM=0 F S ITEM=$O(^PRC(442,PRCFA("PODA"),2,ITEM)) Q:'ITEM D
.S DA(1)=PRCFA("PODA"),DA=ITEM,DIE="^PRC(442,"_DA(1)_",2,",DR="3.5///^S X=SA" D ^DIE K DIE,DR
K SA S (PRCHPO,DA)=PRCFA("PODA"),(FISCEDIT,BOCEDIT)=1 D MSG1,^PRCHSF S PO(0)=^PRC(442,PRCFA("PODA"),0)
Q
PROMPT ; Prompt for user
S DIR(0)="Y",DIR("A")="Should the Cost Center or BOC information be edited at this time",DIR("B")="NO"
S DIR("?")="Enter 'NO' or 'N' or 'RETURN' if no editing is needed."
S DIR("?",1)="Enter '^' to exit the option."
S DIR("?",2)="Enter 'YES' or 'Y' to edit this information."
W ! D ^DIR K DIR
Q
ESHEDIT ; Edit Shipping BOC
S ESHEDIT=0
D GENDIQ^PRCFFU7(442,+PO,"13;13.05","IEN","")
I $G(PRCTMP(442,+PO,13,"I"))="" Q
I $G(PRCTMP(442,+PO,13,"I")) D
.K MSG W !!
.S MSG(1)="...now editing Estimated Shipping BOC...",MSG(2)=" ",MSG(3)="The BOC for Estimated Shipping is '"_$G(PRCTMP(442,+PO,13.05,"E"))_"'."
.D EN^DDIOL(.MSG) K MSG
.S DIR(0)="Y",DIR("A")="Should I change the BOC for Estimated Shipping",DIR("B")="YES" W ! D ^DIR K DIR
.I 'Y!($D(DIRUT)) W ! D EN^DDIOL("No change made to Shipping BOC.") Q
.I Y D
..W !
..S DA=+PO,DIE=442,DR=13.05 D ^DIE K DIE,DR
..S (ESHEDIT,FISCEDIT)=1
..Q
.Q
K PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05)
Q
; Message processing
MSG1 K MSG W !! S MSG="...now recalculating FMS accounting lines..." D EN^DDIOL(MSG) K MSG W !
Q
;
MSG2 K MSG W !! S MSG(1)="...Cost Center is missing - cannot continue..."
MSG21 S MSG(2)=" ",MSG(3)="No further action is being taken on this obligation."
D EN^DDIOL(.MSG) K MSG W !
Q
;
MSG3 K MSG W !! S MSG(1)="BOC '"_SA_"' is not valid with Cost Center "_$P(PO(0),U,5)_".",MSG(2)="Please ensure that this BOC is properly linked with the Cost Center."
D EN^DDIOL(.MSG) K MSG W !
Q
;
MSG4 W !! S DIR(0)="Y",DIR("A",1)="I will now enter BOC '"_SA_"' on all line items.",DIR("A")="Is this OK",DIR("B")="YES"
D ^DIR K DIR
Q
;
MSG5 K MSG W !! S MSG="...now changing the BOCs on all line items..."
D EN^DDIOL(MSG) K MSG W !
Q
MSG6 I (CCEDIT=1)!(BOCEDIT=1)!(ESHEDIT=1) Q
K MSG W !!
S MSG(1)="",MSG(2)=""
S:CCEDIT=0 MSG(1)="Cost Center has not changed.",MSG(3)=" "
S:BOCEDIT=0 MSG(2)="BOC has not changed.",MSG(4)=" "
S MSG(5)="No further editing is being done on this obligation.",MSG(6)=" "
S MSG(7)="Returning to the Obligation processing."
D EN^DDIOL(.MSG) K MSG W !
Q
MSG7 ;
K MSG W !! S MSG(1)="Cost Center and BOCs cannot be edited for Supply Fund orders."
S MSG(2)=" "
S MSG(3)="Returning to the Obligation processing."
D EN^DDIOL(.MSG) K MSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFU12 4631 printed Sep 23, 2025@19:39:40 Page 2
PRCFFU12 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS CONT ;6/13/94 14:34
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ; Allows Fiscal to edit Cost Center and BOCs prior to PO obligation
PO ; PO Correction
+1 ; Fiscal cannot edit if FCP is a Special Fund Control Point (2)
+2 NEW CCEDIT,BOCEDIT,ESHEDIT
DO PROMPT
+3 SET (CCEDIT,BOCEDIT,ESHEDIT)=0
+4 if 'Y!($DATA(DIRUT))
QUIT
+5 IF Y
Begin DoDot:1
+6 IF +$PIECE(PCP,"^",2)=2
DO MSG7
QUIT
+7 IF +$PIECE(PCP,"^",2)<2!(+$PIECE(PCP,"^",2)>2)
DO CCEDIT
DO SAEDIT
End DoDot:1
+8 IF (CCEDIT=0)&(BOCEDIT=0)&(ESHEDIT=1)
SET PRCHPO=PRCFA("PODA")
DO MSG1
DO ^PRCHSF
+9 QUIT
+10 ;
CCEDIT ; Cost Center edit
+1 SET CCEDIT=0
SET OLDCC=$PIECE(PO(0),U,5)
+2 WRITE !!
NEW MSG
SET MSG(1)="...now editing the Cost Center..."
SET MSG(2)=""
DO EN^DDIOL(.MSG)
+3 SET DA=PRCFA("PODA")
SET DR="2;"
SET DIE="^PRC(442,"
DO ^DIE
KILL DIE,DR
+4 SET NEWCC=X
IF OLDCC'=NEWCC
SET (FISCEDIT,CCEDIT)=1
SET PO(0)=^PRC(442,DA,0)
+5 QUIT
SAEDIT ; BOC Edit
+1 DO ESHEDIT
+2 SET BOCEDIT=0
+3 WRITE !!
NEW MSG
SET MSG(1)="...now editing the line item BOCs..."
SET MSG(2)=""
DO EN^DDIOL(.MSG)
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to assign the same BOC to ALL items"
SET DIR("B")="NO"
+5 DO ^DIR
KILL DIR
WRITE !!
+6 if Y
GOTO ALLITEMS
+7 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit specific line items"
SET DIR("B")="YES"
+8 DO ^DIR
KILL DIR
+9 if Y
GOTO ONEITEM
+10 IF 'Y!($DATA(DIRUT))
DO MSG6
QUIT
+11 QUIT
ONEITEM ; Edit BOC for one item
+1 SET BOCEDIT=0
+2 SET DIC("A")="Select ITEM: "
SET DA(1)=PRCFA("PODA")
SET DIC="^PRC(442,"_DA(1)_",2,"
SET DIC(0)="AEQMZ"
DO ^DIC
KILL DIC("A")
+3 IF Y<0
if X["^"
SET PRCFOUT=""
SET (PRCHPO,DA)=PRCFA("PODA")
SET (FISCEDIT,BOCEDIT)=1
DO MSG1
DO ^PRCHSF
SET PO(0)=^PRC(442,PRCFA("PODA"),0)
SET %=$SELECT($DATA(PRCFOUT):-1,1:1)
QUIT
+4 SET DA=+Y
SET DIE=DIC
SET DR=3.5
DO ^DIE
SET DIC("A")="Select Next ITEM: "
SET (D0,DA)=PRCFA("PODA")
GOTO ONEITEM
ALLITEMS ; Edit BOCs for all items
+1 SET BOCEDIT=0
+2 SET DIC=420.2
SET DIC(0)="AQEMNZ"
DO ^DIC
IF Y<0
DO MSG6
QUIT
+3 SET SA=+Y
IF $PIECE(PO(0),"^",5)=""
DO MSG2
GOTO OUT3^PRCFFMO1
+4 SET SA=$PIECE(Y(0),U)
IF '$DATA(^PRCD(420.1,$PIECE(PO(0),"^",5),1,+SA))
WRITE $CHAR(7)
DO MSG3
GOTO ALLITEMS
+5 IF 'Y!($DATA(DIRUT))
WRITE !!
DO MSG21
GOTO OUT^PRCFFMO1
+6 DO MSG4
IF 'Y!($DATA(DIRUT))
DO MSG6
QUIT
+7 DO MSG5
SET ITEM=0
FOR
SET ITEM=$ORDER(^PRC(442,PRCFA("PODA"),2,ITEM))
if 'ITEM
QUIT
Begin DoDot:1
+8 SET DA(1)=PRCFA("PODA")
SET DA=ITEM
SET DIE="^PRC(442,"_DA(1)_",2,"
SET DR="3.5///^S X=SA"
DO ^DIE
KILL DIE,DR
End DoDot:1
+9 KILL SA
SET (PRCHPO,DA)=PRCFA("PODA")
SET (FISCEDIT,BOCEDIT)=1
DO MSG1
DO ^PRCHSF
SET PO(0)=^PRC(442,PRCFA("PODA"),0)
+10 QUIT
PROMPT ; Prompt for user
+1 SET DIR(0)="Y"
SET DIR("A")="Should the Cost Center or BOC information be edited at this time"
SET DIR("B")="NO"
+2 SET DIR("?")="Enter 'NO' or 'N' or 'RETURN' if no editing is needed."
+3 SET DIR("?",1)="Enter '^' to exit the option."
+4 SET DIR("?",2)="Enter 'YES' or 'Y' to edit this information."
+5 WRITE !
DO ^DIR
KILL DIR
+6 QUIT
ESHEDIT ; Edit Shipping BOC
+1 SET ESHEDIT=0
+2 DO GENDIQ^PRCFFU7(442,+PO,"13;13.05","IEN","")
+3 IF $GET(PRCTMP(442,+PO,13,"I"))=""
QUIT
+4 IF $GET(PRCTMP(442,+PO,13,"I"))
Begin DoDot:1
+5 KILL MSG
WRITE !!
+6 SET MSG(1)="...now editing Estimated Shipping BOC..."
SET MSG(2)=" "
SET MSG(3)="The BOC for Estimated Shipping is '"_$GET(PRCTMP(442,+PO,13.05,"E"))_"'."
+7 DO EN^DDIOL(.MSG)
KILL MSG
+8 SET DIR(0)="Y"
SET DIR("A")="Should I change the BOC for Estimated Shipping"
SET DIR("B")="YES"
WRITE !
DO ^DIR
KILL DIR
+9 IF 'Y!($DATA(DIRUT))
WRITE !
DO EN^DDIOL("No change made to Shipping BOC.")
QUIT
+10 IF Y
Begin DoDot:2
+11 WRITE !
+12 SET DA=+PO
SET DIE=442
SET DR=13.05
DO ^DIE
KILL DIE,DR
+13 SET (ESHEDIT,FISCEDIT)=1
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 KILL PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05)
+17 QUIT
+18 ; Message processing
MSG1 KILL MSG
WRITE !!
SET MSG="...now recalculating FMS accounting lines..."
DO EN^DDIOL(MSG)
KILL MSG
WRITE !
+1 QUIT
+2 ;
MSG2 KILL MSG
WRITE !!
SET MSG(1)="...Cost Center is missing - cannot continue..."
MSG21 SET MSG(2)=" "
SET MSG(3)="No further action is being taken on this obligation."
+1 DO EN^DDIOL(.MSG)
KILL MSG
WRITE !
+2 QUIT
+3 ;
MSG3 KILL MSG
WRITE !!
SET MSG(1)="BOC '"_SA_"' is not valid with Cost Center "_$PIECE(PO(0),U,5)_"."
SET MSG(2)="Please ensure that this BOC is properly linked with the Cost Center."
+1 DO EN^DDIOL(.MSG)
KILL MSG
WRITE !
+2 QUIT
+3 ;
MSG4 WRITE !!
SET DIR(0)="Y"
SET DIR("A",1)="I will now enter BOC '"_SA_"' on all line items."
SET DIR("A")="Is this OK"
SET DIR("B")="YES"
+1 DO ^DIR
KILL DIR
+2 QUIT
+3 ;
MSG5 KILL MSG
WRITE !!
SET MSG="...now changing the BOCs on all line items..."
+1 DO EN^DDIOL(MSG)
KILL MSG
WRITE !
+2 QUIT
MSG6 IF (CCEDIT=1)!(BOCEDIT=1)!(ESHEDIT=1)
QUIT
+1 KILL MSG
WRITE !!
+2 SET MSG(1)=""
SET MSG(2)=""
+3 if CCEDIT=0
SET MSG(1)="Cost Center has not changed."
SET MSG(3)=" "
+4 if BOCEDIT=0
SET MSG(2)="BOC has not changed."
SET MSG(4)=" "
+5 SET MSG(5)="No further editing is being done on this obligation."
SET MSG(6)=" "
+6 SET MSG(7)="Returning to the Obligation processing."
+7 DO EN^DDIOL(.MSG)
KILL MSG
WRITE !
+8 QUIT
MSG7 ;
+1 KILL MSG
WRITE !!
SET MSG(1)="Cost Center and BOCs cannot be edited for Supply Fund orders."
+2 SET MSG(2)=" "
+3 SET MSG(3)="Returning to the Obligation processing."
+4 DO EN^DDIOL(.MSG)
KILL MSG
+5 QUIT
