source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFUA.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1PRCFFUA ;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 BOCs prior to PO amendment obligation
5 ; only the BOCs on the amendment can be edited
6 ;
7OK ; Prompt user
8 S DIR(0)="Y"
9 S DIR("A")="Is the above BOC information correct",DIR("B")="YES"
10 S DIR("?")="Enter 'NO' or 'N' to edit the BOCs on amended items."
11 S DIR("?",1)="Enter '^' to exit this option."
12 S DIR("?",2)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this amendment."
13 W ! D ^DIR K DIR
14 Q
15POAM ;
16 D ARRAY^PRCFFUA4 I $D(ITRAY("NOITEMS")) D MSG9^PRCFFUA3 Q
17 I FATAL=1 D MSG9^PRCFFUA3 Q
18 N BOCEDIT,ESHEDIT
19 D PROMPT Q:'Y!($D(DIRUT))
20 K YY S YY=Y,YY(0)=Y(0)
21 S (BOCEDIT,ESHEDIT)=0,FILE=$$FILE() D ROLLSET
22 S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO) S Y=YY,Y(0)=YY(0) K YY
23 Q:'Y!($D(DIRUT))
24 I Y D
25 .I $P(PCP,"^",2)=2 D MSG7^PRCFFUA3 Q
26 .D:+$P(PCP,"^",2)<2 SAEDIT
27 I (BOCEDIT=0)&(ESHEDIT=1) D ROLLSET,MSG1^PRCFFUA3,SF1^PRCFFUA1
28 QUIT
29ROLLSET ; Sets variable needed for amendment rollup
30 S (DA,PRCHPO)=PRCFA("PODA"),PRCHTOTQ=$P(PO(0),U,15),PRCHAM=PRCFAA
31 Q
32 ;
33SAEDIT ; BOC Edit
34 D ESHEDIT S BOCEDIT=0
35 W !! N MSG S MSG="...now editing the BOCs on the amendment..." D EN^DDIOL(MSG) W !
36 I '$D(ITRAY("NOITEMS")) D ONEITEM
37 I 'Y!($D(DIRUT)) D MSG6^PRCFFUA3 Q
38 Q
39ONEITEM ; Edit BOC for one item
40 Q:$D(ITRAY("NOITEMS"))
41 S BOCEDIT=0
42 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
43 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
44 I Y>0,'$D(ITRAY(+Y)) W ! D EN^DDIOL("The Item Number selected by you is not on this amendment!") W ! G ONEITEM
45 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
46 S DA=+Y,DIE=DIC,DR=3.5,PRCHAMDA=23 D ^DIE S Y=YY,(BOCEDIT,FISCEDIT)=1
47 I Y>0,$D(ITRAY(+Y)) D ROLLSET,MSG1^PRCFFUA3 D:FILE=442 SF1^PRCFFUA1 D:FILE=443.6 ^PRCHSF3
48 S DIC("A")="Select Next ITEM: ",(D0,DA)=PRCFA("PODA") G ONEITEM
49 ;
50PROMPT ; Prompt for user
51 S DIR(0)="Y",DIR("A")="Should the amendment 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 ; 13 - Estimated Shipping and/or Handling
59 ; 13.05 - Estimated Shipping BOC
60 S ESHEDIT=0 Q:'$D(ITRAY("ESH"))
61 I $G(PRCTMP(FILE,+PO,13,"I"))="" Q
62 I FILE=442,$G(PRCTMP(442,+PO,13.05,"I"))]"" D MSG10^PRCFFUA3,ESH1
63 I FILE=443.6,$G(PRCTMP(443.6,+PO,13.05,"I"))]"" D ESH1
64 K PRCTMP(442,+PO,13),PRCTMP(442,+PO,13.05),PRCTMP(443,6,+PO,13),PRCTMP(443.6,+PO,13.05)
65 Q
66ESH1 K MSG W !!
67 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"))_"'."
68 D EN^DDIOL(.MSG) K MSG
69 S DIR(0)="Y",DIR("A")="Should I change the BOC for Estimated Shipping",DIR("B")="YES" W ! D ^DIR K DIR
70 I 'Y!($D(DIRUT)) W ! D EN^DDIOL("No change made to Shipping BOC.") Q
71 I Y D
72 .W !
73 .S DA=+PO,DIE=FILE,DR=13.05 D ^DIE K DIE,DR
74 .S (ESHEDIT,FISCEDIT)=1
75 .Q
76 Q
77FILE() ; Determine file for lookup/editing
78 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 S FILE=443.6
79 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S FILE=442
80 Q FILE
81KILL K AESHBOC,FILE,II,ITRAY,OESHBOC,POX
82 Q
Note: See TracBrowser for help on using the repository browser.