1 | PRCABIL3 ;SF-ISC/YJK-APPROVE BILL ;10/7/93 2:54 PM
|
---|
2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | APPRV ;APPROVE BILL
|
---|
5 | S DA=1 D SIG^PRCASIG Q:'$D(PRCANM)
|
---|
6 | A1 D SVC^PRCABIL G:'$D(PRCAP("S")) Q S DIC("S")="S Z0=$S($D(^PRCA(430.3,+$P(^(0),U,8),0)):$P(^(0),U,3),1:0) I Z0=205,$D(^PRCA(430,Y,100)),+$P(^(100),U,2)="_PRCAP("S")
|
---|
7 | S PRCATIME=DTIME,DTIME=60 D BILLN^PRCAUTL S DTIME=PRCATIME G Q:'$D(PRCABN)
|
---|
8 | L +^PRCA(430,PRCABN,0):0 I '$T W !,*7,"Another user is editing this bill" D KILLV G A1
|
---|
9 | S PRCABT=+^PRCA(430,PRCABN,100) G Q:'PRCABT!(PRCABT>3)
|
---|
10 | YN1 S %=1 W !," Review Bill" D YN^DICN
|
---|
11 | I %=0 W !,*7,"Answer 'Yes' or 'No' " G YN1
|
---|
12 | I %<1 W !,*7,"This bill will still remain Pending Approval Bill. ",!! D KILLV G A1
|
---|
13 | I %=1 S D0=PRCABN,IOP=0 D ^PRCABD I $P($G(^PRCA(430,PRCABN,3)),U,3) D
|
---|
14 | .N X,X1 S X=$P($G(^(3)),U,3,7),X1=$P(X,U) ;NAKED FROM ABOVE LINE
|
---|
15 | .W !,?28,"****AMENDED BILL INFO****"
|
---|
16 | .W !,"Amended Date: ",$E(X1,4,5),"/",$E(X1,6,7),"/",$E(X1,2,3)
|
---|
17 | .W ?50,"Amended Amount: ",$P(X,U,3),!
|
---|
18 | .S X=$P(X,U,5),DIWL=10,DIWR=65,DIWF="W" D ^DIWP,^DIWW
|
---|
19 | .Q
|
---|
20 | YN S %=2 W !," Approve this Bill" D YN^DICN
|
---|
21 | I %=0 W !,*7,"Answer 'Yes' or 'No' " G YN
|
---|
22 | I %=-1!(%=2) W !,*7,"This bill will still remain Pending Approval Bill.",!! D KILLV G A1
|
---|
23 | S DA=PRCABN G:'$D(DUZ) Q S P=+DUZ,X=$S($D(^VA(200,P,20)):$P(^(20),U,2),1:"") D:X'="" EN^PRCASIG(.X,P,DA_+$P(^PRCA(430,DA,0),U,3))
|
---|
24 | S PRCAX=+DUZ_"^"_X_"^^"_$S($D(^VA(200,+DUZ,20)):$P(^(20),U,3),1:"") D NOW^%DTC S $P(PRCAX,"^",3)=%
|
---|
25 | S ^PRCA(430,PRCABN,104)=PRCAX,PRCA("STATUS")=$O(^PRCA(430.3,"AC",104,0)),PRCA("SDT")=DT
|
---|
26 | I $P($G(^PRCA(430,PRCABN,9)),U,6)=$O(^PRCA(430.3,"AC",230,"")) S PRCA("STATUS")=$O(^PRCA(430.3,"AC",110,""))
|
---|
27 | D UPSTATS^PRCAUT2 K PRCA("STATUS"),PRCA("SDT") W !,"*** This bill has been released to the AR section ***",!
|
---|
28 | I PRCABT=3 G A1 ;Don't print 1114 form
|
---|
29 | ANW S %=1 W !,"Do you want to print a copy of this bill for your records " D YN^DICN G:(%<0)!(%=2) A1
|
---|
30 | I %=0 W !,"The official bill will be printed by Fiscal Service. Enter 'Y' or 'YES'",!,"if you want to print a copy of the bill for your Service's records.",! G ANW
|
---|
31 | K ZTSAVE S D0=PRCABN,PRCADFM=1,PRCARN="^PRCABP"_PRCABT,ZTSAVE("D0")="",ZTSAVE("PRCADFM")="" D OPENDV^PRCABPF D KILLV G A1
|
---|
32 | KILLV L -^PRCA(430,+$G(PRCABN),0)
|
---|
33 | D ^%ZISC K %,%Y,A,B,C,D0,DA,DIC,DIE,DIK,DR,I,PRCABC,PRCABN,PRCABT,PRCADFM,PRCAI,PRCATIME,PRCAMT,PRCANM,PRCAKCT,PRCANQM,PRCAQ,PRCAP,PRCAT,PRCATY,PRCAX,X,Y,Z0,ZRTN,ZTSK,POP,PRCARN,PRCAK,P Q
|
---|
34 | Q D KILLV K PRCA Q
|
---|