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