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

RCEVDRV1.m

Go to the documentation of this file.
  1. RCEVDRV1 ;WASH-ISC@ALTOONA,PA/RGY-Add event to enter file driver #1 ;7/7/95 11:01 AM
  1. V ;;4.5;Accounts Receivable;**10**;Mar 20, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. OPEN(TYPE,DEB,DOE,RCDUZ,SITE,ERROR,EVN,BAL) ;Add new event to event file
  1. NEW DIC,D0,DIE,DA,X,DLAYGO,DR,DEBT,EVENT,DIS,RCOK
  1. S DEBT=$$DEBT^RCEVUTL(DEB),ERROR="",EVN=-1
  1. I DEBT<0 S ERROR="Unable to locate or add Debtor '"_DEB_"' (PRCADRV1)" G Q
  1. I $O(^RC(341,"AC",DEBT,0,0)) S EVN=0 F S EVN=$O(^RC(341,"AC",DEBT,0,EVN)) Q:EVN="" D DEL(EVN)
  1. F EVN=+$P(^RC(341,0),"^",3)+1:1 L +^RC(341,EVN):0 I $T S RCOK=0 D L -^RC(341,EVN) Q:RCOK
  1. .I $D(^RC(341,EVN)) Q
  1. .S DINUM=EVN,DIC="^RC(341,",DIC(0)="L",DLAYGO=341,X=SITE_"-"_EVN_"-0" K DD,DO D FILE^DICN K DIC,DLAYGO,DO
  1. .S DIE="^RC(341,",DR="[RCEV OPEN EVENT]",DA=EVN D ^DIE
  1. .S RCOK=1
  1. .Q
  1. Q Q
  1. CLOSE(EVN,ERR) ;Close event
  1. S DIE="^RC(341,",DR="[RCEV CLOSE EVENT]",DA=EVN D ^DIE
  1. Q
  1. DEL(EVN) ;Delete event
  1. NEW DIK,DA
  1. I $P($G(^RC(341,EVN,0)),"^",11)=1 G Q2
  1. S DA=EVN,DIK="^RC(341," D ^DIK
  1. Q2 Q
  1. PUR ;Purge events
  1. NEW DATE,EVN,EVN2,DEBT,LST,N0,PURDT
  1. S DATE=0,EVN2=""
  1. F S DATE=$O(^RC(341,"C",DATE)) Q:'DATE S EVN=0 F S EVN=$O(^RC(341,"C",DATE,EVN)) Q:'EVN D
  1. .S N0=$G(^RC(341,EVN,0)) Q:N0=""
  1. .S DEBT=$P(N0,"^",5) Q:DEBT=""
  1. .S LST=$O(^RC(341,"AD",DEBT,2,"")) Q:LST=""
  1. .S PURDT=$O(^RC(341,"AD",DEBT,2,LST)) Q:PURDT=""
  1. .S EVN2=$O(^RC(341,"AD",DEBT,2,PURDT,EVN2)) Q:EVN2=""!(EVN=EVN2)
  1. .S PURDT=9999999.999999-PURDT
  1. .Q:DATE>PURDT
  1. .I $P(N0,"^",7)<PURDT,$P(N0,"^",2)'=$O(^RC(341.1,"AC",1,0)),EVN'=$P($$LST^RCFN01($P(N0,"^",5),2),"^",2) S DA=EVN,DIK="^RC(341," D ^DIK
  1. .Q
  1. Q