source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFUC2.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: 1.9 KB
RevLine 
[613]1PRCFFUC2 ;WISC/SJG-UTILITY ROUTINE FOR HOLD FUNCTIONALITY ;7/24/00 23:13
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Edit checking accounting period, obligation processing date, etc.
6CHK1 ; Check for earlier accounting periods
7 N CUR,NEW
8 S CUR=$P(PRCFA("CURRENT"),U,3),NEW=$P(PRCFA("ACCPD"),U,3)
9 Q:CUR=NEW Q:CUR<NEW
10 I CUR>NEW D M1
11 Q
12CHK2 ; Check for accounting period/obligation processing
13 N APCK,NEW
14 S APCK=$P(PRCFA("ACCPDCK"),U,3),NEW=$P(PRCFA("ACCPD"),U,3)
15 Q:APCK=NEW
16 I APCK>NEW!(APCK<NEW) D M2
17 Q
18M ; Message Processing
19M1 D LN K MSG
20 S MSG(1)="WARNING: The Accounting Period selected is earlier than the current"
21 S MSG(2)="the Accounting Period! Sending this document to FMS with this Accounting"
22 S MSG(3)="Period may cause the document to reject with a Closed Accounting Period error!"
23 D EN^DDIOL(.MSG) K MSG D LN
24 Q
25M2 ;
26 N YY S YY=$$DATE^PRC0C(PRCFA("OBLDATE"),"I"),YY=$$TRANS^PRCFFUC(YY)
27 W ! K MSG D LN
28 S MSG(1)="WARNING: There may be an Obligation Processing Date/Accounting Period"
29 S MSG(2)="mismatch! The Obligation Processing Date ("_YY_") does not fall into"
30 S MSG(3)="the selected Accounting Period ("_$P(PRCFA("ACCPD"),U)_") for "_$P(PRCFA("ACCPD"),U,2)_"."
31 S MSG(4)=" "
32 S:APCK>NEW MM="precedes" S:APCK<NEW MM="follows"
33 S MSG(5)="The Accounting Period "_MM_" the Obligation Processing Date."
34 S MSG(6)=" ",MSG(7)="Please be sure that the appropriate Accounting Period has been"
35 S MSG(8)="chosen for this transaction before proceeding with this obligation."
36 D EN^DDIOL(.MSG) K MSG D LN
37 D TABLE I Y D H2^PRCFFUC1 W !
38 Q
39TABLE ; Set up call to display help table
40 N DIR S DIR(0)="Y",DIR("B")="NO"
41 S DIR("A")="the calendar month and its fiscal month"
42 S DIR("A",1)="Do you wish to display a table showing the relationship between"
43 W ! D ^DIR K DIR
44 Q
45LN ; Write out a line of asterisks
46 W ! S $P(LN,"*",80)="" W LN Q
Note: See TracBrowser for help on using the repository browser.