103 lines
4.8 KiB
Mathematica
103 lines
4.8 KiB
Mathematica
PRCB1D ;WISC/PLT-RESET FCP YEARLY FMS ACCOUNTING ELEMENT AND BBFY ACT CODE ; 03/14/94 2:06 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
QUIT ;invalid entry
|
|
;
|
|
EN N PRCRI,PRC,PRCZ,PRCDD,PRCDI,PRCQT,PRCB,PRCB1,PRCD,PRCD1,PRCSTU
|
|
N A,B,C,X,Y
|
|
F S PRCQT=1 D LG1 QUIT:PRCQT["^" D Q:PRCQT["^"&($G(PRCSTU)<2)
|
|
. F S PRCQT=2 D LG2 QUIT:PRCQT["^"
|
|
. QUIT
|
|
EXIT QUIT
|
|
;
|
|
LG1 K PRC S PRCDI="420;^PRC(420,;" D
|
|
. S PRCSTU=0,PRCRI(411)=0 F S PRCRI(411)=$O(^PRC(411,PRCRI(411))) Q:'PRCRI(411) S:$D(^PRC(420,PRCRI(411),2,DUZ)) PRCSTU=PRCSTU+1_"^"_PRCRI(411)
|
|
I 'PRCSTU D EN^DDIOL("Station access is not allowed") S PRCQT="^" G LG1X
|
|
I +PRCSTU=1 S PRC("SITE")=$P(^PRC(420,+$P(PRCSTU,"^",2),0),"^") D EN^DDIOL("STATION: "_PRC("SITE")) G LG1E
|
|
S X("S")="I $D(^PRC(420,+Y,2,DUZ))"
|
|
D LOOKUP^PRC0B(.X,.Y,PRCDI,"ACEFNO","Select Station: ")
|
|
S:X=""!(X["^") PRCQT="^"
|
|
S PRC("SITE")=$P(Y,"^",2)
|
|
LG1E S PRCRI(420)=+PRC("SITE"),PRCDI=PRCDI_PRCRI(420)_";"
|
|
LG1X QUIT
|
|
;
|
|
LG2 ;
|
|
S $P(PRCDI,"~",2)="420.01;"_$P($P(PRCDI,"~"),";",2)_PRCRI(420)_",1,;"
|
|
Q2 K PRCZ D EN^DDIOL($TR($J("",78)," ","-")) S X("S")="I ^(0)-9999"
|
|
D LOOKUP^PRC0B(.X,.Y,PRCDI,"AEOQS","Select Fund Control Point: ")
|
|
I Y<0!(X="") S PRCQT="^" QUIT
|
|
K X S PRCRI(420.01)=+Y,PRC("CP")=$P($P(Y,"^")," ")
|
|
S PRCDI=PRCDI_PRCRI(420.01)_";"
|
|
;
|
|
Q3 S E="O^2:4^K:X'?2N&(X'?4N) X",Y(1)="Enter a 2 or 4 digit year."
|
|
D FT^PRC0A(.X,.Y,"For Budget Fiscal Year",E,"")
|
|
G:X["^"!(X="") Q2
|
|
S PRC("FY")=$P($$YEAR^PRC0C(Y),"^",2),PRCRI(420.06)=PRC("FY")
|
|
S PRCD=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCRI(420.06),2))
|
|
;I PRCD="" D EN^DDIOL(" The yearly FMS accounting elements are not in file yet.") G Q3
|
|
D DIS(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY"))
|
|
Q4 D YN^PRC0A(.X,.Y,"Reset the fiscal year "_PRC("FY")_" Suballowance Account","O","NO")
|
|
G:X["^"!(X="")!(Y<1) Q2
|
|
S PRCZ(4)=Y
|
|
Q5 ;D SC^PRC0A(.X,.Y,"Select FMS SA-doc ACT code","OM^A:for suballowance account NOT in FMS yet;C:for suballowance account is in FMS","")
|
|
;G:X["^"!(X="") Q2
|
|
S Y="C"
|
|
S PRCZ(5)=Y
|
|
Q6 D YN^PRC0A(.X,.Y,"Ready to File","O","NO")
|
|
G:X["^"!(X="")!'Y Q2
|
|
I '$P(PRCB1,"^",11) D EN^DDIOL("BBFY missing in FCP set up") G Q2
|
|
S A=$$FUND^PRC0C($P(PRCB1,"^",10),$P(PRCB1,"^",11))
|
|
I 'A D EN^DDIOL("Fund code "_$P(PRCB1,"^",10)_" with beginning year "_$P(PRCB1,"^",11)_" is not in fund file (420.14)") G Q2
|
|
S PRC("BBFY")=$$BBFY^PRCSUT(PRCRI(420),PRC("FY"),PRCRI(420.01),1)
|
|
I $G(PRCZ(4))=1 D G:'$G(PRC("BBFY")) Q2
|
|
. S:$P(PRCD1,"^",10)="" $P(PRCD1,"^",10)=$P(PRCB1,"^",10) S A=$$FUND^PRC0C($P(PRCD1,"^",10),PRC("BBFY"))
|
|
. I 'A D EN^DDIOL("Fund code "_$P(PRCD1,"^",10)_" with beginning year "_PRC("BBFY")_" is not in fund file (420.14).") K PRC("BBFY")
|
|
. QUIT
|
|
S PRCLOCK=$P($P(PRCDI,"~",2),";",2)_PRCRI(420.01)_","
|
|
D ICLOCK^PRC0B(PRCLOCK,.Y)
|
|
I 'Y D EN^DDIOL("This FCP File is in use, please try later!") G Q2
|
|
D FILE D DCLOCK^PRC0B(PRCLOCK)
|
|
G Q2
|
|
;
|
|
FILE ;filing
|
|
I $G(PRCZ(4))=1 D
|
|
. ;delete old entry in file 420.141
|
|
. S C=$$ACC^PRC0C(PRC("SITE"),PRC("CP")_"^"_PRC("FY")_"^"_PRC("BBFY"))
|
|
. S A=$$FMSACC^PRC0D(PRC("SITE"),C)
|
|
. S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
|
|
. I B D DELETE^PRC0B1(.X,";^PRCD(420.141,;"_B)
|
|
. ;reset fiscal yearly accounting elements
|
|
. D:'$D(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCRI(420.06))) EBAL^PRCSEZ(PRCRI(420)_"^"_PRCRI(420.01)_"^"_PRCRI(420.06)_"^1^0","C")
|
|
. S ^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCRI(420.06),2)=PRCB
|
|
;add new entry if action code is 'C', delete if code is A
|
|
S C=$$ACC^PRC0C(PRC("SITE"),PRC("CP")_"^"_PRC("FY")_"^"_PRC("BBFY"))
|
|
S A=$$FMSACC^PRC0D(PRC("SITE"),C)
|
|
S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
|
|
I $G(PRCZ(5))="A",B D DELETE^PRC0B1(.X,";^PRCD(420.141,;"_B)
|
|
I $G(PRCZ(5))="C",'B S B=$$A420D141^PRC0F(A,PRCRI(420.01))
|
|
QUIT
|
|
;
|
|
;PRCA data ^1=station, ^2=control point, ^3=fiscal year
|
|
DIS(PRCA) ;display fms accounting data
|
|
D ;get acc element from fcp
|
|
. N Z
|
|
. S Z("ST")=PRCRI(420),Z("CP")=PRCRI(420.01)
|
|
. S PRCB=$$SUBALL^PRCSEZ
|
|
. QUIT
|
|
S PRCD=$G(^PRC(420,PRCRI(420),1,PRCRI(420.01),4,PRCRI(420.06),2))
|
|
S PRCB1=$$ACC(PRCB),PRCD1=$$ACC(PRCD)
|
|
S A=$P($G(^PRC(420,PRCRI(420),1,PRCRI(420.01),5)),"^",8),$P(PRCB1,"^",11)=+$$DATE^PRC0C(A,"F")
|
|
S $P(PRCD1,"^",11)=PRC("FY")
|
|
W !,"CURRENT FCP ACCOUNTING ELEMENTS",?40,"FISCAL YEAR FCP ACCOUNTING ELEMENTS"
|
|
S B=0 F A=11,10,9,4:1:8 S B=B+1,C=$P("BBFY~FUND~APPROPRI~A/O~PROGRAM~FCP/PRJ~OBJECT CLASS~JOB","~",B) W !,$J(C,12),": ",$P(PRCB1,"^",A) S:C="BBFY" C="FISCAL YEAR" W ?40,$J(C,12),": ",$P(PRCD1,"^",A)
|
|
QUIT
|
|
;
|
|
ACC(A) ;get external format of prca
|
|
S:$P(A,"^",4) $P(A,"^",4)=$$NP^PRC0B("^PRCD(420.15,$P(A,""^"",4),",0,1)
|
|
S:$P(A,"^",5) $P(A,"^",5)=$$NP^PRC0B("^PRCD(420.13,$P(A,""^"",5),",0,1)
|
|
S:$P(A,"^",6) $P(A,"^",6)=$$NP^PRC0B("^PRCD(420.131,$P(A,""^"",6),",0,1)
|
|
S:$P(A,"^",7) $P(A,"^",7)=$$NP^PRC0B("^PRCD(420.132,$P(A,""^"",7),",0,1)
|
|
S:$P(A,"^",8) $P(A,"^",8)=$$NP^PRC0B("^PRCD(420.133,$P(A,""^"",8),",0,1)
|
|
QUIT A
|
|
;
|