PRCABIL3 ;SF-ISC/YJK-APPROVE BILL ;10/7/93 2:54 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
APPRV ;APPROVE BILL
S DA=1 D SIG^PRCASIG Q:'$D(PRCANM)
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")
S PRCATIME=DTIME,DTIME=60 D BILLN^PRCAUTL S DTIME=PRCATIME G Q:'$D(PRCABN)
L +^PRCA(430,PRCABN,0):0 I '$T W !,*7,"Another user is editing this bill" D KILLV G A1
S PRCABT=+^PRCA(430,PRCABN,100) G Q:'PRCABT!(PRCABT>3)
YN1 S %=1 W !," Review Bill" D YN^DICN
I %=0 W !,*7,"Answer 'Yes' or 'No' " G YN1
I %<1 W !,*7,"This bill will still remain Pending Approval Bill. ",!! D KILLV G A1
I %=1 S D0=PRCABN,IOP=0 D ^PRCABD I $P($G(^PRCA(430,PRCABN,3)),U,3) D
.N X,X1 S X=$P($G(^(3)),U,3,7),X1=$P(X,U) ;NAKED FROM ABOVE LINE
.W !,?28,"****AMENDED BILL INFO****"
.W !,"Amended Date: ",$E(X1,4,5),"/",$E(X1,6,7),"/",$E(X1,2,3)
.W ?50,"Amended Amount: ",$P(X,U,3),!
.S X=$P(X,U,5),DIWL=10,DIWR=65,DIWF="W" D ^DIWP,^DIWW
.Q
YN S %=2 W !," Approve this Bill" D YN^DICN
I %=0 W !,*7,"Answer 'Yes' or 'No' " G YN
I %=-1!(%=2) W !,*7,"This bill will still remain Pending Approval Bill.",!! D KILLV G A1
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))
S PRCAX=+DUZ_"^"_X_"^^"_$S($D(^VA(200,+DUZ,20)):$P(^(20),U,3),1:"") D NOW^%DTC S $P(PRCAX,"^",3)=%
S ^PRCA(430,PRCABN,104)=PRCAX,PRCA("STATUS")=$O(^PRCA(430.3,"AC",104,0)),PRCA("SDT")=DT
I $P($G(^PRCA(430,PRCABN,9)),U,6)=$O(^PRCA(430.3,"AC",230,"")) S PRCA("STATUS")=$O(^PRCA(430.3,"AC",110,""))
D UPSTATS^PRCAUT2 K PRCA("STATUS"),PRCA("SDT") W !,"*** This bill has been released to the AR section ***",!
I PRCABT=3 G A1 ;Don't print 1114 form
ANW S %=1 W !,"Do you want to print a copy of this bill for your records " D YN^DICN G:(%<0)!(%=2) A1
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
K ZTSAVE S D0=PRCABN,PRCADFM=1,PRCARN="^PRCABP"_PRCABT,ZTSAVE("D0")="",ZTSAVE("PRCADFM")="" D OPENDV^PRCABPF D KILLV G A1
KILLV L -^PRCA(430,+$G(PRCABN),0)
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
Q D KILLV K PRCA Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCABIL3 2552 printed Dec 13, 2024@01:39:01 Page 2
PRCABIL3 ;SF-ISC/YJK-APPROVE BILL ;10/7/93 2:54 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
APPRV ;APPROVE BILL
+1 SET DA=1
DO SIG^PRCASIG
if '$DATA(PRCANM)
QUIT
A1 DO SVC^PRCABIL
if '$DATA(PRCAP("S"))
GOTO Q
SET 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")
+1 SET PRCATIME=DTIME
SET DTIME=60
DO BILLN^PRCAUTL
SET DTIME=PRCATIME
if '$DATA(PRCABN)
GOTO Q
+2 LOCK +^PRCA(430,PRCABN,0):0
IF '$TEST
WRITE !,*7,"Another user is editing this bill"
DO KILLV
GOTO A1
+3 SET PRCABT=+^PRCA(430,PRCABN,100)
if 'PRCABT!(PRCABT>3)
GOTO Q
YN1 SET %=1
WRITE !," Review Bill"
DO YN^DICN
+1 IF %=0
WRITE !,*7,"Answer 'Yes' or 'No' "
GOTO YN1
+2 IF %<1
WRITE !,*7,"This bill will still remain Pending Approval Bill. ",!!
DO KILLV
GOTO A1
+3 IF %=1
SET D0=PRCABN
SET IOP=0
DO ^PRCABD
IF $PIECE($GET(^PRCA(430,PRCABN,3)),U,3)
Begin DoDot:1
+4 ;NAKED FROM ABOVE LINE
NEW X,X1
SET X=$PIECE($GET(^(3)),U,3,7)
SET X1=$PIECE(X,U)
+5 WRITE !,?28,"****AMENDED BILL INFO****"
+6 WRITE !,"Amended Date: ",$EXTRACT(X1,4,5),"/",$EXTRACT(X1,6,7),"/",$EXTRACT(X1,2,3)
+7 WRITE ?50,"Amended Amount: ",$PIECE(X,U,3),!
+8 SET X=$PIECE(X,U,5)
SET DIWL=10
SET DIWR=65
SET DIWF="W"
DO ^DIWP
DO ^DIWW
+9 QUIT
End DoDot:1
YN SET %=2
WRITE !," Approve this Bill"
DO YN^DICN
+1 IF %=0
WRITE !,*7,"Answer 'Yes' or 'No' "
GOTO YN
+2 IF %=-1!(%=2)
WRITE !,*7,"This bill will still remain Pending Approval Bill.",!!
DO KILLV
GOTO A1
+3 SET DA=PRCABN
if '$DATA(DUZ)
GOTO Q
SET P=+DUZ
SET X=$SELECT($DATA(^VA(200,P,20)):$PIECE(^(20),U,2),1:"")
if X'=""
DO EN^PRCASIG(.X,P,DA_+$PIECE(^PRCA(430,DA,0),U,3))
+4 SET PRCAX=+DUZ_"^"_X_"^^"_$SELECT($DATA(^VA(200,+DUZ,20)):$PIECE(^(20),U,3),1:"")
DO NOW^%DTC
SET $PIECE(PRCAX,"^",3)=%
+5 SET ^PRCA(430,PRCABN,104)=PRCAX
SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",104,0))
SET PRCA("SDT")=DT
+6 IF $PIECE($GET(^PRCA(430,PRCABN,9)),U,6)=$ORDER(^PRCA(430.3,"AC",230,""))
SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",110,""))
+7 DO UPSTATS^PRCAUT2
KILL PRCA("STATUS"),PRCA("SDT")
WRITE !,"*** This bill has been released to the AR section ***",!
+8 ;Don't print 1114 form
IF PRCABT=3
GOTO A1
ANW SET %=1
WRITE !,"Do you want to print a copy of this bill for your records "
DO YN^DICN
if (%<0)!(%=2)
GOTO A1
+1 IF %=0
WRITE !,"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.",!
GOTO ANW
+2 KILL ZTSAVE
SET D0=PRCABN
SET PRCADFM=1
SET PRCARN="^PRCABP"_PRCABT
SET ZTSAVE("D0")=""
SET ZTSAVE("PRCADFM")=""
DO OPENDV^PRCABPF
DO KILLV
GOTO A1
KILLV LOCK -^PRCA(430,+$GET(PRCABN),0)
+1 DO ^%ZISC
KILL %,%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
QUIT
Q DO KILLV
KILL PRCA
QUIT
