source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHNPO8.m@ 1211

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

revised back to 6/30/08 version

File size: 2.3 KB
RevLine 
[623]1PRCHNPO8 ;WISC/RHD/DL-MISCELLANEOUS ROUTINES FROM P.O.ADD/EDIT 443.6 ;9/5/00 12:30
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN1 ;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 Q
18 ;
19EN2 ;UPDATE BOC #3.5
20 D VEN^PRCHNPO7 Q:'$D(X)!($P(^PRC(442,DA(1),2,DA,0),U,5)="")
21 S:'$D(PRC("SITE")) PRC("SITE")=$P($P(^PRC(442,DA(1),0),U,1),"-",1)
22 S PRCHCV=$P(^PRC(442,DA(1),1),U),PRCHCI=$P(^(2,DA,0),U,5)
23 D EN13^PRCHCRD1
24 Q
25 ;
26BBFY(PO) ;BEGINING BUDGET FISCAL YEAR CHECK/UPDATE
27 ; ENTERED:
28 ; PO = FILE 442 INTERNAL RECORD NUMBER
29 ;
30 ; RETURNED:
31 ; PRC("BBFY") = FOUR DIGIT YEAR (1995)
32 ;
33 ; PO IS UNCHANGED BY THIS CALL
34 ;
35 N BBFY,N0,N1,FY,P2237,SFCP,DIE,DA,DR,X,FLAG
36 S N0=$G(^PRC(442,PO,0)),N1=$G(^PRC(442,PO,1))
37 S FY=$P(N1,U,15),FY=$E(100+$E(FY,2,3)+$E(FY,4),2,3)
38 S FLAG="",P2237=$P(N0,U,12) I P2237>0 D G:FLAG=1 T1
39 .S FY=$$NP^PRC0B("^PRCS(410,"_P2237_",",3,11)
40 .I FY?2N S FY=1700+$E(FY,1,3),PRC("BBFY")=FY,FLAG=1 Q
41 .S FY=$$NP^PRC0B("^PRCS(410,"_P2237_",",0,1)
42 .S FY=$P(FY,"-",2)
43 .Q
44 S FY=$$BBFY^PRCSUT(+N0,FY,+$P(N0,U,3),1)
45T1 S SFCP=$P(N0,U,19) I SFCP=1!(SFCP=2) S (PRC("BBFY"),FY)=1994
46 I FY?2N S DIE="^PRC(442,",DA=PO,DR="26///^S X=FY" D ^DIE
47 Q
Note: See TracBrowser for help on using the repository browser.