BPSOSK.m

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 ---BPSOSK   2259     printed  Feb 18, 2025@23:18:08                                                                                                                                                                                                      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