source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCESOE2.m@ 1582

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PRCESOE2 ;WISC/SJG-CONTINUATION OF 1358 OBLIGATION ;7/24/00 23:23
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; No Top Level Entry
6 QUIT
7ENO ; Entry point for original entry 1358 documents
8 N DATEZ S DATEZ=PRCFA("OBLDATE")
9 D CURRENT^PRCFFUC
10ENO1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y Q:EXIT Q:EXIT1
11 I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT W ! G ENO1
12 Q
13RETRANO ; Get accounting period/obligation processing date from stack file
14 N RETRAN,ACCPD,OBLDT
15 S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
16 S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
17 I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
18 Q
19ENM ; Entry point for modification entry 1358 documents
20 N DATEZ
21 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=0 D NOW^%DTC S DATEZ=X
22 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 S DATEZ=PRCFA("OBLDATE")
23 D CURRENT^PRCFFUC
24ENM1 S EXIT1=0 D ACCPD^PRCFFUC Q:Y Q:EXIT Q:EXIT1
25 I 'Y D NACCPD^PRCFFUC,CHECK^PRCFFUC Q:EXIT W ! G ENM1
26RETRANM ; Get accounting period/obligation processing date from stack file
27 N RETRAN,ACCPD
28 S RETRAN=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
29 S ACCPD=$P(RETRAN,"/",5),PRCFA("OBLDATE")=$P(RETRAN,"/",6)
30 I PRCFA("OBLDATE")="" D NOW^%DTC S PRCFA("OBLDATE")=X
31 Q
32KILL ; Kill scratch variables
33 K CURDT,DATEZ,DEFDT,EXIT,EXIT1,PARTDT,X,Y,YY
34 Q
Note: See TracBrowser for help on using the repository browser.