source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCABPF.m@ 1094

Last change on this file since 1094 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1PRCABPF ;SF-ISC/YJK-PRINT BILL FORMS ;7/22/93 1:40 PM
2V ;;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.
5OPENDV 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
8EN2 ;Print 1080 and 1081.
9 S PRCARN="EN21^PRCABPF" K ZTSAVE D OPENDV K PRCARN,ZTRTN Q
10EN21 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
12EN 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
15KILLV ;
16END K BT,PRCAMEND,PRCANEWB,PRCA,PRCAK,PRCABPF,PRCAROUT Q
17EN3 ;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
22EX Q
Note: See TracBrowser for help on using the repository browser.