PRCFFUA.m

PRCFFUA ;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 BOCs prior to PO amendment obligation

 ; only the BOCs on the amendment can be edited

 ;

OK ; Prompt user

 S DIR(0)="Y"

 S DIR("A")="Is the above BOC information correct",DIR("B")="YES"

 S DIR("?")="Enter 'NO' or 'N' to edit the BOCs on amended items."

 S DIR("?",1)="Enter '^' to exit this option."

 S DIR("?",2)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this amendment."

 W ! D ^DIR K DIR

 Q

POAM ;

 D ARRAY^PRCFFUA4 I $D(ITRAY("NOITEMS")) D MSG9^PRCFFUA3 Q

 I FATAL=1 D MSG9^PRCFFUA3 Q

 N BOCEDIT,ESHEDIT

 D PROMPT Q:'Y!($D(DIRUT))

 K YY S YY=Y,YY(0)=Y(0)

 S (BOCEDIT,ESHEDIT)=0,FILE=$$FILE() D ROLLSET

 S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO) S Y=YY,Y(0)=YY(0) K YY

 Q:'Y!($D(DIRUT))

 I Y D

 .I $P(PCP,"^",2)=2 D MSG7^PRCFFUA3 Q

 .D:+$P(PCP,"^",2)<2 SAEDIT

 I (BOCEDIT=0)&(ESHEDIT=1) D ROLLSET,MSG1^PRCFFUA3,SF1^PRCFFUA1

 QUIT

ROLLSET ; Sets variable needed for amendment rollup

 S (DA,PRCHPO)=PRCFA("PODA"),PRCHTOTQ=$P(PO(0),U,15),PRCHAM=PRCFAA

 Q

 ;

SAEDIT ; BOC Edit

 D ESHEDIT S BOCEDIT=0

 W !! N MSG S MSG="...now editing the BOCs on the amendment..." D EN^DDIOL(MSG) W !

 I '$D(ITRAY("NOITEMS")) D ONEITEM

 I 'Y!($D(DIRUT)) D MSG6^PRCFFUA3 Q

 Q

ONEITEM ; Edit BOC for one item

 Q:$D(ITRAY("NOITEMS"))

 S BOCEDIT=0

 S DIC("A")="Select ITEM: ",DA(1)=PRCFA("PODA"),DIC="^PRC("_FILE_","_DA(1)_",2,",DIC(0)="AEQMZ" D ^DIC K DIC("A") S YY=Y

 I Y>0,$D(ITRAY("CANCEL",+Y)) W ! D EN^DDIOL("The Item Number selected by you has been cancelled and cannot be changed in the amendment!") W ! G ONEITEM

 I Y>0,'$D(ITRAY(+Y)) W ! D EN^DDIOL("The Item Number selected by you is not on this amendment!") W ! G ONEITEM

 I Y<0 S:X["^" PRCFOUT="" D ROLLSET S POX="^PRC("_FILE_","_PRCFA("PODA")_",0)" S PO(0)=@POX S %=$S($D(PRCFOUT):-1,1:1) Q

 S DA=+Y,DIE=DIC,DR=3.5,PRCHAMDA=23 D ^DIE S Y=YY,(BOCEDIT,FISCEDIT)=1

 I Y>0,$D(ITRAY(+Y))  D ROLLSET,MSG1^PRCFFUA3 D:FILE=442 SF1^PRCFFUA1 D:FILE=443.6 ^PRCHSF3

 S DIC("A")="Select Next ITEM: ",(D0,DA)=PRCFA("PODA") G ONEITEM

 ;

PROMPT ; Prompt for user

 S DIR(0)="Y",DIR("A")="Should the amendment 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

 ; 13    - Estimated Shipping and/or Handling

 ; 13.05 - Estimated Shipping BOC

 S ESHEDIT=0 Q:'$D(ITRAY("ESH"))

 I $G(PRCTMP(FILE,+PO,13,"I"))="" Q

 I FILE=442,$G(PRCTMP(442,+PO,13.05,"I"))]"" D MSG10^PRCFFUA3,ESH1

 I FILE=443.6,$G(PRCTMP(443.6,+PO,13.05,"I"))]"" D ESH1

 K PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05),PRCTMP(443,6,+PO,13),PRCTMP(443.6,+PO,13.05)

 Q

ESH1 K MSG W !!

 S MSG(1)="...now editing Estimated Shipping BOC...",MSG(2)=" ",MSG(3)="The BOC for Estimated Shipping is '"_$G(PRCTMP(FILE,+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=FILE,DR=13.05 D ^DIE K DIE,DR

 .S (ESHEDIT,FISCEDIT)=1

 .Q

 Q

FILE() ; Determine file for lookup/editing

 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 S FILE=443.6

 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S FILE=442

 Q FILE

KILL K AESHBOC,FILE,II,ITRAY,OESHBOC,POX

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFFUA   3607     printed  Mar 13, 2025@21:08:43                                                                                                                                                                                                     Page 2

PRCFFUA   ;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 BOCs prior to PO amendment obligation

 +3       ; only the BOCs on the amendment can be edited

 +4       ;

OK        ; Prompt user

 +1        SET DIR(0)="Y"

 +2        SET DIR("A")="Is the above BOC information correct"

           SET DIR("B")="YES"

 +3        SET DIR("?")="Enter 'NO' or 'N' to edit the BOCs on amended items."

 +4        SET DIR("?",1)="Enter '^' to exit this option."

 +5        SET DIR("?",2)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this amendment."

 +6        WRITE !

           DO ^DIR

           KILL DIR

 +7        QUIT 

POAM      ;

 +1        DO ARRAY^PRCFFUA4

           IF $DATA(ITRAY("NOITEMS"))

               DO MSG9^PRCFFUA3

               QUIT 

 +2        IF FATAL=1

               DO MSG9^PRCFFUA3

               QUIT 

 +3        NEW BOCEDIT,ESHEDIT

 +4        DO PROMPT

           if 'Y!($DATA(DIRUT))

               QUIT 

 +5        KILL YY

           SET YY=Y

           SET YY(0)=Y(0)

 +6        SET (BOCEDIT,ESHEDIT)=0

           SET FILE=$$FILE()

           DO ROLLSET

 +7        SET PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO)

           SET Y=YY

           SET Y(0)=YY(0)

           KILL YY

 +8        if 'Y!($DATA(DIRUT))

               QUIT 

 +9        IF Y

               Begin DoDot:1

 +10               IF $PIECE(PCP,"^",2)=2

                       DO MSG7^PRCFFUA3

                       QUIT 

 +11               if +$PIECE(PCP,"^",2)<2

                       DO SAEDIT

               End DoDot:1

 +12       IF (BOCEDIT=0)&(ESHEDIT=1)

               DO ROLLSET

               DO MSG1^PRCFFUA3

               DO SF1^PRCFFUA1

 +13       QUIT 

ROLLSET   ; Sets variable needed for amendment rollup

 +1        SET (DA,PRCHPO)=PRCFA("PODA")

           SET PRCHTOTQ=$PIECE(PO(0),U,15)

           SET PRCHAM=PRCFAA

 +2        QUIT 

 +3       ;

SAEDIT    ; BOC Edit

 +1        DO ESHEDIT

           SET BOCEDIT=0

 +2        WRITE !!

           NEW MSG

           SET MSG="...now editing the BOCs on the amendment..."

           DO EN^DDIOL(MSG)

           WRITE !

 +3        IF '$DATA(ITRAY("NOITEMS"))

               DO ONEITEM

 +4        IF 'Y!($DATA(DIRUT))

               DO MSG6^PRCFFUA3

               QUIT 

 +5        QUIT 

ONEITEM   ; Edit BOC for one item

 +1        if $DATA(ITRAY("NOITEMS"))

               QUIT 

 +2        SET BOCEDIT=0

 +3        SET DIC("A")="Select ITEM: "

           SET DA(1)=PRCFA("PODA")

           SET DIC="^PRC("_FILE_","_DA(1)_",2,"

           SET DIC(0)="AEQMZ"

           DO ^DIC

           KILL DIC("A")

           SET YY=Y

 +4        IF Y>0

               IF $DATA(ITRAY("CANCEL",+Y))

                   WRITE !

                   DO EN^DDIOL("The Item Number selected by you has been cancelled and cannot be changed in the amendment!")

                   WRITE !

                   GOTO ONEITEM

 +5        IF Y>0

               IF '$DATA(ITRAY(+Y))

                   WRITE !

                   DO EN^DDIOL("The Item Number selected by you is not on this amendment!")

                   WRITE !

                   GOTO ONEITEM

 +6        IF Y<0

               if X["^"

                   SET PRCFOUT=""

               DO ROLLSET

               SET POX="^PRC("_FILE_","_PRCFA("PODA")_",0)"

               SET PO(0)=@POX

               SET %=$SELECT($DATA(PRCFOUT):-1,1:1)

               QUIT 

 +7        SET DA=+Y

           SET DIE=DIC

           SET DR=3.5

           SET PRCHAMDA=23

           DO ^DIE

           SET Y=YY

           SET (BOCEDIT,FISCEDIT)=1

 +8        IF Y>0

               IF $DATA(ITRAY(+Y))

                   DO ROLLSET

                   DO MSG1^PRCFFUA3

                   if FILE=442

                       DO SF1^PRCFFUA1

                   if FILE=443.6

                       DO ^PRCHSF3

 +9        SET DIC("A")="Select Next ITEM: "

           SET (D0,DA)=PRCFA("PODA")

           GOTO ONEITEM

 +10      ;

PROMPT    ; Prompt for user

 +1        SET DIR(0)="Y"

           SET DIR("A")="Should the amendment 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       ; 13    - Estimated Shipping and/or Handling

 +2       ; 13.05 - Estimated Shipping BOC

 +3        SET ESHEDIT=0

           if '$DATA(ITRAY("ESH"))

               QUIT 

 +4        IF $GET(PRCTMP(FILE,+PO,13,"I"))=""

               QUIT 

 +5        IF FILE=442

               IF $GET(PRCTMP(442,+PO,13.05,"I"))]""

                   DO MSG10^PRCFFUA3

                   DO ESH1

 +6        IF FILE=443.6

               IF $GET(PRCTMP(443.6,+PO,13.05,"I"))]""

                   DO ESH1

 +7        KILL PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05),PRCTMP(443,6,+PO,13),PRCTMP(443.6,+PO,13.05)

 +8        QUIT 

ESH1       KILL MSG

           WRITE !!

 +1        SET MSG(1)="...now editing Estimated Shipping BOC..."

           SET MSG(2)=" "

           SET MSG(3)="The BOC for Estimated Shipping is '"_$GET(PRCTMP(FILE,+PO,13.05,"E"))_"'."

 +2        DO EN^DDIOL(.MSG)

           KILL MSG

 +3        SET DIR(0)="Y"

           SET DIR("A")="Should I change the BOC for Estimated Shipping"

           SET DIR("B")="YES"

           WRITE !

           DO ^DIR

           KILL DIR

 +4        IF 'Y!($DATA(DIRUT))

               WRITE !

               DO EN^DDIOL("No change made to Shipping BOC.")

               QUIT 

 +5        IF Y

               Begin DoDot:1

 +6                WRITE !

 +7                SET DA=+PO

                   SET DIE=FILE

                   SET DR=13.05

                   DO ^DIE

                   KILL DIE,DR

 +8                SET (ESHEDIT,FISCEDIT)=1

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

FILE()    ; Determine file for lookup/editing

 +1        IF $DATA(PRCFA("RETRAN"))

               IF PRCFA("RETRAN")=0

                   SET FILE=443.6

 +2        IF $DATA(PRCFA("RETRAN"))

               IF PRCFA("RETRAN")=1

                   SET FILE=442

 +3        QUIT FILE

KILL       KILL AESHBOC,FILE,II,ITRAY,OESHBOC,POX

 +1        QUIT