IBACCWLPURGE ;EDE/TAZ - ACC (Automated Community Care) Claims - Purge ; 20-MAR-2024
;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;Initialize Variables
;Loop through "CLOSED" (2) STATUS X-ref
;CLAIM NUMBER (#2.02) eXISTS?
; YES = REASONS NOT AUTOBILLED (#5) Exist?
; Yes = Manual
; No = Auto
; NO = Failed
;
EN ;Entry point from Option
N DIR
S DIR(0)="Y"
S DIR("A")="Do you want to continue?"
S DIR("A",1)="This will purge the Automated Community Care Encounter File"
S DIR("A",2)=""
S DIR("B")="N"
D ^DIR
I $D(DIRUT) G PURGEQ
I 'Y G PURGEQ
W !!,"Purging. Please stand by."
;
EN1 ; Entry point from scheduled
N CLAIM,IEN,FINALCLONE
;Loop though each encounter that is CLOSED
S IEN=0
F S IEN=$O(^IBA(364.9,"AD",2,IEN)) Q:'IEN D
. S CLAIM=$$GET1^DIQ(364.9,IEN_",",2.02,"I") ;IEN of File 399
. I 'CLAIM D PURGE("F") Q ;Failed to create claim
. S FINALCLONE=$$FINDCLONES(CLAIM) ;MJL;EBILL-6180
. I $$ACTIVE^IBJTU4(FINALCLONE) Q ;Claim is still active - drills down to find the last cloned version of this claim just to be safe ;MJL;EBILL-6180
. ;I $$ACTIVE^IBJTU4(CLAIM) Q ;Claim is still active
. I $$GET1^DIQ(364.95,"1,"_IEN_",",.01,"I") D PURGE("M") Q ; Billed after manual intervention
. D PURGE("A") ;Auto-generated claims
Q
;
PURGE(TYPE) ;Purge record based on Purge Time in IB Site Parameters
N CNT,DATE,DAYS,FIELD,IBVAR,STR
;
; S FIELD=$S(TYPE="F":277,TYPE="M":276,1:275)
; S DAYS=$$GET1^DIQ(350.9,"1,",FIELD) ; Number of days to wait before purge
S FIELD=$S(TYPE="F":"ACCFAILEDPUR",TYPE="M":"ACCMIPUR",1:"ACCAGPUR")
S IBVAR=$$FIND1^DIC(364.991,,"X",FIELD)
I IBVAR S DAYS=$$GET1^DIQ(364.991,IBVAR_",",.1) ;WCJ;V42;
Q:$G(DAYS)=""
;
S DATE=$$GET1^DIQ(364.9,IEN_",",.22,"I") ; STATUS DATE CHANGED
I $$FMADD^XLFDT(DATE,DAYS)>DT G PURGEQ ; Not eligible to purge
S CNT=0
F S CNT=$O(^IBA(364.9,IEN,1,CNT)) Q:'CNT S STR=^(CNT,0) D
. N DA,DR,DIE
. I $P(STR,"*",1,2)="REF*D9" Q ;Do not remove this node.
. S DIE="^IBA(364.9,"_IEN_",1,",DA=CNT,DA(1)=IEN,DR=".01///@"
. D ^DIE
;Update STATUS to PURGED
S DIE="^IBA(364.9,",DA=IEN,DR=".16///3"
D ^DIE
PURGEQ ;
Q
FINDCLONES(CLAIM) ;Find all the times this claim has been cloned, so we're only looking at the most recent one ;MJL;EBILL-6180
N STOP,LASTCLONE,CLONEDTO
I $$GET1^DIQ(399,CLAIM_",",29,"I")="" Q CLAIM ;There are no clones, no need to run this loop
S LASTCLONE=CLAIM
S STOP=""
F D Q:STOP=1
. S CLONEDTO=$$GET1^DIQ(399,LASTCLONE_",",29,"I")
. I CLONEDTO="" S STOP=1 Q ;Nothing left, take the last clone and exit
. S LASTCLONE=CLONEDTO
Q LASTCLONE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBACCWLPURGE 2751 printed May 25, 2026@12:10:03 Page 2
IBACCWLPURGE ;EDE/TAZ - ACC (Automated Community Care) Claims - Purge ; 20-MAR-2024
+1 ;;2.0;INTEGRATED BILLING;**770**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;Initialize Variables
+6 ;Loop through "CLOSED" (2) STATUS X-ref
+7 ;CLAIM NUMBER (#2.02) eXISTS?
+8 ; YES = REASONS NOT AUTOBILLED (#5) Exist?
+9 ; Yes = Manual
+10 ; No = Auto
+11 ; NO = Failed
+12 ;
EN ;Entry point from Option
+1 NEW DIR
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Do you want to continue?"
+4 SET DIR("A",1)="This will purge the Automated Community Care Encounter File"
+5 SET DIR("A",2)=""
+6 SET DIR("B")="N"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
GOTO PURGEQ
+9 IF 'Y
GOTO PURGEQ
+10 WRITE !!,"Purging. Please stand by."
+11 ;
EN1 ; Entry point from scheduled
+1 NEW CLAIM,IEN,FINALCLONE
+2 ;Loop though each encounter that is CLOSED
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(^IBA(364.9,"AD",2,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 ;IEN of File 399
SET CLAIM=$$GET1^DIQ(364.9,IEN_",",2.02,"I")
+6 ;Failed to create claim
IF 'CLAIM
DO PURGE("F")
QUIT
+7 ;MJL;EBILL-6180
SET FINALCLONE=$$FINDCLONES(CLAIM)
+8 ;Claim is still active - drills down to find the last cloned version of this claim just to be safe ;MJL;EBILL-6180
IF $$ACTIVE^IBJTU4(FINALCLONE)
QUIT
+9 ;I $$ACTIVE^IBJTU4(CLAIM) Q ;Claim is still active
+10 ; Billed after manual intervention
IF $$GET1^DIQ(364.95,"1,"_IEN_",",.01,"I")
DO PURGE("M")
QUIT
+11 ;Auto-generated claims
DO PURGE("A")
End DoDot:1
+12 QUIT
+13 ;
PURGE(TYPE) ;Purge record based on Purge Time in IB Site Parameters
+1 NEW CNT,DATE,DAYS,FIELD,IBVAR,STR
+2 ;
+3 ; S FIELD=$S(TYPE="F":277,TYPE="M":276,1:275)
+4 ; S DAYS=$$GET1^DIQ(350.9,"1,",FIELD) ; Number of days to wait before purge
+5 SET FIELD=$SELECT(TYPE="F":"ACCFAILEDPUR",TYPE="M":"ACCMIPUR",1:"ACCAGPUR")
+6 SET IBVAR=$$FIND1^DIC(364.991,,"X",FIELD)
+7 ;WCJ;V42;
IF IBVAR
SET DAYS=$$GET1^DIQ(364.991,IBVAR_",",.1)
+8 if $GET(DAYS)=""
QUIT
+9 ;
+10 ; STATUS DATE CHANGED
SET DATE=$$GET1^DIQ(364.9,IEN_",",.22,"I")
+11 ; Not eligible to purge
IF $$FMADD^XLFDT(DATE,DAYS)>DT
GOTO PURGEQ
+12 SET CNT=0
+13 FOR
SET CNT=$ORDER(^IBA(364.9,IEN,1,CNT))
if 'CNT
QUIT
SET STR=^(CNT,0)
Begin DoDot:1
+14 NEW DA,DR,DIE
+15 ;Do not remove this node.
IF $PIECE(STR,"*",1,2)="REF*D9"
QUIT
+16 SET DIE="^IBA(364.9,"_IEN_",1,"
SET DA=CNT
SET DA(1)=IEN
SET DR=".01///@"
+17 DO ^DIE
End DoDot:1
+18 ;Update STATUS to PURGED
+19 SET DIE="^IBA(364.9,"
SET DA=IEN
SET DR=".16///3"
+20 DO ^DIE
PURGEQ ;
+1 QUIT
FINDCLONES(CLAIM) ;Find all the times this claim has been cloned, so we're only looking at the most recent one ;MJL;EBILL-6180
+1 NEW STOP,LASTCLONE,CLONEDTO
+2 ;There are no clones, no need to run this loop
IF $$GET1^DIQ(399,CLAIM_",",29,"I")=""
QUIT CLAIM
+3 SET LASTCLONE=CLAIM
+4 SET STOP=""
+5 FOR
Begin DoDot:1
+6 SET CLONEDTO=$$GET1^DIQ(399,LASTCLONE_",",29,"I")
+7 ;Nothing left, take the last clone and exit
IF CLONEDTO=""
SET STOP=1
QUIT
+8 SET LASTCLONE=CLONEDTO
End DoDot:1
if STOP=1
QUIT
+9 QUIT LASTCLONE
