BPSOSK ;BHAM ISC/FCS/DRS/DLF - Winnow ECME data ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
; MAIN
MAIN ;
; Set lock so only one job is running at a time
L +^TMP($T(+0)):0 Q:'$T
;
; New the common variables
N SLOT,TESTING
;
; Initialize the log and store slot in BPS Setup
; Also keep previous two logs.
S SLOT=DT+.5
D LOG^BPSOSL(SLOT,"Start Purge","DT")
;
S TESTING=$$GET1^DIQ(9002313.99,1,2341.01,"I")
I TESTING D LOG^BPSOSL(SLOT,"Test Mode - no data will be deleted")
I 'TESTING D LOG^BPSOSL(SLOT,"Purge Mode - data may be deleted")
;
; Delete the log file
N FILE,AGE,IEN,UPDT,IENS,MSG,FDA,ENDDT
S FILE=9002313.12
;
; Log start message
D LOG^BPSOSL(SLOT,"Winnowing file BPS LOG")
;
; Get number of days to keep on the system
S AGE=$$GET1^DIQ(9002313.99,1,2341.03)
I 'AGE D
. S AGE=365
. I '$D(^BPS(9002313.99,1)) Q
. N DIE,DA,DR,DTOUT
. S DIE=9002313.99,DA=1,DR="2341.03///"_AGE
. D ^DIE
;
; Calculate end date of purge
N X,X1,X2
S X1=DT,X2=(AGE*-1) D C^%DTC
S ENDDT=X
D LOG^BPSOSL(SLOT,"AGE is "_AGE_". End Date is "_ENDDT)
;
; Loop through data and delete it
S UPDT="" F S UPDT=$O(^BPS(FILE,"AC",UPDT)) Q:UPDT'<ENDDT!(UPDT="") D
. S IEN="" F S IEN=$O(^BPS(FILE,"AC",UPDT,IEN)) Q:'IEN D
.. S IENS=IEN_","
.. ;
.. ; Never delete the highest entry in a file
.. ; This will prevent the re-use of IENs.
.. I '$O(^BPS(FILE,IEN)) Q
.. ;
.. ; Log the message
.. S MSG=$S(TESTING:" We would delete",1:" Deleting")
.. S MSG=MSG_" record "_IEN_" - "_$P($G(^BPS(FILE,IEN,0)),U,1)
.. D LOG^BPSOSL(SLOT,MSG)
.. ;
.. ; Quit if testing mode
.. I TESTING Q
.. ;
.. ; Do the delete
.. K FDA,MSG
.. S FDA(FILE,IENS,.01)=""
.. D FILE^DIE(,"FDA","MSG")
.. I $D(MSG) D
... D LOG^BPSOSL(SLOT,"Deletion failed - MSG array returned:")
... D LOGARRAY^BPSOSL(SLOT,"MSG")
.. ;
.. ; Make sure the deletion worked: fetch the .01 field
.. I $$GET1^DIQ(FILE,IENS,.01)]"" D LOG^BPSOSL(SLOT,"Deletion failed-record still defined")
;
; Log ending message
D LOG^BPSOSL(SLOT,"Done with file BPS LOG")
;
; Unlock the job
L -^TMP($T(+0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSK 2259 printed Jun 11, 2024@21:38:43 Page 2
BPSOSK ;BHAM ISC/FCS/DRS/DLF - Winnow ECME data ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ; MAIN
MAIN ;
+1 ; Set lock so only one job is running at a time
+2 LOCK +^TMP($TEXT(+0)):0
if '$TEST
QUIT
+3 ;
+4 ; New the common variables
+5 NEW SLOT,TESTING
+6 ;
+7 ; Initialize the log and store slot in BPS Setup
+8 ; Also keep previous two logs.
+9 SET SLOT=DT+.5
+10 DO LOG^BPSOSL(SLOT,"Start Purge","DT")
+11 ;
+12 SET TESTING=$$GET1^DIQ(9002313.99,1,2341.01,"I")
+13 IF TESTING
DO LOG^BPSOSL(SLOT,"Test Mode - no data will be deleted")
+14 IF 'TESTING
DO LOG^BPSOSL(SLOT,"Purge Mode - data may be deleted")
+15 ;
+16 ; Delete the log file
+17 NEW FILE,AGE,IEN,UPDT,IENS,MSG,FDA,ENDDT
+18 SET FILE=9002313.12
+19 ;
+20 ; Log start message
+21 DO LOG^BPSOSL(SLOT,"Winnowing file BPS LOG")
+22 ;
+23 ; Get number of days to keep on the system
+24 SET AGE=$$GET1^DIQ(9002313.99,1,2341.03)
+25 IF 'AGE
Begin DoDot:1
+26 SET AGE=365
+27 IF '$DATA(^BPS(9002313.99,1))
QUIT
+28 NEW DIE,DA,DR,DTOUT
+29 SET DIE=9002313.99
SET DA=1
SET DR="2341.03///"_AGE
+30 DO ^DIE
End DoDot:1
+31 ;
+32 ; Calculate end date of purge
+33 NEW X,X1,X2
+34 SET X1=DT
SET X2=(AGE*-1)
DO C^%DTC
+35 SET ENDDT=X
+36 DO LOG^BPSOSL(SLOT,"AGE is "_AGE_". End Date is "_ENDDT)
+37 ;
+38 ; Loop through data and delete it
+39 SET UPDT=""
FOR
SET UPDT=$ORDER(^BPS(FILE,"AC",UPDT))
if UPDT'<ENDDT!(UPDT="")
QUIT
Begin DoDot:1
+40 SET IEN=""
FOR
SET IEN=$ORDER(^BPS(FILE,"AC",UPDT,IEN))
if 'IEN
QUIT
Begin DoDot:2
+41 SET IENS=IEN_","
+42 ;
+43 ; Never delete the highest entry in a file
+44 ; This will prevent the re-use of IENs.
+45 IF '$ORDER(^BPS(FILE,IEN))
QUIT
+46 ;
+47 ; Log the message
+48 SET MSG=$SELECT(TESTING:" We would delete",1:" Deleting")
+49 SET MSG=MSG_" record "_IEN_" - "_$PIECE($GET(^BPS(FILE,IEN,0)),U,1)
+50 DO LOG^BPSOSL(SLOT,MSG)
+51 ;
+52 ; Quit if testing mode
+53 IF TESTING
QUIT
+54 ;
+55 ; Do the delete
+56 KILL FDA,MSG
+57 SET FDA(FILE,IENS,.01)=""
+58 DO FILE^DIE(,"FDA","MSG")
+59 IF $DATA(MSG)
Begin DoDot:3
+60 DO LOG^BPSOSL(SLOT,"Deletion failed - MSG array returned:")
+61 DO LOGARRAY^BPSOSL(SLOT,"MSG")
End DoDot:3
+62 ;
+63 ; Make sure the deletion worked: fetch the .01 field
+64 IF $$GET1^DIQ(FILE,IENS,.01)]""
DO LOG^BPSOSL(SLOT,"Deletion failed-record still defined")
End DoDot:2
End DoDot:1
+65 ;
+66 ; Log ending message
+67 DO LOG^BPSOSL(SLOT,"Done with file BPS LOG")
+68 ;
+69 ; Unlock the job
+70 LOCK -^TMP($TEXT(+0))
+71 QUIT
