| 1 | PRCFFU19 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;1/12/95 5:33 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | QUIT
|
|---|
| 6 | ; .1 - P.O. Date
|
|---|
| 7 | ; .07 - Primary 2237
|
|---|
| 8 | ; .03 - Special FCP
|
|---|
| 9 | ; 17 - Validation Date for PA Esig
|
|---|
| 10 | ; PRCFA("BBFY") - BBFY as stored in file 442,field 26
|
|---|
| 11 | ; PRC("BBFY") - BBFY based on station #, doc FY, FCP
|
|---|
| 12 | ;
|
|---|
| 13 | BBFYCHK(PO) ; Check BBFY at Obligation
|
|---|
| 14 | N BBFY,BBFYCHK,FY2,FY4,FYI,N0,N1,PODT,PRIMREQ,REV,SFCP
|
|---|
| 15 | I '$D(PRCFA("OBLDATE")) D NOW^%DTC S PRCFA("OBLDATE")=X K X
|
|---|
| 16 | D GENDIQ^PRCFFU7(442,PO,".1;.07;.03;17","IEN","")
|
|---|
| 17 | S N0=$$NODE^PRC0B("^PRC(442,"_PO_",",0)
|
|---|
| 18 | S N1=$$NODE^PRC0B("^PRC(442,"_PO_",",1)
|
|---|
| 19 | S PODT=$G(PRCTMP(442,PO,.1,"I"))
|
|---|
| 20 | I PODT="" D DATE S PODT=$P(N1,U,15)
|
|---|
| 21 | S PRIMREQ=$G(PRCTMP(442,PO,.07,"I"))
|
|---|
| 22 | I PRIMREQ>0 D G T1
|
|---|
| 23 | .S FYI=$$NP^PRC0B("^PRCS(410,"_PRIMREQ_",",3,11)
|
|---|
| 24 | .I FYI]"" S (FY4,PRC("BBFY"))=$P($$DATE^PRC0C(FYI,"I"),U) Q
|
|---|
| 25 | .I FYI="" D Q
|
|---|
| 26 | ..N TXN
|
|---|
| 27 | ..S TXN=$$NP^PRC0B("^PRCS(410,"_PRIMREQ_",",0,1)
|
|---|
| 28 | ..S FY2=$P(TXN,"-",2),(FY4,PRC("BBFY"))=$P($$YEAR^PRC0C(FY2),U)
|
|---|
| 29 | ..Q
|
|---|
| 30 | S FY2=$E(PRCFA("OBLDATE"),2,3)+$E(PRCFA("OBLDATE"),4)
|
|---|
| 31 | D GETBBFY S (FY4,PRC("BBFY"))=BBFY
|
|---|
| 32 | T1 I PRC("BBFY")'=PRCFA("BBFY") D Q
|
|---|
| 33 | .S BBFYCHK=$P($$DATE^PRC0C(PRCFA("OBLDATE"),"I"),U)
|
|---|
| 34 | .S FY4=BBFYCHK D EDIT
|
|---|
| 35 | QUIT
|
|---|
| 36 | ;
|
|---|
| 37 | DATE ; Determine P.O. Date
|
|---|
| 38 | K OK D DATE1 Q:$D(OK)
|
|---|
| 39 | D ESIG
|
|---|
| 40 | Q
|
|---|
| 41 | DATE1 ; Get date of obligation from first node in Obligation Data
|
|---|
| 42 | N OBND,OBDT
|
|---|
| 43 | S OBND=$O(^PRC(442,PO,10,0)) I +OBND D Q:$D(OK)
|
|---|
| 44 | .S OBDT=$P($G(^PRC(442,PO,10,OBND,0)),U,6) I $E(OBDT,1,7)?7N D SET(OBDT) Q
|
|---|
| 45 | Q
|
|---|
| 46 | ESIG ; Use Purchasing Agent Esig Date or Current Date
|
|---|
| 47 | N CURDT,ESIGDT
|
|---|
| 48 | S ESIGDT=$G(PRCTMP(442,PO,17,"I"))
|
|---|
| 49 | I ESIGDT]"" S ESIGDT=$P(ESIGDT,".") I ESIGDT?7N D SET(ESIGDT) Q:$D(OK)
|
|---|
| 50 | S CURDT=DT D SET(CURDT)
|
|---|
| 51 | Q
|
|---|
| 52 | SET(DATE) ; Set P.O. Date Field
|
|---|
| 53 | N DIE,DR,DA
|
|---|
| 54 | S DATE=$E(DATE,1,7),$P(N1,U,15)=DATE
|
|---|
| 55 | S DIE="^PRC(442,",DR=".1////^S X=DATE",DA=PO D ^DIE S OK=1
|
|---|
| 56 | Q
|
|---|
| 57 | EDIT ; Edit BBFY field in File 442
|
|---|
| 58 | N DIE,DR,DA,APPR
|
|---|
| 59 | S APPR=$P($$ACC^PRC0C(PRC("SITE"),+PCP_U_PRC("FY")_U_PRC("BBFY")),U,11)
|
|---|
| 60 | S DIE="^PRC(442,",DA=PO,DR="1.4///^S X=APPR;26///^S X=FY4" D ^DIE
|
|---|
| 61 | S PRCFA("BBFY")=$$BBFY^PRCFFU5(PO)
|
|---|
| 62 | Q
|
|---|
| 63 | GETBBFY ; Get BBFY based on station, 2-digit FY, and FCP
|
|---|
| 64 | S BBFY=$$BBFY^PRCSUT(+N0,FY2,+$P(N0,U,3))
|
|---|
| 65 | Q
|
|---|
