IBCNIUK ;AITC/TAZ - Interfacility Ins Purge;29-OCT-2020
;;2.0;INTEGRATED BILLING;**687**; 21-MAR-94;Build 88
;;Per VA Directive 6402, this routine should not be modified.
;
; Variables:
;CDAYS - Number of Days to retain Candidate Entries (#350.9,53.06)
;SDAYS - Number of Days to retain Sent entries. (#350.9,53.05)
;RDAYS - Number of Days to retain Received Entries (#350.9,53.07)
;
Q
EN ;entry point
N BDATE,CDAYS,DA,DATE,DIE,DIK,DR,EDATE,IEN,IENS,RDAYS,SDAYS,SDATE,SENT,STATUS,VIEN
;
S SDAYS=$$GET1^DIQ(350.9,"1,",53.05)+1
S CDAYS=$$GET1^DIQ(350.9,"1,",53.06)+1
S RDAYS=$$GET1^DIQ(350.9,"1,",53.07)+1
;
;Process Candidate SENDER entries
S DATE="",EDATE=$$FMADD^XLFDT(DT,-CDAYS)
F S DATE=$O(^IBCN(365.19,"DIR","S",DATE)) Q:'DATE D
. S IEN=""
. F S IEN=$O(^IBCN(365.19,"DIR","S",DATE,IEN)) Q:'IEN D
. . I $P(DATE,".")>EDATE Q
. . ;file 365.19, field 1.01 SENDER STATUS
. . S STATUS=$$GET1^DIQ(365.19,IEN,1.01)
. . I STATUS="COMPLETE" Q
. . I (STATUS="WAITING")!(STATUS["FAILED") D Q
. . . S DIK="^IBCN(365.19,",DA=IEN D ^DIK K DA,DIK
. . S (SENT,VIEN)=0
. . F S VIEN=$O(^IBCN(365.19,IEN,1.1,VIEN)) Q:'VIEN D
. . . S DA=VIEN,DA(1)=IEN
. . . S IENS=VIEN_","_IEN_","
. . . ;Check SENT STATUS, purge "READY TO SEND" entries.
. . . I $$GET1^DIQ(365.191,IENS,.02)="READY TO SEND" D
. . . . S DIK="^IBCN(365.19,"_DA(1)_",1.1," D ^DIK K DA,DIK
. . . I $$GET1^DIQ(365.191,IENS,.02)="SENT" S SENT=1
. . ;If SENT, update STATUS to "COMPLETE"
. . I SENT S DIE=365.19,DR="1.01///COMPLETE",DA=IEN D ^DIE K DA,DIE,DR
;
; Clean up the SENDER 'COMPLETE' entries
S DATE="",EDATE=$$FMADD^XLFDT(DT,-SDAYS)
F S DATE=$O(^IBCN(365.19,"DIR","S",DATE)) Q:'DATE D
. S IEN=""
. F S IEN=$O(^IBCN(365.19,"DIR","S",DATE,IEN)) Q:'IEN D
. . S STATUS=$$GET1^DIQ(365.19,IEN,1.01)
. . I STATUS'="COMPLETE" Q
. . S VIEN=0
. . F S VIEN=$O(^IBCN(365.19,IEN,1.1,VIEN)) Q:'VIEN D
. . . S DA=VIEN,DA(1)=IEN
. . . S IENS=VIEN_","_IEN_","
. . . ;Use SENT STATUS DATE/TIME to compare against EDATE
. . . S SDATE=$P($$GET1^DIQ(365.191,IENS,.03,"I"),".")
. . . I SDATE>EDATE Q
. . . S DA=IEN,DIK="^IBCN(365.19," D ^DIK K DA,DIK
;
;Process RECEIVER entries
S DATE="",EDATE=$$FMADD^XLFDT(DT,-RDAYS)
F S DATE=$O(^IBCN(365.19,"DIR","R",DATE)) Q:'DATE D
. I DATE>EDATE Q ;Compare against the date received (aka create date)
. S IEN=0
. F S IEN=$O(^IBCN(365.19,"DIR","R",DATE,IEN)) Q:'IEN D
. . S DIK="^IBCN(365.19,",DA=IEN D ^DIK K DA,DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNIUK 2538 printed Nov 22, 2024@17:26:05 Page 2
IBCNIUK ;AITC/TAZ - Interfacility Ins Purge;29-OCT-2020
+1 ;;2.0;INTEGRATED BILLING;**687**; 21-MAR-94;Build 88
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Variables:
+5 ;CDAYS - Number of Days to retain Candidate Entries (#350.9,53.06)
+6 ;SDAYS - Number of Days to retain Sent entries. (#350.9,53.05)
+7 ;RDAYS - Number of Days to retain Received Entries (#350.9,53.07)
+8 ;
+9 QUIT
EN ;entry point
+1 NEW BDATE,CDAYS,DA,DATE,DIE,DIK,DR,EDATE,IEN,IENS,RDAYS,SDAYS,SDATE,SENT,STATUS,VIEN
+2 ;
+3 SET SDAYS=$$GET1^DIQ(350.9,"1,",53.05)+1
+4 SET CDAYS=$$GET1^DIQ(350.9,"1,",53.06)+1
+5 SET RDAYS=$$GET1^DIQ(350.9,"1,",53.07)+1
+6 ;
+7 ;Process Candidate SENDER entries
+8 SET DATE=""
SET EDATE=$$FMADD^XLFDT(DT,-CDAYS)
+9 FOR
SET DATE=$ORDER(^IBCN(365.19,"DIR","S",DATE))
if 'DATE
QUIT
Begin DoDot:1
+10 SET IEN=""
+11 FOR
SET IEN=$ORDER(^IBCN(365.19,"DIR","S",DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+12 IF $PIECE(DATE,".")>EDATE
QUIT
+13 ;file 365.19, field 1.01 SENDER STATUS
+14 SET STATUS=$$GET1^DIQ(365.19,IEN,1.01)
+15 IF STATUS="COMPLETE"
QUIT
+16 IF (STATUS="WAITING")!(STATUS["FAILED")
Begin DoDot:3
+17 SET DIK="^IBCN(365.19,"
SET DA=IEN
DO ^DIK
KILL DA,DIK
End DoDot:3
QUIT
+18 SET (SENT,VIEN)=0
+19 FOR
SET VIEN=$ORDER(^IBCN(365.19,IEN,1.1,VIEN))
if 'VIEN
QUIT
Begin DoDot:3
+20 SET DA=VIEN
SET DA(1)=IEN
+21 SET IENS=VIEN_","_IEN_","
+22 ;Check SENT STATUS, purge "READY TO SEND" entries.
+23 IF $$GET1^DIQ(365.191,IENS,.02)="READY TO SEND"
Begin DoDot:4
+24 SET DIK="^IBCN(365.19,"_DA(1)_",1.1,"
DO ^DIK
KILL DA,DIK
End DoDot:4
+25 IF $$GET1^DIQ(365.191,IENS,.02)="SENT"
SET SENT=1
End DoDot:3
+26 ;If SENT, update STATUS to "COMPLETE"
+27 IF SENT
SET DIE=365.19
SET DR="1.01///COMPLETE"
SET DA=IEN
DO ^DIE
KILL DA,DIE,DR
End DoDot:2
End DoDot:1
+28 ;
+29 ; Clean up the SENDER 'COMPLETE' entries
+30 SET DATE=""
SET EDATE=$$FMADD^XLFDT(DT,-SDAYS)
+31 FOR
SET DATE=$ORDER(^IBCN(365.19,"DIR","S",DATE))
if 'DATE
QUIT
Begin DoDot:1
+32 SET IEN=""
+33 FOR
SET IEN=$ORDER(^IBCN(365.19,"DIR","S",DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+34 SET STATUS=$$GET1^DIQ(365.19,IEN,1.01)
+35 IF STATUS'="COMPLETE"
QUIT
+36 SET VIEN=0
+37 FOR
SET VIEN=$ORDER(^IBCN(365.19,IEN,1.1,VIEN))
if 'VIEN
QUIT
Begin DoDot:3
+38 SET DA=VIEN
SET DA(1)=IEN
+39 SET IENS=VIEN_","_IEN_","
+40 ;Use SENT STATUS DATE/TIME to compare against EDATE
+41 SET SDATE=$PIECE($$GET1^DIQ(365.191,IENS,.03,"I"),".")
+42 IF SDATE>EDATE
QUIT
+43 SET DA=IEN
SET DIK="^IBCN(365.19,"
DO ^DIK
KILL DA,DIK
End DoDot:3
End DoDot:2
End DoDot:1
+44 ;
+45 ;Process RECEIVER entries
+46 SET DATE=""
SET EDATE=$$FMADD^XLFDT(DT,-RDAYS)
+47 FOR
SET DATE=$ORDER(^IBCN(365.19,"DIR","R",DATE))
if 'DATE
QUIT
Begin DoDot:1
+48 ;Compare against the date received (aka create date)
IF DATE>EDATE
QUIT
+49 SET IEN=0
+50 FOR
SET IEN=$ORDER(^IBCN(365.19,"DIR","R",DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+51 SET DIK="^IBCN(365.19,"
SET DA=IEN
DO ^DIK
KILL DA,DIK
End DoDot:2
End DoDot:1
+52 QUIT
