source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC0C.m@ 649

Last change on this file since 649 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRC0C ;WISC/PLT-UTILITY (2) ; 1/23/98 1200
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ; invalid entry
5 ;
6 ;extrinsic function for fms document required fields
7 ;A is ^1=record id of file 420.14 (option)
8 ; ^2=station #, ^3=fund control pt #,
9 ; ^4=(document) fiscal year, ^5=beginning budget fiscal year
10 ;B=fix value of doc type in file 420.16
11 ;C=fix value of doc data element of file 420.17
12 ; variable=Y for yes, N or nil for no
13REQ(A,B,C) ;get fund's one required field value Y/N
14 N D,X
15 S X="",B=$O(^PRCD(420.16,"AC",B,"")),C=$O(^PRCD(420.17,"AC",C,""))
16 I $P(A,"^",2) S D=$$ACC($P(A,"^",2),$P(A,"^",3)_"^"_$P(A,"^",4)_"^"_$P(A,"^",5)),$P(A,"^")=$P(D,"^",9)
17 I A,B,C D
18 . S X=$O(^PRCD(420.18,"UNQ",$P(A,"^"),B,C,""))
19 . S:X>0 X=$P($G(^PRCD(420.18,X,0)),"^",4)
20 . QUIT
21 QUIT X
22 ;
23 ; A=^1 fund 420.14 ri (opt), ^2 station #, ^3 control pt #,
24 ; ^4=(document) fiscal year, ^5=beginning budget fiscal year
25 ; B=document type fix value, C=variable name
26 ; return value is variable name(data element fix value)="Y","N" or nil
27 ; variable name=$$ACC^PRC0C
28DOCREQ(A,B,C) ;get fund's all required fields in array
29 N D,E
30 I $P(A,"^",2) S D=$$ACC($P(A,"^",2),$P(A,"^",3)_"^"_$P(A,"^",4)_"^"_$P(A,"^",5)),@C=D,$P(A,"^",1)=$P(D,"^",9)
31 S B=$O(^PRCD(420.16,"AC",B,""))
32 I A,B D
33 .S D="" F S D=$O(^PRCD(420.18,"UNQ",+A,B,D)) Q:'D S E=$O(^(D,"")) D:E
34 .. S E=^PRCD(420.18,E,0)
35 .. S @(C_"($P(^PRCD(420.17,D,0),""^"",4))=$P(E,""^"",4)")
36 .. QUIT
37 . QUIT
38 QUIT
39 ;
40 ;A is station #
41 ;B is data ^1=fund control point code, ^2= (document) fiscal 2-digit year,
42 ; ^3=beginning budget fiscal year (4-digit)
43 ; value ^1=a/o code, ^2=program, ^3=fcp/prj code
44 ; ^4=object class, ^5=fund code
45 ; ^6=bfy beginning, ^7=bfy end, ^8=fund trans allowed
46 ; ^9=file 420.14 record id, ^10=job, ^11=fill-in-year(s) appropriation, ^12=gross/net, ^13='Y' if revolving fund
47ACC(A,B) ;extrinsic function
48 N C,D,E,F,G,I
49 S (C,D,F)=""
50 S:$P(B,"^",2)?2N&A&B C=$$ACC^PRCSEZ(+A,$P(B,"^",2),+B)
51 S:$P(C,"^",4) D=$$NP^PRC0B("^PRCD(420.15,$P(C,""^"",4),",0,1)
52 S:$P(C,"^",5) $P(D,"^",2)=$$NP^PRC0B("^PRCD(420.13,$P(C,""^"",5),",0,1)
53 S:$P(C,"^",6) $P(D,"^",3)=$$NP^PRC0B("^PRCD(420.131,$P(C,""^"",6),",0,1)
54 S:$P(C,"^",7) $P(D,"^",4)=$$NP^PRC0B("^PRCD(420.132,$P(C,""^"",7),",0,1)
55 I $P(C,"^",10)]"",$P(B,"^",3) S F=$$FUND($P(C,"^",10),$P(B,"^",3))
56 S E="" F I=2,4,5,8,1 S E=E_$P(F,"^",I)_"^"
57 S $P(D,"^",5,9)=E,$P(D,"^",12)=$P(F,"^",6) S:$P(D,"^",12)="" $P(D,"^",12)="N"
58 S:$P(C,"^",8) $P(D,"^",10)=$$NP^PRC0B("^PRCD(420.133,$P(C,""^"",8),",0,1)
59 S:$P(D,"^",6) $P(D,"^",11)=$$APPF($P(C,"^",9),$P(D,"^",6),$P(D,"^",7))
60 I $P(D,"^",5)]"" S C=$O(^PRCD(420.3,"B",$P(D,"^",5),0)) S:C $P(D,"^",13)=$P(^PRCD(420.3,C,0),"^",8)
61 QUIT D
62 ;
63FUND(A,B) ;get fund, A=fund code, B=bbfy
64 N C
65 S C="" I A]"",B]"" S C=$O(^PRCD(420.14,"UNQ",A,B,"")) I C S C=$O(^(C,""))
66 QUIT C_"^"_$S(C:$G(^PRCD(420.14,C,0)),1:"")
67 ;
68 ;A=station #, B=fiscal year (2-digit), C=fcp #
69 ;D is data ^1=appropriation code, ^2=fund code
70APP(A,B,C) ;EF data ^1=app symbol, ^2=fund code, ^3=program ri
71 N D
72 S D=$G(^PRC(420,+A,1,+C,4,B,2)) S:D]"" D=$P(D,"^",9,10)_"^"_$P(D,"^",5)
73 S:D="" D=$P($G(^PRC(420,+A,1,+C,0)),"^",3),$P(D,"^",2,3)=$P($G(^(5)),"^",1,2)
74 QUIT D
75 ;
76APPF(A,B,C) ;fill-in-years appropriation, A=appropriation, B=bbfy, C=ebfy
77 N D
78 S D=$F(A,"_/_")
79 QUIT $S(D>1:$E(A,1,D-4)_(B#10)_"/"_(C#10)_$E(A,D,999),1:$TR(A,"_",B#10))
80 ;
81 ;X date
82 ;A=I if fm date, E if external date, H if $H date
83DATE(X,A) ;ext value ^1=fy (4 digits),^2=fy qtr,^3=year,^4=month (2 digits),^5=day (2 digits),^6=week day #,^7=fm date,^8=$H date, ^9=fiscal month( 2-dig)
84 N B,C,D,E,Y,%H,%,%DT,%T,%Y
85 S D=""
86 I A="H" S D=X,E=D-3#7,%H=X D YMD^%DTC
87 I A="E" S %DT="" D ^%DT S X=Y
88 S A=X\10000+1700,B=$E(X,4,5),C=$E(X,6,7)
89 I D="" D H^%DTC S D=%H,E=%Y
90 QUIT B>9+A_"^"_(B+2\3#4+1)_"^"_A_"^"_B_"^"_C_"^"_E_"^"_X_"^"_D_"^"_$E(B+2#12+1+100,2,3)
91 ;
92 ;A is 2/4 digit year
93YEAR(A) ;EF value ^1=4-digit year,^2=2-digit year
94 N B,C,D,F,X,Y,%DT
95 I A>100 S B=A_"^"_$E(A,$L(A)-1,$L(A))
96 E S X=$E(100+A,2,3),%DT="" D ^%DT S B=$E(Y,1,3)+1700_"^"_X
97 QUIT B
98 ;
99 ;A=staiton #
100SEC1(A) ;EF value=fms sec1 code
101 QUIT $P($G(^PRCD(420.138,+$P($G(^PRC(411,+A,9)),"^",2),0)),"^",1)
102 ;
Note: See TracBrowser for help on using the repository browser.