PRCFFUC2 ;WISC/SJG-UTILITY ROUTINE FOR HOLD FUNCTIONALITY ;7/24/00 23:13
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Edit checking accounting period, obligation processing date, etc.
CHK1 ; Check for earlier accounting periods
N CUR,NEW
S CUR=$P(PRCFA("CURRENT"),U,3),NEW=$P(PRCFA("ACCPD"),U,3)
Q:CUR=NEW Q:CUR<NEW
I CUR>NEW D M1
Q
CHK2 ; Check for accounting period/obligation processing
N APCK,NEW
S APCK=$P(PRCFA("ACCPDCK"),U,3),NEW=$P(PRCFA("ACCPD"),U,3)
Q:APCK=NEW
I APCK>NEW!(APCK<NEW) D M2
Q
M ; Message Processing
M1 D LN K MSG
S MSG(1)="WARNING: The Accounting Period selected is earlier than the current"
S MSG(2)="the Accounting Period! Sending this document to FMS with this Accounting"
S MSG(3)="Period may cause the document to reject with a Closed Accounting Period error!"
D EN^DDIOL(.MSG) K MSG D LN
Q
M2 ;
N YY S YY=$$DATE^PRC0C(PRCFA("OBLDATE"),"I"),YY=$$TRANS^PRCFFUC(YY)
W ! K MSG D LN
S MSG(1)="WARNING: There may be an Obligation Processing Date/Accounting Period"
S MSG(2)="mismatch! The Obligation Processing Date ("_YY_") does not fall into"
S MSG(3)="the selected Accounting Period ("_$P(PRCFA("ACCPD"),U)_") for "_$P(PRCFA("ACCPD"),U,2)_"."
S MSG(4)=" "
S:APCK>NEW MM="precedes" S:APCK<NEW MM="follows"
S MSG(5)="The Accounting Period "_MM_" the Obligation Processing Date."
S MSG(6)=" ",MSG(7)="Please be sure that the appropriate Accounting Period has been"
S MSG(8)="chosen for this transaction before proceeding with this obligation."
D EN^DDIOL(.MSG) K MSG D LN
D TABLE I Y D H2^PRCFFUC1 W !
Q
TABLE ; Set up call to display help table
N DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="the calendar month and its fiscal month"
S DIR("A",1)="Do you wish to display a table showing the relationship between"
W ! D ^DIR K DIR
Q
LN ; Write out a line of asterisks
W ! S $P(LN,"*",80)="" W LN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFUC2 1970 printed Nov 22, 2024@17:14:08 Page 2
PRCFFUC2 ;WISC/SJG-UTILITY ROUTINE FOR HOLD FUNCTIONALITY ;7/24/00 23:13
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ; Edit checking accounting period, obligation processing date, etc.
CHK1 ; Check for earlier accounting periods
+1 NEW CUR,NEW
+2 SET CUR=$PIECE(PRCFA("CURRENT"),U,3)
SET NEW=$PIECE(PRCFA("ACCPD"),U,3)
+3 if CUR=NEW
QUIT
if CUR<NEW
QUIT
+4 IF CUR>NEW
DO M1
+5 QUIT
CHK2 ; Check for accounting period/obligation processing
+1 NEW APCK,NEW
+2 SET APCK=$PIECE(PRCFA("ACCPDCK"),U,3)
SET NEW=$PIECE(PRCFA("ACCPD"),U,3)
+3 if APCK=NEW
QUIT
+4 IF APCK>NEW!(APCK<NEW)
DO M2
+5 QUIT
M ; Message Processing
M1 DO LN
KILL MSG
+1 SET MSG(1)="WARNING: The Accounting Period selected is earlier than the current"
+2 SET MSG(2)="the Accounting Period! Sending this document to FMS with this Accounting"
+3 SET MSG(3)="Period may cause the document to reject with a Closed Accounting Period error!"
+4 DO EN^DDIOL(.MSG)
KILL MSG
DO LN
+5 QUIT
M2 ;
+1 NEW YY
SET YY=$$DATE^PRC0C(PRCFA("OBLDATE"),"I")
SET YY=$$TRANS^PRCFFUC(YY)
+2 WRITE !
KILL MSG
DO LN
+3 SET MSG(1)="WARNING: There may be an Obligation Processing Date/Accounting Period"
+4 SET MSG(2)="mismatch! The Obligation Processing Date ("_YY_") does not fall into"
+5 SET MSG(3)="the selected Accounting Period ("_$PIECE(PRCFA("ACCPD"),U)_") for "_$PIECE(PRCFA("ACCPD"),U,2)_"."
+6 SET MSG(4)=" "
+7 if APCK>NEW
SET MM="precedes"
if APCK<NEW
SET MM="follows"
+8 SET MSG(5)="The Accounting Period "_MM_" the Obligation Processing Date."
+9 SET MSG(6)=" "
SET MSG(7)="Please be sure that the appropriate Accounting Period has been"
+10 SET MSG(8)="chosen for this transaction before proceeding with this obligation."
+11 DO EN^DDIOL(.MSG)
KILL MSG
DO LN
+12 DO TABLE
IF Y
DO H2^PRCFFUC1
WRITE !
+13 QUIT
TABLE ; Set up call to display help table
+1 NEW DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+2 SET DIR("A")="the calendar month and its fiscal month"
+3 SET DIR("A",1)="Do you wish to display a table showing the relationship between"
+4 WRITE !
DO ^DIR
KILL DIR
+5 QUIT
LN ; Write out a line of asterisks
+1 WRITE !
SET $PIECE(LN,"*",80)=""
WRITE LN
QUIT
