DVB458P.m

DVB458P ;ALB/RBS - ENV/PRE/POST-INSTALL FOR PATCH DVB*4*58 ; 1/11/07 1:34pm

 ;;4.0;HINQ;**58**;03/25/92;Build 29

 ;

 ;This routine is the main install routine that will update the

 ;DISABILITY CONDITION (#31) file with the new mapping of Rated

 ;Disabilities (VA) VBA DX CODES to specific ICD DIAGNOSIS codes.

 ;There are 3,085 ICD9 codes that will be added to the (#31) file.

 ;

 ;

 Q  ;no direct entry

 ;

 ;

ENV ;Main entry point for Environment check point.

 ;

 S XPDABORT=""

 ;checks programmer variables

 D PROGCHK(.XPDABORT)

 ;check if patch install is running

 D ISRUNING(.XPDABORT)

 ;

 I XPDABORT="" K XPDABORT

 Q

 ;

 ;

PRE ;Main entry point for Pre-init items.

 ;

 Q

 ;

 ;

POST ;Main entry point for Post-init items.

 ;

 N DVBTOT  ;count of total ICD9 codes filed

 N DVBTMP  ;Closed Root global reference for error reporting

 ;remove data from #field 20 in file #31 and repopulate

 I $$VFIELD^DILFD(31,20) D

 .D DELETE^DVB458P1

 S DVBTMP=$NA(^TMP("DVB458P",$J))

 K @DVBTMP

 S @DVBTMP@(0)="PATCH DVB*4*58 POST-INSTALL^"_$$NOW^XLFDT

 S DVBTOT=0

 ;

 D BMES^XPDUTL("  >>> *** Updating the DISABILITY CONDITION (#31) file...")

 D MES^XPDUTL("      *** Please be patient, this should take less than 5 minutes.")

 D MES^XPDUTL("  ")

 ;

 ;call to process (#31) file updates

 D POST^DVB458P1(DVBTMP,.DVBTOT)

 ;

 S @DVBTMP@(0)=@DVBTMP@(0)_"^"_$$NOW^XLFDT_"^"_DVBTOT

 ;

 I '$D(@DVBTMP@("ERROR")) D

 . D BMES^XPDUTL("  >>> *** SUCCESS updating the DISABILITY CONDITION (#31) file.")

 . D MES^XPDUTL("          Total RELATED ICD9 CODES filed: "_DVBTOT)

 . ;

 E  D

 . D BMES^XPDUTL("  >>> *** FAILURE updating the DISABILITY CONDITION (#31) file.")

 . D BMES^XPDUTL("      Filing error's have occurred when adding the new RELATED ICD9 CODES.")

 . D MES^XPDUTL("      Immediate resolution is necessary to maintain database integrity.")

 . D BMES^XPDUTL("  A MailMan message has been sent to the installer of this patch")

 . D MES^XPDUTL("  with a listing of the error's.")

 . D BMES^XPDUTL("  Once these filing error's have been resolved, please re-run")

 . D MES^XPDUTL("  the Post-Installation routine directly from programmer mode")

 . D MES^XPDUTL("  by entering the following command:")

 . D MES^XPDUTL("  ")

 . D MES^XPDUTL("  D POST^DVB458P")

 . D MES^XPDUTL("  ")

 . D BMES^XPDUTL("  >>> I'm now creating and sending the MailMan message...")

 . ;

 . D SENDMSG(DVBTMP,.DVBTOT)

 . ;

 . D MES^XPDUTL("  >>> All done.")

 ;

 ;cleanup temp file

 K @DVBTMP

 Q

 ;

 ;

SENDMSG(DVBTMP,DVBTOT) ;send failure MailMan message to installer of patch

 ;

 N DIFROM,DVBMSG

 N XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ

 S XMSUB="DVB*4.0*58 Patch Post-Install Error Listing"

 S XMTEXT="DVBMSG("

 S XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""

 S DVBMSG(1)="Patch:  DVB*4.0*58 Automated Service Connected Designation"

 S DVBMSG(2)=""

 S DVBMSG(3)="The post-installation update of the DISABILITY CONDITION (#31) file"

 S DVBMSG(4)="has FAILED to successfully complete.  Filing error's have occurred when"

 S DVBMSG(5)="attempting to add the new data mapping of RELATED ICD9 CODES."

 S DVBMSG(6)=""

 S DVBMSG(7)="Immediate resolution of ALL error's is needed to maintain database integrity."

 S DVBMSG(8)=""

 S DVBMSG(9)="Once these filing error's have been resolved, please re-run"

 S DVBMSG(10)="the Post-Installation routine directly from programmer mode"

 S DVBMSG(11)="by entering the following command:"

 S DVBMSG(12)=""

 S DVBMSG(13)="D POST^DVB458P"

 S DVBMSG(14)=""

 S DVBMSG(15)="The new update run time should take less than 5 minutes to complete."

 S DVBMSG(16)=""

 S DVBMSG(17)=">>> Please review and resolve the following error's:"

 S DVBMSG(18)=""

 S DVBMSG(19)="*** DISABILITY CONDITION FILE (#31) FILING ERRORS ***"

 S DVBMSG(20)="-----------------------------------------------------"

 ;

 ;loop and list error's

 N DVBICD,DVBHDR,DVBHDR1,DVBIEN,DVBLN,DVBMSS,DVBVBA,DVBDESC

 S DVBHDR="VBA DX CODE: ",DVBHDR1="    ICD DIAGNOSIS CODE: "

 S DVBLN=21,DVBVBA=0

 F  S DVBVBA=$O(@DVBTMP@("ERROR",DVBVBA)) Q:'DVBVBA  D

 . I $D(@DVBTMP@("ERROR",DVBVBA,0)) D  Q

 . . S DVBMSS=DVBHDR_DVBVBA_" - "_$G(@DVBTMP@("ERROR",DVBVBA,0))

 . . S DVBMSG(DVBLN)=DVBMSS,DVBLN=DVBLN+1

 . K DVBDESC D FIND^DIC(31,"","","X",DVBVBA,,"C","","","DVBDESC")

 . S DVBMSS=DVBHDR_DVBVBA_" - "_$E($G(DVBDESC("DILIST",1,1)),1,50)

 . S DVBMSG(DVBLN)=DVBMSS,DVBLN=DVBLN+1

 . S DVBIEN=0

 . F  S DVBIEN=$O(@DVBTMP@("ERROR",DVBVBA,DVBIEN)) Q:'DVBIEN  D

 . . S DVBICD=""

 . . F  S DVBICD=$O(@DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD)) Q:DVBICD=""  D

 . . . S DVBMSS=DVBHDR1_DVBICD_" - "_$G(@DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD))

 . . . S DVBMSG(DVBLN)=DVBMSS,DVBLN=DVBLN+1

 S DVBMSG(DVBLN)="",DVBLN=DVBLN+1

 S DVBMSG(DVBLN)="<End of Report>"

 ;

 D ^XMD

 Q

 ;

 ;

PROGCHK(XPDABORT) ;checks for necessary programmer variables

 ;

 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D

 . D BMES^XPDUTL("*****")

 . D MES^XPDUTL("Your programming variables are not set up properly.")

 . D MES^XPDUTL("Installation aborted.")

 . D MES^XPDUTL("*****")

 . S XPDABORT=2

 Q

 ;

 ;

ISRUNING(XPDABORT) ;check if patch install is running

 ;

 I $D(^TMP("DVB458P")) D

 . D BMES^XPDUTL("*****")

 . D MES^XPDUTL("This patch is currently being Installed.  Try later.")

 . D MES^XPDUTL("Installation aborted.")

 . D MES^XPDUTL("*****")

 . S XPDABORT=2

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVB458P   5410     printed  Apr 23, 2025@18:12:06                                                                                                                                                                                                     Page 2

DVB458P   ;ALB/RBS - ENV/PRE/POST-INSTALL FOR PATCH DVB*4*58 ; 1/11/07 1:34pm

 +1       ;;4.0;HINQ;**58**;03/25/92;Build 29

 +2       ;

 +3       ;This routine is the main install routine that will update the

 +4       ;DISABILITY CONDITION (#31) file with the new mapping of Rated

 +5       ;Disabilities (VA) VBA DX CODES to specific ICD DIAGNOSIS codes.

 +6       ;There are 3,085 ICD9 codes that will be added to the (#31) file.

 +7       ;

 +8       ;

 +9       ;no direct entry

           QUIT 

 +10      ;

 +11      ;

ENV       ;Main entry point for Environment check point.

 +1       ;

 +2        SET XPDABORT=""

 +3       ;checks programmer variables

 +4        DO PROGCHK(.XPDABORT)

 +5       ;check if patch install is running

 +6        DO ISRUNING(.XPDABORT)

 +7       ;

 +8        IF XPDABORT=""

               KILL XPDABORT

 +9        QUIT 

 +10      ;

 +11      ;

PRE       ;Main entry point for Pre-init items.

 +1       ;

 +2        QUIT 

 +3       ;

 +4       ;

POST      ;Main entry point for Post-init items.

 +1       ;

 +2       ;count of total ICD9 codes filed

           NEW DVBTOT

 +3       ;Closed Root global reference for error reporting

           NEW DVBTMP

 +4       ;remove data from #field 20 in file #31 and repopulate

 +5        IF $$VFIELD^DILFD(31,20)

               Begin DoDot:1

 +6                DO DELETE^DVB458P1

               End DoDot:1

 +7        SET DVBTMP=$NAME(^TMP("DVB458P",$JOB))

 +8        KILL @DVBTMP

 +9        SET @DVBTMP@(0)="PATCH DVB*4*58 POST-INSTALL^"_$$NOW^XLFDT

 +10       SET DVBTOT=0

 +11      ;

 +12       DO BMES^XPDUTL("  >>> *** Updating the DISABILITY CONDITION (#31) file...")

 +13       DO MES^XPDUTL("      *** Please be patient, this should take less than 5 minutes.")

 +14       DO MES^XPDUTL("  ")

 +15      ;

 +16      ;call to process (#31) file updates

 +17       DO POST^DVB458P1(DVBTMP,.DVBTOT)

 +18      ;

 +19       SET @DVBTMP@(0)=@DVBTMP@(0)_"^"_$$NOW^XLFDT_"^"_DVBTOT

 +20      ;

 +21       IF '$DATA(@DVBTMP@("ERROR"))

               Begin DoDot:1

 +22               DO BMES^XPDUTL("  >>> *** SUCCESS updating the DISABILITY CONDITION (#31) file.")

 +23               DO MES^XPDUTL("          Total RELATED ICD9 CODES filed: "_DVBTOT)

 +24      ;

               End DoDot:1

 +25      IF '$TEST

               Begin DoDot:1

 +26               DO BMES^XPDUTL("  >>> *** FAILURE updating the DISABILITY CONDITION (#31) file.")

 +27               DO BMES^XPDUTL("      Filing error's have occurred when adding the new RELATED ICD9 CODES.")

 +28               DO MES^XPDUTL("      Immediate resolution is necessary to maintain database integrity.")

 +29               DO BMES^XPDUTL("  A MailMan message has been sent to the installer of this patch")

 +30               DO MES^XPDUTL("  with a listing of the error's.")

 +31               DO BMES^XPDUTL("  Once these filing error's have been resolved, please re-run")

 +32               DO MES^XPDUTL("  the Post-Installation routine directly from programmer mode")

 +33               DO MES^XPDUTL("  by entering the following command:")

 +34               DO MES^XPDUTL("  ")

 +35               DO MES^XPDUTL("  D POST^DVB458P")

 +36               DO MES^XPDUTL("  ")

 +37               DO BMES^XPDUTL("  >>> I'm now creating and sending the MailMan message...")

 +38      ;

 +39               DO SENDMSG(DVBTMP,.DVBTOT)

 +40      ;

 +41               DO MES^XPDUTL("  >>> All done.")

               End DoDot:1

 +42      ;

 +43      ;cleanup temp file

 +44       KILL @DVBTMP

 +45       QUIT 

 +46      ;

 +47      ;

SENDMSG(DVBTMP,DVBTOT) ;send failure MailMan message to installer of patch

 +1       ;

 +2        NEW DIFROM,DVBMSG

 +3        NEW XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ

 +4        SET XMSUB="DVB*4.0*58 Patch Post-Install Error Listing"

 +5        SET XMTEXT="DVBMSG("

 +6        SET XMDUZ=.5

           SET (XMY(DUZ),XMY(XMDUZ))=""

 +7        SET DVBMSG(1)="Patch:  DVB*4.0*58 Automated Service Connected Designation"

 +8        SET DVBMSG(2)=""

 +9        SET DVBMSG(3)="The post-installation update of the DISABILITY CONDITION (#31) file"

 +10       SET DVBMSG(4)="has FAILED to successfully complete.  Filing error's have occurred when"

 +11       SET DVBMSG(5)="attempting to add the new data mapping of RELATED ICD9 CODES."

 +12       SET DVBMSG(6)=""

 +13       SET DVBMSG(7)="Immediate resolution of ALL error's is needed to maintain database integrity."

 +14       SET DVBMSG(8)=""

 +15       SET DVBMSG(9)="Once these filing error's have been resolved, please re-run"

 +16       SET DVBMSG(10)="the Post-Installation routine directly from programmer mode"

 +17       SET DVBMSG(11)="by entering the following command:"

 +18       SET DVBMSG(12)=""

 +19       SET DVBMSG(13)="D POST^DVB458P"

 +20       SET DVBMSG(14)=""

 +21       SET DVBMSG(15)="The new update run time should take less than 5 minutes to complete."

 +22       SET DVBMSG(16)=""

 +23       SET DVBMSG(17)=">>> Please review and resolve the following error's:"

 +24       SET DVBMSG(18)=""

 +25       SET DVBMSG(19)="*** DISABILITY CONDITION FILE (#31) FILING ERRORS ***"

 +26       SET DVBMSG(20)="-----------------------------------------------------"

 +27      ;

 +28      ;loop and list error's

 +29       NEW DVBICD,DVBHDR,DVBHDR1,DVBIEN,DVBLN,DVBMSS,DVBVBA,DVBDESC

 +30       SET DVBHDR="VBA DX CODE: "

           SET DVBHDR1="    ICD DIAGNOSIS CODE: "

 +31       SET DVBLN=21

           SET DVBVBA=0

 +32       FOR 

               SET DVBVBA=$ORDER(@DVBTMP@("ERROR",DVBVBA))

               if 'DVBVBA

                   QUIT 

               Begin DoDot:1

 +33               IF $DATA(@DVBTMP@("ERROR",DVBVBA,0))

                       Begin DoDot:2

 +34                       SET DVBMSS=DVBHDR_DVBVBA_" - "_$GET(@DVBTMP@("ERROR",DVBVBA,0))

 +35                       SET DVBMSG(DVBLN)=DVBMSS

                           SET DVBLN=DVBLN+1

                       End DoDot:2

                       QUIT 

 +36               KILL DVBDESC

                   DO FIND^DIC(31,"","","X",DVBVBA,,"C","","","DVBDESC")

 +37               SET DVBMSS=DVBHDR_DVBVBA_" - "_$EXTRACT($GET(DVBDESC("DILIST",1,1)),1,50)

 +38               SET DVBMSG(DVBLN)=DVBMSS

                   SET DVBLN=DVBLN+1

 +39               SET DVBIEN=0

 +40               FOR 

                       SET DVBIEN=$ORDER(@DVBTMP@("ERROR",DVBVBA,DVBIEN))

                       if 'DVBIEN

                           QUIT 

                       Begin DoDot:2

 +41                       SET DVBICD=""

 +42                       FOR 

                               SET DVBICD=$ORDER(@DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD))

                               if DVBICD=""

                                   QUIT 

                               Begin DoDot:3

 +43                               SET DVBMSS=DVBHDR1_DVBICD_" - "_$GET(@DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD))

 +44                               SET DVBMSG(DVBLN)=DVBMSS

                                   SET DVBLN=DVBLN+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +45       SET DVBMSG(DVBLN)=""

           SET DVBLN=DVBLN+1

 +46       SET DVBMSG(DVBLN)="<End of Report>"

 +47      ;

 +48       DO ^XMD

 +49       QUIT 

 +50      ;

 +51      ;

PROGCHK(XPDABORT) ;checks for necessary programmer variables

 +1       ;

 +2        IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")

               Begin DoDot:1

 +3                DO BMES^XPDUTL("*****")

 +4                DO MES^XPDUTL("Your programming variables are not set up properly.")

 +5                DO MES^XPDUTL("Installation aborted.")

 +6                DO MES^XPDUTL("*****")

 +7                SET XPDABORT=2

               End DoDot:1

 +8        QUIT 

 +9       ;

 +10      ;

ISRUNING(XPDABORT) ;check if patch install is running

 +1       ;

 +2        IF $DATA(^TMP("DVB458P"))

               Begin DoDot:1

 +3                DO BMES^XPDUTL("*****")

 +4                DO MES^XPDUTL("This patch is currently being Installed.  Try later.")

 +5                DO MES^XPDUTL("Installation aborted.")

 +6                DO MES^XPDUTL("*****")

 +7                SET XPDABORT=2

               End DoDot:1

 +8        QUIT