66 lines
2.2 KiB
Mathematica
66 lines
2.2 KiB
Mathematica
PRCFFU19 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;1/12/95 5:33 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
QUIT
|
|
; .1 - P.O. Date
|
|
; .07 - Primary 2237
|
|
; .03 - Special FCP
|
|
; 17 - Validation Date for PA Esig
|
|
; PRCFA("BBFY") - BBFY as stored in file 442,field 26
|
|
; PRC("BBFY") - BBFY based on station #, doc FY, FCP
|
|
;
|
|
BBFYCHK(PO) ; Check BBFY at Obligation
|
|
N BBFY,BBFYCHK,FY2,FY4,FYI,N0,N1,PODT,PRIMREQ,REV,SFCP
|
|
I '$D(PRCFA("OBLDATE")) D NOW^%DTC S PRCFA("OBLDATE")=X K X
|
|
D GENDIQ^PRCFFU7(442,PO,".1;.07;.03;17","IEN","")
|
|
S N0=$$NODE^PRC0B("^PRC(442,"_PO_",",0)
|
|
S N1=$$NODE^PRC0B("^PRC(442,"_PO_",",1)
|
|
S PODT=$G(PRCTMP(442,PO,.1,"I"))
|
|
I PODT="" D DATE S PODT=$P(N1,U,15)
|
|
S PRIMREQ=$G(PRCTMP(442,PO,.07,"I"))
|
|
I PRIMREQ>0 D G T1
|
|
.S FYI=$$NP^PRC0B("^PRCS(410,"_PRIMREQ_",",3,11)
|
|
.I FYI]"" S (FY4,PRC("BBFY"))=$P($$DATE^PRC0C(FYI,"I"),U) Q
|
|
.I FYI="" D Q
|
|
..N TXN
|
|
..S TXN=$$NP^PRC0B("^PRCS(410,"_PRIMREQ_",",0,1)
|
|
..S FY2=$P(TXN,"-",2),(FY4,PRC("BBFY"))=$P($$YEAR^PRC0C(FY2),U)
|
|
..Q
|
|
S FY2=$E(PRCFA("OBLDATE"),2,3)+$E(PRCFA("OBLDATE"),4)
|
|
D GETBBFY S (FY4,PRC("BBFY"))=BBFY
|
|
T1 I PRC("BBFY")'=PRCFA("BBFY") D Q
|
|
.S BBFYCHK=$P($$DATE^PRC0C(PRCFA("OBLDATE"),"I"),U)
|
|
.S FY4=BBFYCHK D EDIT
|
|
QUIT
|
|
;
|
|
DATE ; Determine P.O. Date
|
|
K OK D DATE1 Q:$D(OK)
|
|
D ESIG
|
|
Q
|
|
DATE1 ; Get date of obligation from first node in Obligation Data
|
|
N OBND,OBDT
|
|
S OBND=$O(^PRC(442,PO,10,0)) I +OBND D Q:$D(OK)
|
|
.S OBDT=$P($G(^PRC(442,PO,10,OBND,0)),U,6) I $E(OBDT,1,7)?7N D SET(OBDT) Q
|
|
Q
|
|
ESIG ; Use Purchasing Agent Esig Date or Current Date
|
|
N CURDT,ESIGDT
|
|
S ESIGDT=$G(PRCTMP(442,PO,17,"I"))
|
|
I ESIGDT]"" S ESIGDT=$P(ESIGDT,".") I ESIGDT?7N D SET(ESIGDT) Q:$D(OK)
|
|
S CURDT=DT D SET(CURDT)
|
|
Q
|
|
SET(DATE) ; Set P.O. Date Field
|
|
N DIE,DR,DA
|
|
S DATE=$E(DATE,1,7),$P(N1,U,15)=DATE
|
|
S DIE="^PRC(442,",DR=".1////^S X=DATE",DA=PO D ^DIE S OK=1
|
|
Q
|
|
EDIT ; Edit BBFY field in File 442
|
|
N DIE,DR,DA,APPR
|
|
S APPR=$P($$ACC^PRC0C(PRC("SITE"),+PCP_U_PRC("FY")_U_PRC("BBFY")),U,11)
|
|
S DIE="^PRC(442,",DA=PO,DR="1.4///^S X=APPR;26///^S X=FY4" D ^DIE
|
|
S PRCFA("BBFY")=$$BBFY^PRCFFU5(PO)
|
|
Q
|
|
GETBBFY ; Get BBFY based on station, 2-digit FY, and FCP
|
|
S BBFY=$$BBFY^PRCSUT(+N0,FY2,+$P(N0,U,3))
|
|
Q
|