- 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 Jan 18, 2025@02:40:15 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