- RCEVDRV1 ;WASH-ISC@ALTOONA,PA/RGY-Add event to enter file driver #1 ;7/7/95 11:01 AM
- V ;;4.5;Accounts Receivable;**10**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- OPEN(TYPE,DEB,DOE,RCDUZ,SITE,ERROR,EVN,BAL) ;Add new event to event file
- NEW DIC,D0,DIE,DA,X,DLAYGO,DR,DEBT,EVENT,DIS,RCOK
- S DEBT=$$DEBT^RCEVUTL(DEB),ERROR="",EVN=-1
- I DEBT<0 S ERROR="Unable to locate or add Debtor '"_DEB_"' (PRCADRV1)" G Q
- 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)
- 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
- .I $D(^RC(341,EVN)) Q
- .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
- .S DIE="^RC(341,",DR="[RCEV OPEN EVENT]",DA=EVN D ^DIE
- .S RCOK=1
- .Q
- Q Q
- CLOSE(EVN,ERR) ;Close event
- S DIE="^RC(341,",DR="[RCEV CLOSE EVENT]",DA=EVN D ^DIE
- Q
- DEL(EVN) ;Delete event
- NEW DIK,DA
- I $P($G(^RC(341,EVN,0)),"^",11)=1 G Q2
- S DA=EVN,DIK="^RC(341," D ^DIK
- Q2 Q
- PUR ;Purge events
- NEW DATE,EVN,EVN2,DEBT,LST,N0,PURDT
- S DATE=0,EVN2=""
- 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
- .S N0=$G(^RC(341,EVN,0)) Q:N0=""
- .S DEBT=$P(N0,"^",5) Q:DEBT=""
- .S LST=$O(^RC(341,"AD",DEBT,2,"")) Q:LST=""
- .S PURDT=$O(^RC(341,"AD",DEBT,2,LST)) Q:PURDT=""
- .S EVN2=$O(^RC(341,"AD",DEBT,2,PURDT,EVN2)) Q:EVN2=""!(EVN=EVN2)
- .S PURDT=9999999.999999-PURDT
- .Q:DATE>PURDT
- .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
- .Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCEVDRV1 1660 printed Jan 18, 2025@02:47:59 Page 2
- RCEVDRV1 ;WASH-ISC@ALTOONA,PA/RGY-Add event to enter file driver #1 ;7/7/95 11:01 AM
- V ;;4.5;Accounts Receivable;**10**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- +2 SET DEBT=$$DEBT^RCEVUTL(DEB)
- SET ERROR=""
- SET EVN=-1
- +3 IF DEBT<0
- SET ERROR="Unable to locate or add Debtor '"_DEB_"' (PRCADRV1)"
- GOTO Q
- +4 IF $ORDER(^RC(341,"AC",DEBT,0,0))
- SET EVN=0
- FOR
- SET EVN=$ORDER(^RC(341,"AC",DEBT,0,EVN))
- if EVN=""
- QUIT
- DO DEL(EVN)
- +5 FOR EVN=+$PIECE(^RC(341,0),"^",3)+1:1
- LOCK +^RC(341,EVN):0
- IF $TEST
- SET RCOK=0
- Begin DoDot:1
- +6 IF $DATA(^RC(341,EVN))
- QUIT
- +7 SET DINUM=EVN
- SET DIC="^RC(341,"
- SET DIC(0)="L"
- SET DLAYGO=341
- SET X=SITE_"-"_EVN_"-0"
- KILL DD,DO
- DO FILE^DICN
- KILL DIC,DLAYGO,DO
- +8 SET DIE="^RC(341,"
- SET DR="[RCEV OPEN EVENT]"
- SET DA=EVN
- DO ^DIE
- +9 SET RCOK=1
- +10 QUIT
- End DoDot:1
- LOCK -^RC(341,EVN)
- if RCOK
- QUIT
- Q QUIT
- CLOSE(EVN,ERR) ;Close event
- +1 SET DIE="^RC(341,"
- SET DR="[RCEV CLOSE EVENT]"
- SET DA=EVN
- DO ^DIE
- +2 QUIT
- DEL(EVN) ;Delete event
- +1 NEW DIK,DA
- +2 IF $PIECE($GET(^RC(341,EVN,0)),"^",11)=1
- GOTO Q2
- +3 SET DA=EVN
- SET DIK="^RC(341,"
- DO ^DIK
- Q2 QUIT
- PUR ;Purge events
- +1 NEW DATE,EVN,EVN2,DEBT,LST,N0,PURDT
- +2 SET DATE=0
- SET EVN2=""
- +3 FOR
- SET DATE=$ORDER(^RC(341,"C",DATE))
- if 'DATE
- QUIT
- SET EVN=0
- FOR
- SET EVN=$ORDER(^RC(341,"C",DATE,EVN))
- if 'EVN
- QUIT
- Begin DoDot:1
- +4 SET N0=$GET(^RC(341,EVN,0))
- if N0=""
- QUIT
- +5 SET DEBT=$PIECE(N0,"^",5)
- if DEBT=""
- QUIT
- +6 SET LST=$ORDER(^RC(341,"AD",DEBT,2,""))
- if LST=""
- QUIT
- +7 SET PURDT=$ORDER(^RC(341,"AD",DEBT,2,LST))
- if PURDT=""
- QUIT
- +8 SET EVN2=$ORDER(^RC(341,"AD",DEBT,2,PURDT,EVN2))
- if EVN2=""!(EVN=EVN2)
- QUIT
- +9 SET PURDT=9999999.999999-PURDT
- +10 if DATE>PURDT
- QUIT
- +11 IF $PIECE(N0,"^",7)<PURDT
- IF $PIECE(N0,"^",2)'=$ORDER(^RC(341.1,"AC",1,0))
- IF EVN'=$PIECE($$LST^RCFN01($PIECE(N0,"^",5),2),"^",2)
- SET DA=EVN
- SET DIK="^RC(341,"
- DO ^DIK
- +12 QUIT
- End DoDot:1
- +13 QUIT