source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU12.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1PRCFFU12 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS CONT ;6/13/94 14:34
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ; Allows Fiscal to edit Cost Center and BOCs prior to PO obligation
5PO ; PO Correction
6 ; Fiscal cannot edit if FCP is a Special Fund Control Point (2)
7 N CCEDIT,BOCEDIT,ESHEDIT D PROMPT
8 S (CCEDIT,BOCEDIT,ESHEDIT)=0
9 Q:'Y!($D(DIRUT))
10 I Y D
11 .I +$P(PCP,"^",2)=2 D MSG7 Q
12 .I +$P(PCP,"^",2)<2!(+$P(PCP,"^",2)>2) D CCEDIT,SAEDIT
13 I (CCEDIT=0)&(BOCEDIT=0)&(ESHEDIT=1) S PRCHPO=PRCFA("PODA") D MSG1,^PRCHSF
14 QUIT
15 ;
16CCEDIT ; Cost Center edit
17 S CCEDIT=0,OLDCC=$P(PO(0),U,5)
18 W !! N MSG S MSG(1)="...now editing the Cost Center...",MSG(2)="" D EN^DDIOL(.MSG)
19 S DA=PRCFA("PODA"),DR="2;",DIE="^PRC(442," D ^DIE K DIE,DR
20 S NEWCC=X I OLDCC'=NEWCC S (FISCEDIT,CCEDIT)=1,PO(0)=^PRC(442,DA,0)
21 Q
22SAEDIT ; BOC Edit
23 D ESHEDIT
24 S BOCEDIT=0
25 W !! N MSG S MSG(1)="...now editing the line item BOCs...",MSG(2)="" D EN^DDIOL(.MSG)
26 K DIR S DIR(0)="Y",DIR("A")="Do you wish to assign the same BOC to ALL items",DIR("B")="NO"
27 D ^DIR K DIR W !!
28 G:Y ALLITEMS
29 K DIR S DIR(0)="Y",DIR("A")="Do you wish to edit specific line items",DIR("B")="YES"
30 D ^DIR K DIR
31 G:Y ONEITEM
32 I 'Y!($D(DIRUT)) D MSG6 Q
33 Q
34ONEITEM ; Edit BOC for one item
35 S BOCEDIT=0
36 S DIC("A")="Select ITEM: ",DA(1)=PRCFA("PODA"),DIC="^PRC(442,"_DA(1)_",2,",DIC(0)="AEQMZ" D ^DIC K DIC("A")
37 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
38 S DA=+Y,DIE=DIC,DR=3.5 D ^DIE S DIC("A")="Select Next ITEM: ",(D0,DA)=PRCFA("PODA") G ONEITEM
39ALLITEMS ; Edit BOCs for all items
40 S BOCEDIT=0
41 S DIC=420.2,DIC(0)="AQEMNZ" D ^DIC I Y<0 D MSG6 Q
42 S SA=+Y I $P(PO(0),"^",5)="" D MSG2 G OUT3^PRCFFMO1
43 S SA=$P(Y(0),U) I '$D(^PRCD(420.1,$P(PO(0),"^",5),1,+SA)) W $C(7) D MSG3 G ALLITEMS
44 I 'Y!($D(DIRUT)) W !! D MSG21 G OUT^PRCFFMO1
45 D MSG4 I 'Y!($D(DIRUT)) D MSG6 Q
46 D MSG5 S ITEM=0 F S ITEM=$O(^PRC(442,PRCFA("PODA"),2,ITEM)) Q:'ITEM D
47 .S DA(1)=PRCFA("PODA"),DA=ITEM,DIE="^PRC(442,"_DA(1)_",2,",DR="3.5///^S X=SA" D ^DIE K DIE,DR
48 K SA S (PRCHPO,DA)=PRCFA("PODA"),(FISCEDIT,BOCEDIT)=1 D MSG1,^PRCHSF S PO(0)=^PRC(442,PRCFA("PODA"),0)
49 Q
50PROMPT ; Prompt for user
51 S DIR(0)="Y",DIR("A")="Should the Cost Center or BOC information be edited at this time",DIR("B")="NO"
52 S DIR("?")="Enter 'NO' or 'N' or 'RETURN' if no editing is needed."
53 S DIR("?",1)="Enter '^' to exit the option."
54 S DIR("?",2)="Enter 'YES' or 'Y' to edit this information."
55 W ! D ^DIR K DIR
56 Q
57ESHEDIT ; Edit Shipping BOC
58 S ESHEDIT=0
59 D GENDIQ^PRCFFU7(442,+PO,"13;13.05","IEN","")
60 I $G(PRCTMP(442,+PO,13,"I"))="" Q
61 I $G(PRCTMP(442,+PO,13,"I")) D
62 .K MSG W !!
63 .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"))_"'."
64 .D EN^DDIOL(.MSG) K MSG
65 .S DIR(0)="Y",DIR("A")="Should I change the BOC for Estimated Shipping",DIR("B")="YES" W ! D ^DIR K DIR
66 .I 'Y!($D(DIRUT)) W ! D EN^DDIOL("No change made to Shipping BOC.") Q
67 .I Y D
68 ..W !
69 ..S DA=+PO,DIE=442,DR=13.05 D ^DIE K DIE,DR
70 ..S (ESHEDIT,FISCEDIT)=1
71 ..Q
72 .Q
73 K PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05)
74 Q
75 ; Message processing
76MSG1 K MSG W !! S MSG="...now recalculating FMS accounting lines..." D EN^DDIOL(MSG) K MSG W !
77 Q
78 ;
79MSG2 K MSG W !! S MSG(1)="...Cost Center is missing - cannot continue..."
80MSG21 S MSG(2)=" ",MSG(3)="No further action is being taken on this obligation."
81 D EN^DDIOL(.MSG) K MSG W !
82 Q
83 ;
84MSG3 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."
85 D EN^DDIOL(.MSG) K MSG W !
86 Q
87 ;
88MSG4 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"
89 D ^DIR K DIR
90 Q
91 ;
92MSG5 K MSG W !! S MSG="...now changing the BOCs on all line items..."
93 D EN^DDIOL(MSG) K MSG W !
94 Q
95MSG6 I (CCEDIT=1)!(BOCEDIT=1)!(ESHEDIT=1) Q
96 K MSG W !!
97 S MSG(1)="",MSG(2)=""
98 S:CCEDIT=0 MSG(1)="Cost Center has not changed.",MSG(3)=" "
99 S:BOCEDIT=0 MSG(2)="BOC has not changed.",MSG(4)=" "
100 S MSG(5)="No further editing is being done on this obligation.",MSG(6)=" "
101 S MSG(7)="Returning to the Obligation processing."
102 D EN^DDIOL(.MSG) K MSG W !
103 Q
104MSG7 ;
105 K MSG W !! S MSG(1)="Cost Center and BOCs cannot be edited for Supply Fund orders."
106 S MSG(2)=" "
107 S MSG(3)="Returning to the Obligation processing."
108 D EN^DDIOL(.MSG) K MSG
109 Q
Note: See TracBrowser for help on using the repository browser.