Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCABPF

PRCABPF.m

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