PRCABPF ;SF-ISC/YJK-PRINT BILL FORMS ;7/22/93  1:40 PM
V ;;4.5;Accounts Receivable;**99**;Mar 20, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;Print the new bills generated by services - 1114,1080,1081.
OPENDV K POP S %ZIS="QM" D ^%ZIS Q:POP  I IO=IO("0") W:$D(IOF) @IOF D @PRCARN,^%ZISC Q
 I $D(IO("Q")) K IO("Q") S ZTRTN=PRCARN D ^%ZTLOAD,^%ZISC K ZTSAVE,ZTRTN,ZTDTH Q
 U IO D @PRCARN D ^%ZISC K %ZIS Q
EN2 ;Print 1080 and 1081.
 S PRCARN="EN21^PRCABPF" K ZTSAVE D OPENDV K PRCARN,ZTRTN Q
EN21 S PRCANEWB=+$O(^PRCA(430.3,"AC",104,0)) Q:PRCANEWB'>0  D EN
 S PRCANEWB=+$O(^PRCA(430.3,"AC",110,0)) Q:PRCANEWB'>0  S PRCAMEND="" D EN Q
EN S PRCABPF=0
 F PRCAK=0:0 S PRCABPF=$O(^PRCA(430,"AC",PRCANEWB,PRCABPF)) Q:PRCABPF=""  S BT=+$G(^PRCA(430,PRCABPF,100)) I BT=1!(BT=2) S D0=PRCABPF,PRCAROUT="^PRCABP"_BT D @PRCAROUT
 D KILLV Q
KILLV ;
END K BT,PRCAMEND,PRCANEWB,PRCA,PRCAK,PRCABPF,PRCAROUT Q
EN3 ;reprint 1080 and 1081.
 NEW BT,DIC,PRCABN,PRCA,PRCATY,ST,ZTSAVE,PRCARN,ZTRTN
 S DIC="^PRCA(430,",DIC(0)="AEQM",DIC("S")="S ST=+$P(^(0),U,8),BT=+$G(^(100)) I (BT=1!(BT=2)),ST>0,$D(^PRCA(430.3,ST,0)),$P(^(0),U,3)<200"
 D BILLN^PRCAUTL G:'$D(PRCABN) EX
 S D0=PRCABN,PRCARN="^PRCABP"_+^PRCA(430,D0,100) K ZTSAVE S ZTSAVE("D0")="" D OPENDV
EX Q