| 1 | PRCHNPO8 ;WISC/RHD/DL-MISCELLANEOUS ROUTINES FROM P.O.ADD/EDIT 443.6 ;9/5/00 12:30
|
|---|
| 2 | V ;;5.1;IFCAP;**113**;Oct 20, 2000;Build 4
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN1 ;FILE 443.6, FCP #1
|
|---|
| 6 | N Y
|
|---|
| 7 | S Z0=$E($P(^PRC(443.6,DA,0),"-",2),1,2),Z1=+X D EN4^PRCHNPO6 I '$T K X,Z0,Z1 Q
|
|---|
| 8 | S DIC="^PRC(420,PRC(""SITE""),1,",DIC(0)="QEMNZ",D="B^C" D MIX^DIC1 K:Y<0!('$D(PRC("FY"))) X K DIC,Z0,Z1 Q:'$D(X)
|
|---|
| 9 | N CCNODE S CCNODE=$G(^PRC(420,PRC("SITE"),1,+Y,2,0)) I $P(CCNODE,U,4)'>0!(CCNODE="") W !,"The Fund Control Point selected by you, does not have any",!,"Cost Centers listed under it.",! K X Q
|
|---|
| 10 | I $P(Y(0),U,12)'=2,$P(Y(0),U,18)="" W $C(7),!,"LOG Department Number is missing!!" K X Q
|
|---|
| 11 | S Z0=$P(^PRC(443.6,DA,0),U,2),Z1=$P(Y(0),U,12) I Z1 I Z0=4!((Z0=3)&(Z1=3)) S Z0=$P(^PRCD(442.5,Z0,0),U,1) W $C(7),!,"Fund Control Point not valid for a "_Z0_" order." K Z0,Z1,X Q
|
|---|
| 12 | S Z0=$P(Y(0),U,1) S:$P(Y(0),U,10)]"" PRCHN("SVC")=$P($G(^DIC(49,+$P(Y(0),U,10),0)),U,1)
|
|---|
| 13 | S PRC("FY")=$E(100+$E(PRC("FY"),2,3)+$E(PRC("FY"),4),2,3)
|
|---|
| 14 | I $D(^PRC(420,PRC("SITE"),1,+Y,2,0)),$P(^(0),U,4)=1,$D(^($P(^(0),U,3),0)),$D(^PRCD(420.1,+^(0),0)) S PRCHN("CC")=$P(^(0)," ",1)
|
|---|
| 15 | S PRC("APP")="",X=Z0,PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),+X) I PRC("BBFY")="" Q
|
|---|
| 16 | S PRC("APP")=$P($$ACC^PRC0C(PRC("SITE"),+X_"^"_PRC("FY")_"^"_PRC("BBFY")),U,11) K Z0,Z1
|
|---|
| 17 | I $P($G(^PRC(420,PRC("SITE"),1,+X,0)),U,19)=1 W !,"Sorry, this FCP is inactive!",! K X Q
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | EN2 ;UPDATE BOC #3.5
|
|---|
| 21 | D VEN^PRCHNPO7 Q:'$D(X)!($P(^PRC(442,DA(1),2,DA,0),U,5)="")
|
|---|
| 22 | S:'$D(PRC("SITE")) PRC("SITE")=$P($P(^PRC(442,DA(1),0),U,1),"-",1)
|
|---|
| 23 | S PRCHCV=$P(^PRC(442,DA(1),1),U),PRCHCI=$P(^(2,DA,0),U,5)
|
|---|
| 24 | D EN13^PRCHCRD1
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BBFY(PO) ;BEGINING BUDGET FISCAL YEAR CHECK/UPDATE
|
|---|
| 28 | ; ENTERED:
|
|---|
| 29 | ; PO = FILE 442 INTERNAL RECORD NUMBER
|
|---|
| 30 | ;
|
|---|
| 31 | ; RETURNED:
|
|---|
| 32 | ; PRC("BBFY") = FOUR DIGIT YEAR (1995)
|
|---|
| 33 | ;
|
|---|
| 34 | ; PO IS UNCHANGED BY THIS CALL
|
|---|
| 35 | ;
|
|---|
| 36 | N BBFY,N0,N1,FY,P2237,SFCP,DIE,DA,DR,X,FLAG
|
|---|
| 37 | S N0=$G(^PRC(442,PO,0)),N1=$G(^PRC(442,PO,1))
|
|---|
| 38 | S FY=$P(N1,U,15),FY=$E(100+$E(FY,2,3)+$E(FY,4),2,3)
|
|---|
| 39 | S FLAG="",P2237=$P(N0,U,12) I P2237>0 D G:FLAG=1 T1
|
|---|
| 40 | .S FY=$$NP^PRC0B("^PRCS(410,"_P2237_",",3,11)
|
|---|
| 41 | .I FY?2N S FY=1700+$E(FY,1,3),PRC("BBFY")=FY,FLAG=1 Q
|
|---|
| 42 | .S FY=$$NP^PRC0B("^PRCS(410,"_P2237_",",0,1)
|
|---|
| 43 | .S FY=$P(FY,"-",2)
|
|---|
| 44 | .Q
|
|---|
| 45 | S FY=$$BBFY^PRCSUT(+N0,FY,+$P(N0,U,3),1)
|
|---|
| 46 | T1 S SFCP=$P(N0,U,19) I SFCP=1!(SFCP=2) S (PRC("BBFY"),FY)=1994
|
|---|
| 47 | I FY?2N S DIE="^PRC(442,",DA=PO,DR="26///^S X=FY" D ^DIE
|
|---|
| 48 | Q
|
|---|
