source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCB1C.m@ 1700

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1PRCB1C ;WISC/PLT-FMS documents Inquiry/Regenerate Rejected SA/ST/AT ; 08/16/95 1:45 PM
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 ;
6EN ;FMS doc inquiry
7 D EN^PRC0E("SA:Suballowance;ST:Suballowance Transfer;AT:Allowance Transfer^FMS Budget Document ID: ","D INQ^PRCB1C")
8 QUIT
9INQ ;dispaly dcocument data
10 N A,B,PRCFC,PRCTX,PRCRI
11 S PRCTX=$P(X,"^",2),PRCRI(2100.1)=$P(X,"^",4)
12 S PRCFC=$TR($G(GECSDATA(2100.1,PRCRI(2100.1),26,"E")),"/","^")
13 S $P(PRCFC,"^",6)=$FN($P(PRCFC,"^",6),"",2)
14 D:PRCFC]""
15 . S A=$$DT^PRC0B2(+PRCFC,"I"),$P(PRCFC,"^",1)=$P(A,"^",5)
16 . D @("INQ"_PRCTX)
17 QUIT
18 ;
19 ;
20INQSA ;display SA
21 F B=1,11,10,2:1:7,9 D EN^DDIOL($J($P("FMS Txn Date^Doc Year^Quarter^Station #^FCP #^$Amount^BBFY^^FMS Action^FY Acctg Per^FMS Acctg Per","^",B),13)_": "_$P(PRCFC,"^",B))
22 QUIT
23 ;
24INQST ;dispaly ST
25INQAT ;dispalt AT
26 F B=1,11,10,2:1:8 D EN^DDIOL($J($P("FMS Txn Date^Doc Year^Quarter^Station #^From FCP #^$Amount^BBFY^To FCP#^^FY Acctg Per^FMS Acctg Per","^",B),13)_": "_$P(PRCFC,"^",B))
27 QUIT
28 ;
29 ;PRCA data ^1=txn type;txn type...,^2=select document text, ^3=status
30EN1 ;rejected FMS document process
31 N PRC,PRCA,PRCRI,PRCID,PRCTX,PRCF,PRCFC,PRCLACT
32 D EN^PRC0E("SA:Suballowance;ST:Suballowance Transfer;AT:Allowance Transfer^FMS Rejected Budget Document ID: ^~E~R~T~~","D INQ^PRCB1C,EN2^PRCB1C")
33 QUIT
34 ;
35EN2 ;File process rejected fms doc
36 N PRCRI,PRCTX,PRCID,PRCFC,PRCFDT,PRCFAC,PRCAP,PRCFP
37 S PRCTX=$P(X,"^",2),PRCID=$P(X,"^",3),PRCRI(2100.1)=$P(X,"^",4)
38 D EN^DDIOL(" ")
39 D DATA^GECSSGET(PRCID,0)
40 S PRCFC=GECSDATA(2100.1,PRCRI(2100.1),26,"E") K GECSDATA
41 S PRCFDT=$P(PRCFC,"^"),PRCFAC=$P(PRCFC,"/",9)
42Q11 S Y(1)="Enter a date you want to send documents to FMS in format: MM/DD/YY"
43 S A=$$DT^PRC0B2("T","E"),A=$P(A,"^",5)
44 D DT^PRC0A(.X,.Y,"FMS Transaction Date","",A)
45 QUIT:Y=""!(Y["^")
46 I Y#100=0 W " Enter precise date!" G Q11
47 S Y=$$DT^PRC0B2(Y,"I")
48 W " (",$P(Y,"^",5),")"
49 S PRCFDT=+Y,PRCAP=$P($$DT^PRC0B2($E(Y,1,5)_"00","I"),"^",5)
50Q115 S Y(1)="Enter a calender (not fiscal year) accounting period in format: MM/YY."
51 S Y(2)="NOTE: a closed FMS accounting period will cause documents to be rejected."
52 D DT^PRC0A(.X,.Y,"Accounting Period (MM/YY)","O",PRCAP)
53 I X=""!(X["^") G Q11
54 G:Y<0 Q115
55 I Y#100'=0 W " Enter nonth/year only!" G Q115
56 S Y=$$DT^PRC0B2(Y,"I")
57 W " (",$P(Y,"^",5),")"
58 S PRCFP=$P(Y,"^",5),X=$$DATE^PRC0C(+Y,"I"),PRCFP=$P(X,"^",9)_$E(X,3,4)_"/"_PRCFP
59 G:PRCTX'="SA" Q13
60Q12 ;D SC^PRC0A(.X,.Y,"Select FMS Action Code","B^A:Add New Suballowance;C:Inc/Dec Suballowance",PRCFAC)
61 ;G Q11:Y=""!(Y["^")
62 S Y="C"
63 S PRCFAC=Y
64Q13 K X,Y D YN^PRC0A(.X,.Y,"Ready To File Regenerated FMS Document","","NO")
65 G:Y["^" Q11
66 I Y=1 D
67 . D:PRCFC]"" @PRCTX,EN^DDIOL("<Filed>")
68 QUIT
69 ;
70EXIT K X,Y
71 QUIT
72 ;
73SA I PRCFAC="A" D FMSSAL(PRCFC,-1)
74 I PRCFAC="C" D FMSSAL(PRCFC,1)
75 S $P(PRCFC,"/")=PRCFDT,PRCFC=$P(PRCFC,"/",1,8),$P(PRCFC,"/",9)=PRCFP
76 D SA^PRCB8A(.X,$TR(PRCFC,"/","^"),PRCRI(2100.1)_"^"_$P(PRCID,"-",2,999))
77 QUIT
78 ;
79ST S $P(PRCFC,"/")=PRCFDT,PRCFC=$P(PRCFC,"/",1,8),$P(PRCFC,"/",9)=PRCFP
80 D ST^PRCB8A1(.X,$TR(PRCFC,"/","^"),PRCRI(2100.1)_"^"_$P(PRCID,"-",2,999))
81 QUIT
82 ;
83AT S $P(PRCFC,"/")=PRCFDT,PRCFC=$P(PRCFC,"/",1,8),$P(PRCFC,"/",9)=PRCFP
84 D AT^PRCB8A2(.X,$TR(PRCFC,"/","^"),PRCRI(2100.1)_"^"_$P(PRCID,"-",2,999))
85 QUIT
86 ;
87 ;A=file 2100.1 ri, B=status
88SAREJ(A,B) ;DCT process rejected sa subroutine
89 N GECSDATA,PRCRI,PRCID,PRCFC,PRCDDT,PRCY,PRCQ,PRCSITE,PRCAMT,PRCY
90 QUIT:B'="R"
91 D DATA^GECSSGET(A,0) QUIT:'$G(GECSDATA)
92 S PRCRI(2100.1)=GECSDATA,PRCID=GECSDATA(2100.1,PRCRI(2100.1),.01,"E")
93 S PRCFC=GECSDATA(2100.1,PRCRI(2100.1),26,"E")
94 K GECSDATA
95 D:$P(PRCFC,"/",9)="A" FMSSAL(PRCFC,-1)
96 QUIT
97 ;
98 ;PRCFC=SA document string, PRCA=1 if add, -1 if delete
99FMSSAL(PRCFC,PRCA) ;add/delete entry in file 420.141
100 N PRCRI,PRCQ,PRCSITE,PRCAMT,PRCY,PRCF
101 N A,B
102 S PRCFC=$TR($P(PRCFC,"/",1,8),"/","^")
103 S PRCY=$P(PRCFC,"^",2),PRCQ=$P(PRCFC,"^",3)
104 S PRCSITE=+$P(PRCFC,"^",4),PRCRI(420.01)=+$P(PRCFC,"^",5),PRCAMT=$P(PRCFC,"^",6)
105 S PRCY=$$YEAR^PRC0C(PRCY)
106 S PRCF=$$ACC^PRC0C(PRCSITE,PRCRI(420.01)_"^"_$E(PRCY,3,4)_"^"_$P(PRCFC,"^",7))
107 S A=$$FMSACC^PRC0D(PRCSITE,PRCF)
108 S B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
109 I PRCA=-1,B D DELETE^PRC0B1(.X,";^PRCD(420.141,;"_B)
110 I PRCA=1,'B S B=$$A420D141^PRC0F(A,PRCRI(420.01))
111 QUIT
112 ;
Note: See TracBrowser for help on using the repository browser.