source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU19.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1PRCFFU19 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES ;1/12/95 5:33 PM
2V ;;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 ;
13BBFYCHK(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
32T1 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 ;
37DATE ; Determine P.O. Date
38 K OK D DATE1 Q:$D(OK)
39 D ESIG
40 Q
41DATE1 ; 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
46ESIG ; 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
52SET(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
57EDIT ; 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
63GETBBFY ; Get BBFY based on station, 2-digit FY, and FCP
64 S BBFY=$$BBFY^PRCSUT(+N0,FY2,+$P(N0,U,3))
65 Q
Note: See TracBrowser for help on using the repository browser.