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 ---[H[J[2J[HDVB458P 5410 printed Nov 22, 2024@17:07:48 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
