BPS10P7.m

BPS10P7 ;OAK/ELZ - BPS*1*7 PRE/POST INSTALL ROUTINE ;6/9/08  11:02

 ;;1.0;E CLAIMS MGMT ENGINE;**7**;JUN 2004;Build 46

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

PRE ; pre-install of BPS*1*7

 ;

 ; delete the following files (leaving the data), the actual

 ; install of BPS*1*7 will re-install the updated files.

 ;          9002313.91 -- BPS NCPDP FIELD DEFS

 ;          9002313.92 -- BPS NCPDP FORMATS

 ;          9002313.93 -- BPS NCPDP REJECT CODES ** REMOVE DATA **

 ;          9002313.59 -- BPS TRANSACTION

 ;          9002313.02 -- BPS CLAIMS

 ;          9002313.03 -- BPS RESPONSES

 ;          9002313.56 -- BPS PHARMACIES

 ;          9002313.57 -- BPS LOG OF TRANSACTIONS

 ;          9002313.77 -- BPS REQUESTS

 ;          9002313.78 -- BPS INSURER DATA

 ;          9002313.99 -- BPS SETUP

 ;

 ; DBIA2172,DBIA10141,DBIA10014

 ;

 N BPSX,DIU,XPDIDTOT,BPSC,BPSP

 D MES^XPDUTL("  Starting pre-install of BPS*1*7")

 S XPDIDTOT=11,BPSC=0

 D MES^XPDUTL("  - Deleting files to be restored during install.")

 F BPSX=9002313.91,9002313.92,9002313.93,9002313.59,9002313.02,9002313.03,9002313.56,9002313.57,9002313.77,9002313.78,9002313.99 D

 . S BPSP=$G(DILOCKTM,3)

 . D MES^XPDUTL("    - Deleting file #"_BPSX_", Waiting for hardware "_BPSP_" seconds...")

 . S DIU=BPSX

 . S DIU(0)=$S(BPSX=9002313.93:"DE",1:"E")

 . D EN^DIU2

 . S BPSC=BPSC+1

 . D UPDATE^XPDID(BPSC)

 . H BPSP  ; need to pause so we don't hit the globals too hard

 D MES^XPDUTL("  Finished pre-install of BPS*1*7")

 Q

 ;

POST ; post install for BPS*1*7

 ;   - need to build the new AD cross reference on Status

 ;     of the BPS LOG OF TRANSACTIONS so it matches the

 ;     BPS TRANSACTION file.

 ;

 ; DBIA2172,DBIA10141

 ;

 N BPSX,BPSY,BPSC,XPDIDTOT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,BPSTIME,DIU,BPSP

 D MES^XPDUTL("  Starting post-install of BPS*1*7")

 D MES^XPDUTL("  - Building AD xref on BPS LOG OF TRANSACTIONS file")

 S XPDIDTOT=$P($G(^BPST(0)),"^",4)

 S (BPSC,BPSX)=0

 F  S BPSX=$O(^BPST(BPSX)) Q:'BPSX  S BPSC=BPSC+1,BPSY=$P($G(^BPST(BPSX,0)),"^",2) D:'(BPSC#500) UPDATE^XPDID(BPSC) I $L(BPSY) S ^BPST("AD",$E(BPSY,1,30),BPSX)=""

 ;

 ; need to clean up old fields from BPS Pharmacies 9002313.56

 D MES^XPDUTL("  - Cleaning out old data from BPS PHARMACIES")

 S BPSX=0 F  S BPSX=$O(^BPS(9002313.56,BPSX)) Q:'BPSX  K ^BPS(9002313.56,BPSX,"HOURS"),^("TCLOSE"),^("TOPEN")

 D MES^XPDUTL("  - Done cleaning out old data from BPS PHARMACIES")

 ;

 ; Clean up the old field being removed with tasked job 9002313.0301,508Sales Tax Paid

 D MES^XPDUTL("  - Queing task to clean up old data")

 S ZTRTN="DQ^BPS10P7",ZTDESC="Post Install BPS*1*7, Clean-up of Data"

 S (BPSTIME,ZTDTH)=$$FMADD^XLFDT($$NOW^XLFDT,,,5),ZTIO=""

 D ^%ZTLOAD

 I $G(ZTSK) D

 . D MES^XPDUTL("  - Task Queued, #"_ZTSK_" to run at "_$$FMTE^XLFDT(BPSTIME))

 E  D MES^XPDUTL("  - ERROR:  Task not queued!!!")

 ;

 ; populate new fields in setup file

 D MES^XPDUTL("   - Setting up New Insurer Asleep fields in site param file")

 S:$P($G(^BPS(9002313.99,1,0)),"^",5)="" $P(^(0),"^",5)=20

 S:$P($G(^BPS(9002313.99,1,0)),"^",6)="" $P(^(0),"^",6)=10

 D MES^XPDUTL("   - New Insurer Asleep fields set")

 ;

 ; delete the following obsolete files leaving no data

 ;         9002313.82103 BPS NCPDP FIELD 103

 ;         9002313.82305 BPS NCPDP FIELD 305

 ;         9002313.82306 BPS NCPDP FIELD 306

 ;         9002313.82307 BPS NCPDP FIELD 307

 ;         9002313.82308 BPS NCPDP FIELD 308

 ;         9002313.82309 BPS NCPDP FIELD 309

 ;         9002313.82406 BPS NCPDP FIELD 406

 ;         9002313.82408 BPS NCPDP FIELD 408

 ;         9002313.82416 BPS NCPDP FIELD 416

 ;         9002313.82419 BPS NCPDP FIELD 419

 ;         9002313.8242  BPS NCPDP FIELD 420

 ;         9002313.82423 BPS NCPDP FIELD 423

 ;         9002313.82425 BPS NCPDP FIELD 425

 ;         9002313.82429 BPS NCPDP FIELD 429

 ;         9002313.82432 BPS NCPDP FIELD 432

 ;         9002313.82436 BPS NCPDP FIELD 436

 ;         9002313.82439 BPS NCPDP FIELD 439

 ;         9002313.8244  BPS NCPDP FIELD 440

 ;         9002313.82441 BPS NCPDP FIELD 441

 ;         9002313.82461 BPS NCPDP FIELD 461

 ;         9002313.82501 BPS NCPDP FIELD 501

 ;         9002313.82522 BPS NCPDP FIELD 522

 ;         9002313.82528 BPS NCPDP FIELD 528

 ;         9002313.82529 BPS NCPDP FIELD 529

 ;         9002313.82532 BPS NCPDP FIELD 532

 ;         9002313.82533 BPS NCPDP FIELD 533

 ;         9002313.82535 BPS NCPDP FIELD 535

 ;

 ; DBIA2172,DBIA10141,DBIA10014

 ;

 D MES^XPDUTL("   - Deleting obsolete files.")

 S XPDIDTOT=27,BPSC=0

 F BPSY=1:1 S BPSX=$P($T(DELFILE+BPSY),";",3) Q:BPSX=""  D

 . S BPSP=$G(DILOCKTM,3)

 . D MES^XPDUTL("    - Deleting obsolete file #"_BPSX_", Waiting for hardware "_BPSP_" seconds...")

 . S DIU=BPSX,DIU(0)="EDT"

 . D EN^DIU2

 . S BPSC=BPSC+1

 . D UPDATE^XPDID(BPSC)

 . H BPSP  ; need to pause so we don't hit the globals too hard

 ;

 D MES^XPDUTL("  Finished post-install of BPS*1*7")

 Q

 ;

DQ ; taskman entry to clean up data

 N BPSX,BPSY,Y,%DT,X

 S BPSX=0 F  S BPSX=$O(^BPSR(BPSX)) Q:'BPSX  S BPSY=0 F  S BPSY=$O(^BPSR(BPSX,1000,BPSY)) Q:'BPSY  D

 . I $D(^BPSR(BPSX,1000,BPSY,500)) S $P(^(500),"^",8)=""

 ;

 ; reset *M Vendor field to be null if a date is not stored there

 I $L($P($G(^BPS(9002313.99,1,0)),"^",4)),$E($P(^(0),"^",4),1,7)'?7N S $P(^(0),"^",4)=""

 ;

 ; Cleaning up BPS Claims file, Date Reopened field (906)

 ; some data stored in there is in external format, like 8-31-2006@13:20:04

 S BPSX=0 F  S BPSX=$O(^BPSC(BPSX))  Q:'BPSX  D

 . S BPSY=$P($G(^BPSC(BPSX,900)),"^",6)

 . I '$L(BPSY) Q

 . I $E(BPSY,1,7)?7N Q

 . S %DT="PT",X=$P(BPSY,"@")

 . D ^%DT

 . I Y>0 S $P(^BPSC(BPSX,900),"^",6)=+(Y_$S(BPSY["@":"."_$TR($P(BPSY,"@",2),":"),1:""))

 ;

 ; clean out the data for:

 ;  ^BPSC(ien,400,"AC")

 ;  $P(^BPSC(BPS(9002313.02),400,0),"^",3)

 S BPSX=0 F  S BPSX=$O(^BPSC(BPSX)) Q:'BPSX  K ^BPSC(BPSX,400,"AC")  S BPSY=0 F  S BPSY=$O(^BPSC(BPSX,400,BPSY)) Q:'BPSY  I $L($G(^BPSC(BPSX,400,BPSY,0))) S $P(^(0),"^",3)=""

 ;

 Q

DELFILE ; list of files to go bye bye with their data

 ;;9002313.82103

 ;;9002313.82305

 ;;9002313.82306

 ;;9002313.82307

 ;;9002313.82308

 ;;9002313.82309

 ;;9002313.82406

 ;;9002313.82408

 ;;9002313.82416

 ;;9002313.82419

 ;;9002313.82423

 ;;9002313.82425

 ;;9002313.82429

 ;;9002313.82432

 ;;9002313.82436

 ;;9002313.8244

 ;;9002313.82441

 ;;9002313.82501

 ;;9002313.82522

 ;;9002313.82528

 ;;9002313.82529

 ;;9002313.82532

 ;;9002313.82533

 ;;9002313.82535

 ;;9002313.8242

 ;;9002313.82439

 ;;9002313.82461

 ;;

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPS10P7   6651     printed  Mar 13, 2025@20:54:56                                                                                                                                                                                                     Page 2

BPS10P7   ;OAK/ELZ - BPS*1*7 PRE/POST INSTALL ROUTINE ;6/9/08  11:02

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**7**;JUN 2004;Build 46

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

PRE       ; pre-install of BPS*1*7

 +1       ;

 +2       ; delete the following files (leaving the data), the actual

 +3       ; install of BPS*1*7 will re-install the updated files.

 +4       ;          9002313.91 -- BPS NCPDP FIELD DEFS

 +5       ;          9002313.92 -- BPS NCPDP FORMATS

 +6       ;          9002313.93 -- BPS NCPDP REJECT CODES ** REMOVE DATA **

 +7       ;          9002313.59 -- BPS TRANSACTION

 +8       ;          9002313.02 -- BPS CLAIMS

 +9       ;          9002313.03 -- BPS RESPONSES

 +10      ;          9002313.56 -- BPS PHARMACIES

 +11      ;          9002313.57 -- BPS LOG OF TRANSACTIONS

 +12      ;          9002313.77 -- BPS REQUESTS

 +13      ;          9002313.78 -- BPS INSURER DATA

 +14      ;          9002313.99 -- BPS SETUP

 +15      ;

 +16      ; DBIA2172,DBIA10141,DBIA10014

 +17      ;

 +18       NEW BPSX,DIU,XPDIDTOT,BPSC,BPSP

 +19       DO MES^XPDUTL("  Starting pre-install of BPS*1*7")

 +20       SET XPDIDTOT=11

           SET BPSC=0

 +21       DO MES^XPDUTL("  - Deleting files to be restored during install.")

 +22       FOR BPSX=9002313.91,9002313.92,9002313.93,9002313.59,9002313.02,9002313.03,9002313.56,9002313.57,9002313.77,9002313.78,9002313.99

               Begin DoDot:1

 +23               SET BPSP=$GET(DILOCKTM,3)

 +24               DO MES^XPDUTL("    - Deleting file #"_BPSX_", Waiting for hardware "_BPSP_" seconds...")

 +25               SET DIU=BPSX

 +26               SET DIU(0)=$SELECT(BPSX=9002313.93:"DE",1:"E")

 +27               DO EN^DIU2

 +28               SET BPSC=BPSC+1

 +29               DO UPDATE^XPDID(BPSC)

 +30      ; need to pause so we don't hit the globals too hard

                   HANG BPSP

               End DoDot:1

 +31       DO MES^XPDUTL("  Finished pre-install of BPS*1*7")

 +32       QUIT 

 +33      ;

POST      ; post install for BPS*1*7

 +1       ;   - need to build the new AD cross reference on Status

 +2       ;     of the BPS LOG OF TRANSACTIONS so it matches the

 +3       ;     BPS TRANSACTION file.

 +4       ;

 +5       ; DBIA2172,DBIA10141

 +6       ;

 +7        NEW BPSX,BPSY,BPSC,XPDIDTOT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,BPSTIME,DIU,BPSP

 +8        DO MES^XPDUTL("  Starting post-install of BPS*1*7")

 +9        DO MES^XPDUTL("  - Building AD xref on BPS LOG OF TRANSACTIONS file")

 +10       SET XPDIDTOT=$PIECE($GET(^BPST(0)),"^",4)

 +11       SET (BPSC,BPSX)=0

 +12       FOR 

               SET BPSX=$ORDER(^BPST(BPSX))

               if 'BPSX

                   QUIT 

               SET BPSC=BPSC+1

               SET BPSY=$PIECE($GET(^BPST(BPSX,0)),"^",2)

               if '(BPSC#500)

                   DO UPDATE^XPDID(BPSC)

               IF $LENGTH(BPSY)

                   SET ^BPST("AD",$EXTRACT(BPSY,1,30),BPSX)=""

 +13      ;

 +14      ; need to clean up old fields from BPS Pharmacies 9002313.56

 +15       DO MES^XPDUTL("  - Cleaning out old data from BPS PHARMACIES")

 +16       SET BPSX=0

           FOR 

               SET BPSX=$ORDER(^BPS(9002313.56,BPSX))

               if 'BPSX

                   QUIT 

               KILL ^BPS(9002313.56,BPSX,"HOURS"),^("TCLOSE"),^("TOPEN")

 +17       DO MES^XPDUTL("  - Done cleaning out old data from BPS PHARMACIES")

 +18      ;

 +19      ; Clean up the old field being removed with tasked job 9002313.0301,508Sales Tax Paid

 +20       DO MES^XPDUTL("  - Queing task to clean up old data")

 +21       SET ZTRTN="DQ^BPS10P7"

           SET ZTDESC="Post Install BPS*1*7, Clean-up of Data"

 +22       SET (BPSTIME,ZTDTH)=$$FMADD^XLFDT($$NOW^XLFDT,,,5)

           SET ZTIO=""

 +23       DO ^%ZTLOAD

 +24       IF $GET(ZTSK)

               Begin DoDot:1

 +25               DO MES^XPDUTL("  - Task Queued, #"_ZTSK_" to run at "_$$FMTE^XLFDT(BPSTIME))

               End DoDot:1

 +26      IF '$TEST

               DO MES^XPDUTL("  - ERROR:  Task not queued!!!")

 +27      ;

 +28      ; populate new fields in setup file

 +29       DO MES^XPDUTL("   - Setting up New Insurer Asleep fields in site param file")

 +30       if $PIECE($GET(^BPS(9002313.99,1,0)),"^",5)=""

               SET $PIECE(^(0),"^",5)=20

 +31       if $PIECE($GET(^BPS(9002313.99,1,0)),"^",6)=""

               SET $PIECE(^(0),"^",6)=10

 +32       DO MES^XPDUTL("   - New Insurer Asleep fields set")

 +33      ;

 +34      ; delete the following obsolete files leaving no data

 +35      ;         9002313.82103 BPS NCPDP FIELD 103

 +36      ;         9002313.82305 BPS NCPDP FIELD 305

 +37      ;         9002313.82306 BPS NCPDP FIELD 306

 +38      ;         9002313.82307 BPS NCPDP FIELD 307

 +39      ;         9002313.82308 BPS NCPDP FIELD 308

 +40      ;         9002313.82309 BPS NCPDP FIELD 309

 +41      ;         9002313.82406 BPS NCPDP FIELD 406

 +42      ;         9002313.82408 BPS NCPDP FIELD 408

 +43      ;         9002313.82416 BPS NCPDP FIELD 416

 +44      ;         9002313.82419 BPS NCPDP FIELD 419

 +45      ;         9002313.8242  BPS NCPDP FIELD 420

 +46      ;         9002313.82423 BPS NCPDP FIELD 423

 +47      ;         9002313.82425 BPS NCPDP FIELD 425

 +48      ;         9002313.82429 BPS NCPDP FIELD 429

 +49      ;         9002313.82432 BPS NCPDP FIELD 432

 +50      ;         9002313.82436 BPS NCPDP FIELD 436

 +51      ;         9002313.82439 BPS NCPDP FIELD 439

 +52      ;         9002313.8244  BPS NCPDP FIELD 440

 +53      ;         9002313.82441 BPS NCPDP FIELD 441

 +54      ;         9002313.82461 BPS NCPDP FIELD 461

 +55      ;         9002313.82501 BPS NCPDP FIELD 501

 +56      ;         9002313.82522 BPS NCPDP FIELD 522

 +57      ;         9002313.82528 BPS NCPDP FIELD 528

 +58      ;         9002313.82529 BPS NCPDP FIELD 529

 +59      ;         9002313.82532 BPS NCPDP FIELD 532

 +60      ;         9002313.82533 BPS NCPDP FIELD 533

 +61      ;         9002313.82535 BPS NCPDP FIELD 535

 +62      ;

 +63      ; DBIA2172,DBIA10141,DBIA10014

 +64      ;

 +65       DO MES^XPDUTL("   - Deleting obsolete files.")

 +66       SET XPDIDTOT=27

           SET BPSC=0

 +67       FOR BPSY=1:1

               SET BPSX=$PIECE($TEXT(DELFILE+BPSY),";",3)

               if BPSX=""

                   QUIT 

               Begin DoDot:1

 +68               SET BPSP=$GET(DILOCKTM,3)

 +69               DO MES^XPDUTL("    - Deleting obsolete file #"_BPSX_", Waiting for hardware "_BPSP_" seconds...")

 +70               SET DIU=BPSX

                   SET DIU(0)="EDT"

 +71               DO EN^DIU2

 +72               SET BPSC=BPSC+1

 +73               DO UPDATE^XPDID(BPSC)

 +74      ; need to pause so we don't hit the globals too hard

                   HANG BPSP

               End DoDot:1

 +75      ;

 +76       DO MES^XPDUTL("  Finished post-install of BPS*1*7")

 +77       QUIT 

 +78      ;

DQ        ; taskman entry to clean up data

 +1        NEW BPSX,BPSY,Y,%DT,X

 +2        SET BPSX=0

           FOR 

               SET BPSX=$ORDER(^BPSR(BPSX))

               if 'BPSX

                   QUIT 

               SET BPSY=0

               FOR 

                   SET BPSY=$ORDER(^BPSR(BPSX,1000,BPSY))

                   if 'BPSY

                       QUIT 

                   Begin DoDot:1

 +3                    IF $DATA(^BPSR(BPSX,1000,BPSY,500))

                           SET $PIECE(^(500),"^",8)=""

                   End DoDot:1

 +4       ;

 +5       ; reset *M Vendor field to be null if a date is not stored there

 +6        IF $LENGTH($PIECE($GET(^BPS(9002313.99,1,0)),"^",4))

               IF $EXTRACT($PIECE(^(0),"^",4),1,7)'?7N

                   SET $PIECE(^(0),"^",4)=""

 +7       ;

 +8       ; Cleaning up BPS Claims file, Date Reopened field (906)

 +9       ; some data stored in there is in external format, like 8-31-2006@13:20:04

 +10       SET BPSX=0

           FOR 

               SET BPSX=$ORDER(^BPSC(BPSX))

               if 'BPSX

                   QUIT 

               Begin DoDot:1

 +11               SET BPSY=$PIECE($GET(^BPSC(BPSX,900)),"^",6)

 +12               IF '$LENGTH(BPSY)

                       QUIT 

 +13               IF $EXTRACT(BPSY,1,7)?7N

                       QUIT 

 +14               SET %DT="PT"

                   SET X=$PIECE(BPSY,"@")

 +15               DO ^%DT

 +16               IF Y>0

                       SET $PIECE(^BPSC(BPSX,900),"^",6)=+(Y_$SELECT(BPSY["@":"."_$TRANSLATE($PIECE(BPSY,"@",2),":"),1:""))

               End DoDot:1

 +17      ;

 +18      ; clean out the data for:

 +19      ;  ^BPSC(ien,400,"AC")

 +20      ;  $P(^BPSC(BPS(9002313.02),400,0),"^",3)

 +21       SET BPSX=0

           FOR 

               SET BPSX=$ORDER(^BPSC(BPSX))

               if 'BPSX

                   QUIT 

               KILL ^BPSC(BPSX,400,"AC")

               SET BPSY=0

               FOR 

                   SET BPSY=$ORDER(^BPSC(BPSX,400,BPSY))

                   if 'BPSY

                       QUIT 

                   IF $LENGTH($GET(^BPSC(BPSX,400,BPSY,0)))

                       SET $PIECE(^(0),"^",3)=""

 +22      ;

 +23       QUIT 

DELFILE   ; list of files to go bye bye with their data

 +1       ;;9002313.82103

 +2       ;;9002313.82305

 +3       ;;9002313.82306

 +4       ;;9002313.82307

 +5       ;;9002313.82308

 +6       ;;9002313.82309

 +7       ;;9002313.82406

 +8       ;;9002313.82408

 +9       ;;9002313.82416

 +10      ;;9002313.82419

 +11      ;;9002313.82423

 +12      ;;9002313.82425

 +13      ;;9002313.82429

 +14      ;;9002313.82432

 +15      ;;9002313.82436

 +16      ;;9002313.8244

 +17      ;;9002313.82441

 +18      ;;9002313.82501

 +19      ;;9002313.82522

 +20      ;;9002313.82528

 +21      ;;9002313.82529

 +22      ;;9002313.82532

 +23      ;;9002313.82533

 +24      ;;9002313.82535

 +25      ;;9002313.8242

 +26      ;;9002313.82439

 +27      ;;9002313.82461

 +28      ;;

 +29      ;