source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFUD1.m@ 1796

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PRCFFUD1 ;WISC/SJG-UTILITY FOR CARRY FORWARD ;3/27/96 15:14
2 ;;5.1;IFCAP;**58**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 QUIT
6 ; This utility will determine the date that is to be used for the
7 ; obligation processing date for Supply Fund transactions
8 ;
9EN() ;
10 N OPENQTR,PRIMARY,PODATE
11 S RETDATE=""
12 S OPENQTR=$$NP^PRC0B("^PRC(420,"_+PRC("SITE")_",",0,9)
13 S PRIMARY=$$NP^PRC0B("^PRC(442,"_+PO_",",0,12)
14 S PODATE=$$NP^PRC0B("^PRC(442,"_+PO_",",1,15)
15REQ ; 2237 Request on Purchase Order
16 I $G(PRIMARY)]"" D G QUIT
17 .S RETDATE=$G(OPENQTR)
18 .I $G(PODATE)>$G(OPENQTR) S RETDATE=PODATE
19 .I $G(PODATE)<$G(OPENQTR) D NOW^%DTC S RETDATE=X
20 .Q
21NOREQ ; No 2237 Request on Purchase Order
22 I $G(PRIMARY)="" D G QUIT
23 .I $G(PODATE)<$G(OPENQTR) D NOW^%DTC S RETDATE=X Q
24 .S RETDATE=PODATE
25 .Q
26QUIT I RETDATE="" D NOW^%DTC S RETDATE=X
27 QUIT RETDATE
28 ;
29 ;A = RI OF 442 or 443.6, B = node 0 of file 442 or 443.6, C=file # 442 or 443.6,D=amend ri
30DT442(A,B,C,D) ; set up prcfa(bbfy),prc(site),prc(fy),prc(qtr),prc(cp),prcfa(request),prc(rbdt),prc(bbfy),prc(podt),prc(amendt)
31 N PRCA,Z
32 S PRCA=$S($G(C)="":442,1:$G(C))
33 I $G(D) S PRC("AMENDT")=$P($G(^PRC(PRCA,A,6,D,0)),U,2)
34 S:$G(B)="" B=^PRC(PRCA,A,0)
35 S PRCFA("REQUEST")=$P(B,U,12),PRC("RBDT")=""
36 I PRCA=442 D GENDIQ^PRCFFU7(442,A,".1;.07;.03;17","IEN","")
37 I PRCFA("REQUEST") S Z=$G(^PRCS(410,PRCFA("REQUEST"),0)),PRC("RBDT")=$P(Z,U,11),PRCFA("BBFY")=$P(^(3),U,11),PRC("SITE")=$P(Z,"-"),PRC("FY")=$P(Z,"-",2),PRC("QTR")=$P(Z,"-",3),PRC("CP")=$P(Z,"-",4) I 1
38 S Z=$G(^PRC(PRCA,A,1)),PRC("PODT")=$P(Z,U,15) E S PRCFA("BBFY")=$P(^(23),U,2),PRC("SITE")=$P(B,"-"),PRC("CP")=$P(B,U,3),Z=$$DATE^PRC0C($P(Z,U,15),"I"),PRC("FY")=$E(Z,3,4),PRC("QTR")=$P(Z,U,2)
39 S PRCFA("BBFY")=+$$DATE^PRC0C(PRCFA("BBFY"),"I"),PRC("BBFY")=PRCFA("BBFY")
40 S PRC("FYQDT")=$P($$QTRDATE^PRC0D(PRC("FY"),PRC("QTR")),"^",7)
41 I 'PRC("RBDT") S PRC("RBDT")=$$RBDT^PRC0G(PRC("SITE")_U_PRC("FY")_U_PRC("QTR")_U_+PRC("CP")_U_PRCFA("BBFY"))
42 QUIT
43 ;
44 ;a = running balance date (fileman), b = p.o date or amend date
45DTOBL(A,B) ;ef = default obligation date
46 QUIT $S(A<DT:DT,1:B)
47 ;
48OBLDAT(A,B) ; a new subroutine added as part of PRC*5.1*58.
49 ; This new subroutine will enable the software to look for
50 ; amendment funds in the correct fiscal quarter. The NOIS
51 ; addressed by this code is LAH-0602-61845.
52 ;
53 S RBDT=A,AMENDT=B
54 I AMENDT]"",PRC("FY")=$E(DT,2,3) S OBLDAT=AMENDT
55 E S OBLDAT=RBDT
56 K RBDT,AMENDT
57 Q OBLDAT
Note: See TracBrowser for help on using the repository browser.