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