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

IBCNEKI2.m

Go to the documentation of this file. 
  1. IBCNEKI2 ;DAOU/BHS - PURGE eIV DATA FILES CONT'D ;11-JUL-2002
  1.  ;;2.0;INTEGRATED BILLING;**271,316,416,595**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; This routine holds additional procedures for purging the eIV data
  1.  ; from the Trans Queue file (365.1) and the Response file (365).
  1.  ;
  1.  ; ---------------------------------------------------
  1. MMPURGE ; This procedure is responsible for the creation and
  1.  ; sending of the MailMan message on the first day of the month
  1.  ; if the site has data eligible to be purged and if the mail group is
  1.  ; defined appropriately in the eIV site parameters.
  1.  ; Identify records eligible to be purged
  1.  ;
  1.  ; IB*595 Added Automated purge logic
  1.  D EN1^IBCNEKIT
  1.  G MMPURGX
  1.  ;
  1.  ;IB*595 - The following mail message is currently not required.  Code left in case eIns Team wants to bring it back
  1.  NEW ENDDT,STATLIST,DATE,TQIEN,TOTTQ,PURTQ,TQS
  1.  NEW HLIEN,RPIEN,RPS,TOTRP,PURRP,MSG,MGRP
  1.  ;
  1.  ; default end date, Today minus 182 days (approx 6 months)
  1.  S ENDDT=$$FMADD^XLFDT(DT,-182)
  1.  S (TOTTQ,PURTQ,TOTRP,PURRP)=0
  1.  ;
  1.  ; This is the list of statuses that are OK to purge
  1.  ;   3=Response Received
  1.  ;   5=Communication Failure
  1.  ;   7=Cancelled
  1.  S STATLIST=",3,5,7,"
  1.  ;
  1.  S DATE=""
  1.  F  S DATE=$O(^IBCN(365.1,"AE",DATE)) Q:'DATE  S TQIEN=0 F  S TQIEN=$O(^IBCN(365.1,"AE",DATE,TQIEN)) Q:'TQIEN  S TOTTQ=TOTTQ+1 I $P(DATE,".")'>ENDDT D
  1.  . S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4)    ; status
  1.  . I '$F(STATLIST,","_TQS_",") Q
  1.  . S PURTQ=PURTQ+1
  1.  . ; Loop thru responses to count them, too
  1.  . S HLIEN=0
  1.  . F  S HLIEN=$O(^IBCN(365.1,TQIEN,2,HLIEN)) Q:'HLIEN  D
  1.  . .  I $P($G(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3) S PURRP=PURRP+1
  1.  ;
  1.  S DATE=""
  1.  F  S DATE=$O(^IBCN(365,"AE",DATE)) Q:'DATE  S RPIEN=0 F  S RPIEN=$O(^IBCN(365,"AE",DATE,RPIEN)) Q:'RPIEN  S TOTRP=TOTRP+1 I $P(DATE,".")'>ENDDT D
  1.  . I $P($G(^IBCN(365,RPIEN,0)),U,5) Q    ; include only unsolicited
  1.  . S PURRP=PURRP+1
  1.  ;
  1.  ; Do not send message if no records are eligible
  1.  I 'PURTQ,'PURRP G MMPURGX
  1.  ;
  1.  ; Send a MailMan message with Eligible Purge counts
  1.  S MSG(1)="ATTENTION IRM:  There are eIV TRANSMISSION QUEUE and"
  1.  S MSG(2)="eIV RESPONSE records eligible to be purged."
  1.  S MSG(3)=""
  1.  S MSG(4)="File                                  Eligible   Total  "
  1.  S MSG(5)="                                       Count     Count  "
  1.  S MSG(6)="------------------------------------  --------  --------"
  1.  S MSG(7)="eIV RESPONSE FILE (#365)              "_$J(PURRP,8)_"  "_$J(TOTRP,8)
  1.  S MSG(8)="eIV TRANSMISSION QUEUE FILE (#365.1)  "_$J(PURTQ,8)_"  "_$J(TOTTQ,8)
  1.  S MSG(9)="====================================  ========  ========"
  1.  S MSG(10)="Total                                 "_$J(PURTQ+PURRP,8)_"  "_$J(TOTTQ+TOTRP,8)
  1.  S MSG(11)=""
  1.  S MSG(12)="Please run option IBCNE PURGE IIV DATA - Purge eIV Transactions,"
  1.  S MSG(13)="if you would like to purge the eligible records."
  1.  ; Set to IB site parameter MAILGROUP
  1.  S MGRP=$$MGRP^IBCNEUT5()
  1.  D MSG^IBCNEUT5(MGRP,"eIV Data Eligible for Purge","MSG(")
  1.  ;
  1. MMPURGX ;
  1.  Q
  1.  ;