PRCFFU12.m

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 ---PRCFFU12   4631     printed  Mar 13, 2025@21:08:24                                                                                                                                                                                                    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