| 1 | PRCFFUD1 ;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 | ;
|
|---|
| 9 | EN() ;
|
|---|
| 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)
|
|---|
| 15 | REQ ; 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
|
|---|
| 21 | NOREQ ; 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
|
|---|
| 26 | QUIT 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
|
|---|
| 30 | DT442(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
|
|---|
| 45 | DTOBL(A,B) ;ef = default obligation date
|
|---|
| 46 | QUIT $S(A<DT:DT,1:B)
|
|---|
| 47 | ;
|
|---|
| 48 | OBLDAT(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
|
|---|
