| 1 | PRCH1C ;WISC/PLT-FMS documents Inquiry/Regenerate Rejected ET ; 08/16/95 1:45 PM
|
|---|
| 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 | EN ;FMS doc inquiry
|
|---|
| 7 | D EN^PRC0E("ET:Expenditure Transfer^FMS ET Document ID: ","D INQ^PRCH1C")
|
|---|
| 8 | QUIT
|
|---|
| 9 | INQ ;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 | ;
|
|---|
| 27 | INQET ;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
|
|---|
| 36 | EN1 ;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 | ;
|
|---|
| 41 | EN2 ;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
|
|---|
| 50 | Q12 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)," ")
|
|---|
| 56 | Q13 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 | ;
|
|---|
| 62 | EXIT K X,Y
|
|---|
| 63 | QUIT
|
|---|
| 64 | ;
|
|---|
| 65 | ET S PRCFC=PRCRI(440.6)_"^"_PRCRI(442)_"^"_PRCDI_"^"_PRCBOC
|
|---|
| 66 | D ET^PRCH8A(.X,PRCFC,PRCRI(2100.1)_"^"_$P(PRCID,"-",2,999))
|
|---|
| 67 | QUIT
|
|---|
