IBCNEKI2 ;DAOU/BHS - PURGE eIV DATA FILES CONT'D ;11-JUL-2002
;;2.0;INTEGRATED BILLING;**271,316,416,595**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine holds additional procedures for purging the eIV data
; from the Trans Queue file (365.1) and the Response file (365).
;
; ---------------------------------------------------
MMPURGE ; This procedure is responsible for the creation and
; sending of the MailMan message on the first day of the month
; if the site has data eligible to be purged and if the mail group is
; defined appropriately in the eIV site parameters.
; Identify records eligible to be purged
;
; IB*595 Added Automated purge logic
D EN1^IBCNEKIT
G MMPURGX
;
;IB*595 - The following mail message is currently not required. Code left in case eIns Team wants to bring it back
NEW ENDDT,STATLIST,DATE,TQIEN,TOTTQ,PURTQ,TQS
NEW HLIEN,RPIEN,RPS,TOTRP,PURRP,MSG,MGRP
;
; default end date, Today minus 182 days (approx 6 months)
S ENDDT=$$FMADD^XLFDT(DT,-182)
S (TOTTQ,PURTQ,TOTRP,PURRP)=0
;
; This is the list of statuses that are OK to purge
; 3=Response Received
; 5=Communication Failure
; 7=Cancelled
S STATLIST=",3,5,7,"
;
S DATE=""
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
. S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4) ; status
. I '$F(STATLIST,","_TQS_",") Q
. S PURTQ=PURTQ+1
. ; Loop thru responses to count them, too
. S HLIEN=0
. F S HLIEN=$O(^IBCN(365.1,TQIEN,2,HLIEN)) Q:'HLIEN D
. . I $P($G(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3) S PURRP=PURRP+1
;
S DATE=""
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
. I $P($G(^IBCN(365,RPIEN,0)),U,5) Q ; include only unsolicited
. S PURRP=PURRP+1
;
; Do not send message if no records are eligible
I 'PURTQ,'PURRP G MMPURGX
;
; Send a MailMan message with Eligible Purge counts
S MSG(1)="ATTENTION IRM: There are eIV TRANSMISSION QUEUE and"
S MSG(2)="eIV RESPONSE records eligible to be purged."
S MSG(3)=""
S MSG(4)="File Eligible Total "
S MSG(5)=" Count Count "
S MSG(6)="------------------------------------ -------- --------"
S MSG(7)="eIV RESPONSE FILE (#365) "_$J(PURRP,8)_" "_$J(TOTRP,8)
S MSG(8)="eIV TRANSMISSION QUEUE FILE (#365.1) "_$J(PURTQ,8)_" "_$J(TOTTQ,8)
S MSG(9)="==================================== ======== ========"
S MSG(10)="Total "_$J(PURTQ+PURRP,8)_" "_$J(TOTTQ+TOTRP,8)
S MSG(11)=""
S MSG(12)="Please run option IBCNE PURGE IIV DATA - Purge eIV Transactions,"
S MSG(13)="if you would like to purge the eligible records."
; Set to IB site parameter MAILGROUP
S MGRP=$$MGRP^IBCNEUT5()
D MSG^IBCNEUT5(MGRP,"eIV Data Eligible for Purge","MSG(")
;
MMPURGX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEKI2 3093 printed Apr 09, 2024@21:28:27 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine holds additional procedures for purging the eIV data
+5 ; from the Trans Queue file (365.1) and the Response file (365).
+6 ;
+7 ; ---------------------------------------------------
MMPURGE ; This procedure is responsible for the creation and
+1 ; sending of the MailMan message on the first day of the month
+2 ; if the site has data eligible to be purged and if the mail group is
+3 ; defined appropriately in the eIV site parameters.
+4 ; Identify records eligible to be purged
+5 ;
+6 ; IB*595 Added Automated purge logic
+7 DO EN1^IBCNEKIT
+8 GOTO MMPURGX
+9 ;
+10 ;IB*595 - The following mail message is currently not required. Code left in case eIns Team wants to bring it back
+11 NEW ENDDT,STATLIST,DATE,TQIEN,TOTTQ,PURTQ,TQS
+12 NEW HLIEN,RPIEN,RPS,TOTRP,PURRP,MSG,MGRP
+13 ;
+14 ; default end date, Today minus 182 days (approx 6 months)
+15 SET ENDDT=$$FMADD^XLFDT(DT,-182)
+16 SET (TOTTQ,PURTQ,TOTRP,PURRP)=0
+17 ;
+18 ; This is the list of statuses that are OK to purge
+19 ; 3=Response Received
+20 ; 5=Communication Failure
+21 ; 7=Cancelled
+22 SET STATLIST=",3,5,7,"
+23 ;
+24 SET DATE=""
+25 FOR
SET DATE=$ORDER(^IBCN(365.1,"AE",DATE))
if 'DATE
QUIT
SET TQIEN=0
FOR
SET TQIEN=$ORDER(^IBCN(365.1,"AE",DATE,TQIEN))
if 'TQIEN
QUIT
SET TOTTQ=TOTTQ+1
IF $PIECE(DATE,".")'>ENDDT
Begin DoDot:1
+26 ; status
SET TQS=$PIECE($GET(^IBCN(365.1,TQIEN,0)),U,4)
+27 IF '$FIND(STATLIST,","_TQS_",")
QUIT
+28 SET PURTQ=PURTQ+1
+29 ; Loop thru responses to count them, too
+30 SET HLIEN=0
+31 FOR
SET HLIEN=$ORDER(^IBCN(365.1,TQIEN,2,HLIEN))
if 'HLIEN
QUIT
Begin DoDot:2
+32 IF $PIECE($GET(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3)
SET PURRP=PURRP+1
End DoDot:2
End DoDot:1
+33 ;
+34 SET DATE=""
+35 FOR
SET DATE=$ORDER(^IBCN(365,"AE",DATE))
if 'DATE
QUIT
SET RPIEN=0
FOR
SET RPIEN=$ORDER(^IBCN(365,"AE",DATE,RPIEN))
if 'RPIEN
QUIT
SET TOTRP=TOTRP+1
IF $PIECE(DATE,".")'>ENDDT
Begin DoDot:1
+36 ; include only unsolicited
IF $PIECE($GET(^IBCN(365,RPIEN,0)),U,5)
QUIT
+37 SET PURRP=PURRP+1
End DoDot:1
+38 ;
+39 ; Do not send message if no records are eligible
+40 IF 'PURTQ
IF 'PURRP
GOTO MMPURGX
+41 ;
+42 ; Send a MailMan message with Eligible Purge counts
+43 SET MSG(1)="ATTENTION IRM: There are eIV TRANSMISSION QUEUE and"
+44 SET MSG(2)="eIV RESPONSE records eligible to be purged."
+45 SET MSG(3)=""
+46 SET MSG(4)="File Eligible Total "
+47 SET MSG(5)=" Count Count "
+48 SET MSG(6)="------------------------------------ -------- --------"
+49 SET MSG(7)="eIV RESPONSE FILE (#365) "_$JUSTIFY(PURRP,8)_" "_$JUSTIFY(TOTRP,8)
+50 SET MSG(8)="eIV TRANSMISSION QUEUE FILE (#365.1) "_$JUSTIFY(PURTQ,8)_" "_$JUSTIFY(TOTTQ,8)
+51 SET MSG(9)="==================================== ======== ========"
+52 SET MSG(10)="Total "_$JUSTIFY(PURTQ+PURRP,8)_" "_$JUSTIFY(TOTTQ+TOTRP,8)
+53 SET MSG(11)=""
+54 SET MSG(12)="Please run option IBCNE PURGE IIV DATA - Purge eIV Transactions,"
+55 SET MSG(13)="if you would like to purge the eligible records."
+56 ; Set to IB site parameter MAILGROUP
+57 SET MGRP=$$MGRP^IBCNEUT5()
+58 DO MSG^IBCNEUT5(MGRP,"eIV Data Eligible for Purge","MSG(")
+59 ;
MMPURGX ;
+1 QUIT
+2 ;
