| 1 | PRC0C ;WISC/PLT-UTILITY (2) ; 1/23/98 1200
|
|---|
| 2 | V ;;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
|
|---|
| 13 | REQ(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
|
|---|
| 28 | DOCREQ(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
|
|---|
| 47 | ACC(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 | ;
|
|---|
| 63 | FUND(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
|
|---|
| 70 | APP(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 | ;
|
|---|
| 76 | APPF(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
|
|---|
| 83 | DATE(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
|
|---|
| 93 | YEAR(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 #
|
|---|
| 100 | SEC1(A) ;EF value=fms sec1 code
|
|---|
| 101 | QUIT $P($G(^PRCD(420.138,+$P($G(^PRC(411,+A,9)),"^",2),0)),"^",1)
|
|---|
| 102 | ;
|
|---|
