DVBC227P.m

DVBC227P ;ALB/BG;PATCH 227 POST INSTALL ; 9/17/21 9:48am

 ;;2.7;AMIE;**227**;Apr 10, 1995;Build 21

 ;Per VHA Directive 6402 this routine should not be modified

 ;Updates Capri Minimum version

 Q

 ;

PMAIN ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.

 ;

 N DVBERR

 W !!,"*************************************************"

 W !!,"Start DVBAB CAPRI Minimum Version Parameter Update"

 W !,"-------------------------",!

 S DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*227.2*1*A*3211230*1.3*1.3")

 D UPDMSG("CAPRI Minimum Version",DVBERR)

 ;

 W !!,"-------------------------"

 W !,"End DVBAB CAPRI Minimum Version Parameter Updates"

 W !,"****************************************************",!!

 ;

 D STATUS ;add reroute status

 D DIVUPD ;update capri division exam list (#396.15) file for ehrm 2507/7131 mod

 ;

 Q

ENXPAR(DVBENT,DVBPAR,DVBVAL) ;

 ;

 N DVBERR

 D EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)

 Q DVBERR

 ;

 ;

UPDMSG(DVBPAR,DVBERR) ;

 ;

 I DVBERR D

 . D MES^XPDUTL(DVBPAR_" update FAILURE.")

 . D MES^XPDUTL("  Failure reason: "_DVBERR)

 E  D

 . D MES^XPDUTL(DVBPAR_" Update Successful")

 Q

 ;

STATUS ;adding new reroute status

 N DVBFDA,DVBERR

 D BMES^XPDUTL("Updating the CAPRI 2507 STATUS (396.33) file...")

 S FIND="RE-ROUTED, PENDING AT TO SITE"

 D FIND^DIC(396.33,"",.01,"X",.FIND,"","","","","OUT")

 I $G(OUT("DILIST",2,1))'="" D BMES^XPDUTL("NEW RE-ROUTE STATUS HAS ALREADY ADDED") Q

 S DVBFDA(396.33,"+1,",.01)=FIND

 S DVBFDA(396.33,"+1,",.02)="RS"

 D UPDATE^DIE("","DVBFDA","","DVBERR")

 I $G(DVBERR)'="" D BMES^XPDUTL("NEW RE-ROUTE STATUS COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")

 I $G(DVBERR)="" D BMES^XPDUTL("NEW RE-ROUTE STATUS HAS BEEN ADDED.")

 K DVBERR,DVBFDA

 Q

 ;

DIVUPD ;add values to the new fields in the capri division exam list (#396.15) file

 N DVBAIEN,DVBAVAL,DVBAFIVE,DVBASIX,DVBASEVN,DVBAFDA,DVBAERR

 S DVBAIEN=0

 D BMES^XPDUTL("Updating the CAPRI DIVISION EXAM LIST (396.15) file...")

 F  S DVBAIEN=$O(^DVB(396.15,DVBAIEN)) Q:'DVBAIEN  D

  .S DVBAVAL=^DVB(396.15,DVBAIEN,3)

  .I $P(DVBAVAL,U)="Y" S DVBAFIVE="Y"

  .E  S DVBAFIVE="N"

  .S (DVBASIX,DVBASEVN)="N"

  .S DVBAFDA(396.15,DVBAIEN_",",5)=DVBAFIVE

  .S DVBAFDA(396.15,DVBAIEN_",",6)=DVBASIX

  .S DVBAFDA(396.15,DVBAIEN_",",7)=DVBASEVN

  .K DVBAERR D FILE^DIE(,"DVBAFDA","DVBAERR")

  .I '$D(DVBAERR) D BMES^XPDUTL("  >>Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_") updated successfully")

  .I $D(DVBAERR) D BMES^XPDUTL(">>>....Error updating Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_")") D

  ..D MES^XPDUTL("   ERROR: "_DVBAERR("DIERR","1")) ;print error code to help identify filing issue

  ..D BMES^XPDUTL("   *** Please contact support for assistance. ***")

 D BMES^XPDUTL("...CAPRI DIVISION EXAM LIST (396.15) file updates complete.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBC227P   2879     printed  Mar 13, 2025@20:47:49                                                                                                                                                                                                    Page 2

DVBC227P  ;ALB/BG;PATCH 227 POST INSTALL ; 9/17/21 9:48am

 +1       ;;2.7;AMIE;**227**;Apr 10, 1995;Build 21

 +2       ;Per VHA Directive 6402 this routine should not be modified

 +3       ;Updates Capri Minimum version

 +4        QUIT 

 +5       ;

PMAIN     ;-- update DVBAB CAPRI MINIMUM VERSION Parameter.

 +1       ;

 +2        NEW DVBERR

 +3        WRITE !!,"*************************************************"

 +4        WRITE !!,"Start DVBAB CAPRI Minimum Version Parameter Update"

 +5        WRITE !,"-------------------------",!

 +6        SET DVBERR=$$ENXPAR("PKG","DVBAB CAPRI MINIMUM VERSION","CAPRI GUI V2.7*227.2*1*A*3211230*1.3*1.3")

 +7        DO UPDMSG("CAPRI Minimum Version",DVBERR)

 +8       ;

 +9        WRITE !!,"-------------------------"

 +10       WRITE !,"End DVBAB CAPRI Minimum Version Parameter Updates"

 +11       WRITE !,"****************************************************",!!

 +12      ;

 +13      ;add reroute status

           DO STATUS

 +14      ;update capri division exam list (#396.15) file for ehrm 2507/7131 mod

           DO DIVUPD

 +15      ;

 +16       QUIT 

ENXPAR(DVBENT,DVBPAR,DVBVAL) ;

 +1       ;

 +2        NEW DVBERR

 +3        DO EN^XPAR(DVBENT,DVBPAR,1,DVBVAL,.DVBERR)

 +4        QUIT DVBERR

 +5       ;

 +6       ;

UPDMSG(DVBPAR,DVBERR) ;

 +1       ;

 +2        IF DVBERR

               Begin DoDot:1

 +3                DO MES^XPDUTL(DVBPAR_" update FAILURE.")

 +4                DO MES^XPDUTL("  Failure reason: "_DVBERR)

               End DoDot:1

 +5       IF '$TEST

               Begin DoDot:1

 +6                DO MES^XPDUTL(DVBPAR_" Update Successful")

               End DoDot:1

 +7        QUIT 

 +8       ;

STATUS    ;adding new reroute status

 +1        NEW DVBFDA,DVBERR

 +2        DO BMES^XPDUTL("Updating the CAPRI 2507 STATUS (396.33) file...")

 +3        SET FIND="RE-ROUTED, PENDING AT TO SITE"

 +4        DO FIND^DIC(396.33,"",.01,"X",.FIND,"","","","","OUT")

 +5        IF $GET(OUT("DILIST",2,1))'=""

               DO BMES^XPDUTL("NEW RE-ROUTE STATUS HAS ALREADY ADDED")

               QUIT 

 +6        SET DVBFDA(396.33,"+1,",.01)=FIND

 +7        SET DVBFDA(396.33,"+1,",.02)="RS"

 +8        DO UPDATE^DIE("","DVBFDA","","DVBERR")

 +9        IF $GET(DVBERR)'=""

               DO BMES^XPDUTL("NEW RE-ROUTE STATUS COULD NOT BE ADDED BY POST-INSTALL ROUTINE.")

 +10       IF $GET(DVBERR)=""

               DO BMES^XPDUTL("NEW RE-ROUTE STATUS HAS BEEN ADDED.")

 +11       KILL DVBERR,DVBFDA

 +12       QUIT 

 +13      ;

DIVUPD    ;add values to the new fields in the capri division exam list (#396.15) file

 +1        NEW DVBAIEN,DVBAVAL,DVBAFIVE,DVBASIX,DVBASEVN,DVBAFDA,DVBAERR

 +2        SET DVBAIEN=0

 +3        DO BMES^XPDUTL("Updating the CAPRI DIVISION EXAM LIST (396.15) file...")

 +4        FOR 

               SET DVBAIEN=$ORDER(^DVB(396.15,DVBAIEN))

               if 'DVBAIEN

                   QUIT 

               Begin DoDot:1

 +5                SET DVBAVAL=^DVB(396.15,DVBAIEN,3)

 +6                IF $PIECE(DVBAVAL,U)="Y"

                       SET DVBAFIVE="Y"

 +7               IF '$TEST

                       SET DVBAFIVE="N"

 +8                SET (DVBASIX,DVBASEVN)="N"

 +9                SET DVBAFDA(396.15,DVBAIEN_",",5)=DVBAFIVE

 +10               SET DVBAFDA(396.15,DVBAIEN_",",6)=DVBASIX

 +11               SET DVBAFDA(396.15,DVBAIEN_",",7)=DVBASEVN

 +12               KILL DVBAERR

                   DO FILE^DIE(,"DVBAFDA","DVBAERR")

 +13               IF '$DATA(DVBAERR)

                       DO BMES^XPDUTL("  >>Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_") updated successfully")

 +14               IF $DATA(DVBAERR)

                       DO BMES^XPDUTL(">>>....Error updating Division "_$$GET1^DIQ(396.15,DVBAIEN_",",.01)_" (IEN #"_DVBAIEN_")")

                       Begin DoDot:2

 +15      ;print error code to help identify filing issue

                           DO MES^XPDUTL("   ERROR: "_DVBAERR("DIERR","1"))

 +16                       DO BMES^XPDUTL("   *** Please contact support for assistance. ***")

                       End DoDot:2

               End DoDot:1

 +17       DO BMES^XPDUTL("...CAPRI DIVISION EXAM LIST (396.15) file updates complete.")

 +18       QUIT