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

IBECPF.m

Go to the documentation of this file.
  1. IBECPF ;ALB/RLW - IB FLAG/UNFLAG CONTINUOUS PATIENTS ; 1-JAN-92
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. EN ;
  1. ;***
  1. ;S XRTL=$ZU(0),XRTN="IBECPF-1" D T0^%ZOSV ;start rt clock
  1. D DT^DICRW S IBDATE=%
  1. S DIC="^IBE(351.1,",DIC(0)="AELMQZ",DLAYGO=351.1,DIC("A")="Select PATIENT: " D ^DIC K DIC
  1. G:+Y<0 ENQ
  1. I $P(Y,"^",3)=1 S DR=".02;.03////"_DUZ_";.04////"_IBDATE
  1. E S DR=".01;.02;.05////"_DUZ_";.06////"_IBDATE
  1. S DIE="^IBE(351.1,",DA=+Y,DIDEL=351.1 D ^DIE K DIE,DA,DR,Y,DIDEL
  1. ENQ ;
  1. K IBDATE
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBECPF" D T1^%ZOSV ;stop rt clock
  1. Q