source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH1C.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1PRCH1C ;WISC/PLT-FMS documents Inquiry/Regenerate Rejected ET ; 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("ET:Expenditure Transfer^FMS ET Document ID: ","D INQ^PRCH1C")
8 QUIT
9INQ ;dispaly dcocument data
10 N A,B,PRCFC,PRCTX,PRCRI,PRCIDL
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 PRCRI(440.6)=+PRCFC,PRCRI(442)=$P(PRCFC,"^",2),PRCDI=$P(PRCFC,"^",3),PRCBOC=$P(PRCFC,"^",4)
14 S PRCIDL=$P(^PRCH(440.6,PRCRI(440.6),0),"^")
15 S PRCB(1)=$$DDA4406^PRCH0A(PRCRI(440.6)),PRCB(2)=$$DDA442^PRCH0A(PRCRI(442))
16 S $P(PRCB(2),"^",21)=PRCBOC
17 S $P(PRCB(2),"^",33)=$P(PRCB(1),"^",33)
18 S $P(PRCB(1),"^",40)=$E(PRCIDL,13,15),$P(PRCB(2),"^",40)=$E(PRCIDL,13,15)+500
19 F A=1,2 S $P(PRCB(A),"^",34)=$E("DI",A)
20 I PRCDI=2 F A=1,2 S $P(PRCB(A),"^",34)=$E("ID",A)
21 I $P(PRCB(1),"^",33)<0 S A=$P(PRCB(1),"^",34),$P(PRCB(1),"^",34)=$P(PRCB(2),"^",34),$P(PRCB(2),"^",34)=A F A=1,2 S $P(PRCB(A),"^",33)=$E($P(PRCB(A),"^",33),2,999)
22 I $P(PRCB(1),"^",34)="I" S A=PRCB(1),PRCB(1)=PRCB(2),PRCB(2)=A
23 D:PRCFC]""
24 . D @("INQ"_PRCTX)
25 QUIT
26 ;
27INQET ;display ET
28 W !,"Description",?25,"Line #",$P(PRCB(1),"^",40),?45,"Line #",$P(PRCB(2),"^",40)
29 F B=13:1:21,23 W !,$J($P("BBFY^BBEY^FUND^STATION^SUB STATION^COST CENTER^SUB COST CENTER^FCP/PRJ^BOC^^JOB NO","^",B-12),15),": ",?25,$P(PRCB(1),"^",B),?45,$P(PRCB(2),"^",B)
30 F B=33,34 W !,$J($P("LINE AMOUNT^LINE ACTION","^",B-32),15),": ",?25,$P(PRCB(1),"^",B),?45,$P(PRCB(2),"^",B)
31 W !,"PURCHASE CARD ORDER: ",$P(^PRC(442,PRCRI(442),0),"^")
32 QUIT
33 ;
34 ;
35 ;PRCA data ^1=txn type;txn type...,^2=select document text, ^3=status
36EN1 ;rejected FMS document process
37 N PRC,PRCA,PRCRI,PRCID,PRCTX,PRCF,PRCFC,PRCLACT,PRCDI,PRCBOC
38 D EN^PRC0E("ET:Expenditure Transfer^FMS Rejected Budget Document ID: ^~E~R~T~~","D INQ^PRCH1C,EN2^PRCH1C")
39 QUIT
40 ;
41EN2 ;File process rejected fms doc
42 N PRCRI,PRCTX,PRCID,PRCFC,PRCFDT,PRCFAC,PRCAP,PRCFP
43 S PRCTX=$P(X,"^",2),PRCID=$P(X,"^",3),PRCRI(2100.1)=$P(X,"^",4)
44 D EN^DDIOL(" ")
45 D DATA^GECSSGET(PRCID,0)
46 S PRCFC=GECSDATA(2100.1,PRCRI(2100.1),26,"E") K GECSDATA
47 S PRCRI(440.6)=+PRCFC,PRCRI(442)=$P(PRCFC,"/",2),PRCDI=$P(PRCFC,"/",3),PRCBOC=$P(PRCFC,"/",4)
48 S PRCRI(420.1)=+$P(^PRC(442,PRCRI(442),0),"^",5)
49 ;lookup boc
50Q12 S A="420.1;^PRCD(420.1,;"_PRCRI(420.1)_";1~420.11;^PRCD(420.1,"_PRCRI(420.1)_",1,"
51 ;S X("S")="I $P(^(0),U)>0"
52 D LOOKUP^PRC0B(.X,.Y,A,"AEOQS","Select BOC: ")
53 I Y<0!(X="") QUIT
54 S PRCRI(420.2)=+Y
55 S PRCBOC=$P(^PRCD(420.2,PRCRI(420.2),0)," ")
56Q13 K X,Y D YN^PRC0A(.X,.Y,"Ready To Regenerate ET-FMS Document","","NO")
57 I X["^"!'Y QUIT
58 I Y=1 D
59 . D:PRCFC]"" @PRCTX,EN^DDIOL("<Regenerated>")
60 QUIT
61 ;
62EXIT K X,Y
63 QUIT
64 ;
65ET S PRCFC=PRCRI(440.6)_"^"_PRCRI(442)_"^"_PRCDI_"^"_PRCBOC
66 D ET^PRCH8A(.X,PRCFC,PRCRI(2100.1)_"^"_$P(PRCID,"-",2,999))
67 QUIT
Note: See TracBrowser for help on using the repository browser.