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