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 ---[H[J[2J[HPRCFFUA 3607 printed Nov 22, 2024@17:14:01 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
