RORP029 ;ALB/TK - CCR PRE/POST-INSTALL PATCH 29 ;29 Jul 2014 4:02 PM
;;1.5;CLINICAL CASE REGISTRIES;**29**;Feb 17, 2006;Build 18
;
; This routine uses the following IAs:
; #3277 OWNSKEY^XUSRB (supported)
; #10141 BMES^XPDUTL
; MES^XPDUTL
; #2056 GET1^DIQ (supported)
; #2053 UPDATE^DIE (supported)
; #2054 CLEAN^DILF (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*29 APR 2016 T KOPP Patch 29 pre and post install
;******************************************************************************
;******************************************************************************
;
Q
;Pre-Install routine for Patch 29
PRE ;
; CHECK FOR ROR VA IRM KEY, ABORT IF USER DOES NOT POSSESS
N RORKEYOK
D BMES^XPDUTL("Verifying installing user has the ROR VA IRM security key")
D OWNSKEY^XUSRB(.RORKEYOK,"ROR VA IRM",DUZ)
I '$G(RORKEYOK(0)) D Q
. S XPDABORT=1
. D BMES^XPDUTL("****** INSTALL ABORTED!!! ******")
. D BMES^XPDUTL("This patch can only be installed by a user who is assigned the ROR VA IRM key")
. D BMES^XPDUTL("Restart the installation again once the appropriate key has been assigned")
D BMES^XPDUTL(" User has the ROR VA IRM key - OK to install")
Q
;
;Post-Install routine for Patch 29
POST ;
D BMES^XPDUTL("Post install started")
D BMES^XPDUTL("Adding new reports to all registries")
D UPDREG
;
D BMES^XPDUTL("Adding new selection panel to reports")
D UPDPAN
;
D CLEAN^DILF
D BMES^XPDUTL("Post install completed")
Q
;
UPDREG ; Add new reports to all registries
N CT,DIERR,RORDATA,REGNAME,REGIEN,RORERR,RORFDA,RORMSG,X,Y,Z
S REGIEN=0 F S REGIEN=$O(^ROR(798.1,REGIEN)) Q:'REGIEN D
. ; Extract field #27 AVAILABLE REPORTS - Quit if "24,25" already exists in the record . Add ,24,25 to report list
. ; VA HEPB registry does not have report 25
. S RORDATA=$$GET1^DIQ(798.1,REGIEN_",",27,"I")
. S REGNAME=$P($$REGNAME^RORUTL01(REGIEN),U)
. I RORDATA[$S(REGNAME'="VA HEPB":"24,25",1:",24") D Q
.. D BMES^XPDUTL(" o New reports already exist for registry #"_REGIEN)
. K RORFDA,RORMSG
. S RORFDA(798.1,REGIEN_",",27)=RORDATA_",24"_$S(REGNAME'="VA HEPB":",25",1:"")
. D UPDATE^DIE("","RORFDA",,"RORMSG")
. I $D(DIERR) D Q
.. K RORERR
.. D DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
.. M RORMSG=RORERR
.. K RORERR
.. S RORERR(1)=" Update of registry "_$P($G(^ROR(798.1,REGIEN,0)),U)_" with new reports"
.. S RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
.. S RORERR(3)=""
.. S Z=0,CT=3 F S Z=$O(RORMSG("DIERR",1,"TEXT",Z)) Q:'Z S CT=CT+1,RORERR(CT)=$J("",10)_$G(RORMSG("DIERR",1,"TEXT",Z))
.. S CT=CT+1,RORERR(CT)=" "
.. D MES^XPDUTL(.RORERR)
D COMPL
Q
;
UPDPAN ; Add new panel to all reports with OTHER DIAGNOSIS panel
N CT,DIERR,P1,P2,RORDATA,RORRPT,RORERR,RORFDA,RORMSG,X,Y,Z
S RORRPT=0 F S RORRPT=$O(^ROR(799.34,RORRPT)) Q:'RORRPT D
. ; Extract field #1 PARAMETER PANELS - Quit if ",190," already exists in the record . Add ,190 after ,180
. S RORDATA=$$GET1^DIQ(799.34,RORRPT_",",1,"I")
. Q:RORDATA'["180"
. I RORDATA[",180,190" D Q
.. D BMES^XPDUTL(" o New selection panel 190 already exists for report #"_RORRPT)
. K RORFDA,RORMSG
. S P1=$P(RORDATA,",180"),P2=$P(RORDATA,",180",2)
. S RORFDA(799.34,RORRPT_",",1)=P1_",180,190"_P2
. D UPDATE^DIE("","RORFDA",,"RORMSG")
. I $D(DIERR) D Q
.. K RORERR
.. D DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
.. M RORMSG=RORERR
.. K RORERR
.. S RORERR(1)=" Update of report "_$P($G(^ROR(799.34,RORRPT,0)),U)_" with new panel"
.. S RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
.. S RORERR(3)=""
.. S Z=0,CT=3 F S Z=$O(RORMSG("DIERR",1,"TEXT",Z)) Q:'Z S CT=CT+1,RORERR(CT)=$J("",10)_$G(RORMSG("DIERR",1,"TEXT",Z))
.. S CT=CT+1,RORERR(CT)=" "
.. D MES^XPDUTL(.RORERR)
D COMPL
Q
;
COMPL ;
D BMES^XPDUTL(" >> Step complete")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORP029 4397 printed Apr 09, 2024@20:48:25 Page 2
RORP029 ;ALB/TK - CCR PRE/POST-INSTALL PATCH 29 ;29 Jul 2014 4:02 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**29**;Feb 17, 2006;Build 18
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #3277 OWNSKEY^XUSRB (supported)
+5 ; #10141 BMES^XPDUTL
+6 ; MES^XPDUTL
+7 ; #2056 GET1^DIQ (supported)
+8 ; #2053 UPDATE^DIE (supported)
+9 ; #2054 CLEAN^DILF (supported)
+10 ;
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ; --- ROUTINE MODIFICATION LOG ---
+14 ;
+15 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+16 ;----------- ---------- ----------- ----------------------------------------
+17 ;ROR*1.5*29 APR 2016 T KOPP Patch 29 pre and post install
+18 ;******************************************************************************
+19 ;******************************************************************************
+20 ;
+21 QUIT
+22 ;Pre-Install routine for Patch 29
PRE ;
+1 ; CHECK FOR ROR VA IRM KEY, ABORT IF USER DOES NOT POSSESS
+2 NEW RORKEYOK
+3 DO BMES^XPDUTL("Verifying installing user has the ROR VA IRM security key")
+4 DO OWNSKEY^XUSRB(.RORKEYOK,"ROR VA IRM",DUZ)
+5 IF '$GET(RORKEYOK(0))
Begin DoDot:1
+6 SET XPDABORT=1
+7 DO BMES^XPDUTL("****** INSTALL ABORTED!!! ******")
+8 DO BMES^XPDUTL("This patch can only be installed by a user who is assigned the ROR VA IRM key")
+9 DO BMES^XPDUTL("Restart the installation again once the appropriate key has been assigned")
End DoDot:1
QUIT
+10 DO BMES^XPDUTL(" User has the ROR VA IRM key - OK to install")
+11 QUIT
+12 ;
+13 ;Post-Install routine for Patch 29
POST ;
+1 DO BMES^XPDUTL("Post install started")
+2 DO BMES^XPDUTL("Adding new reports to all registries")
+3 DO UPDREG
+4 ;
+5 DO BMES^XPDUTL("Adding new selection panel to reports")
+6 DO UPDPAN
+7 ;
+8 DO CLEAN^DILF
+9 DO BMES^XPDUTL("Post install completed")
+10 QUIT
+11 ;
UPDREG ; Add new reports to all registries
+1 NEW CT,DIERR,RORDATA,REGNAME,REGIEN,RORERR,RORFDA,RORMSG,X,Y,Z
+2 SET REGIEN=0
FOR
SET REGIEN=$ORDER(^ROR(798.1,REGIEN))
if 'REGIEN
QUIT
Begin DoDot:1
+3 ; Extract field #27 AVAILABLE REPORTS - Quit if "24,25" already exists in the record . Add ,24,25 to report list
+4 ; VA HEPB registry does not have report 25
+5 SET RORDATA=$$GET1^DIQ(798.1,REGIEN_",",27,"I")
+6 SET REGNAME=$PIECE($$REGNAME^RORUTL01(REGIEN),U)
+7 IF RORDATA[$SELECT(REGNAME'="VA HEPB":"24,25",1:",24")
Begin DoDot:2
+8 DO BMES^XPDUTL(" o New reports already exist for registry #"_REGIEN)
End DoDot:2
QUIT
+9 KILL RORFDA,RORMSG
+10 SET RORFDA(798.1,REGIEN_",",27)=RORDATA_",24"_$SELECT(REGNAME'="VA HEPB":",25",1:"")
+11 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+12 IF $DATA(DIERR)
Begin DoDot:2
+13 KILL RORERR
+14 DO DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
+15 MERGE RORMSG=RORERR
+16 KILL RORERR
+17 SET RORERR(1)=" Update of registry "_$PIECE($GET(^ROR(798.1,REGIEN,0)),U)_" with new reports"
+18 SET RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+19 SET RORERR(3)=""
+20 SET Z=0
SET CT=3
FOR
SET Z=$ORDER(RORMSG("DIERR",1,"TEXT",Z))
if 'Z
QUIT
SET CT=CT+1
SET RORERR(CT)=$JUSTIFY("",10)_$GET(RORMSG("DIERR",1,"TEXT",Z))
+21 SET CT=CT+1
SET RORERR(CT)=" "
+22 DO MES^XPDUTL(.RORERR)
End DoDot:2
QUIT
End DoDot:1
+23 DO COMPL
+24 QUIT
+25 ;
UPDPAN ; Add new panel to all reports with OTHER DIAGNOSIS panel
+1 NEW CT,DIERR,P1,P2,RORDATA,RORRPT,RORERR,RORFDA,RORMSG,X,Y,Z
+2 SET RORRPT=0
FOR
SET RORRPT=$ORDER(^ROR(799.34,RORRPT))
if 'RORRPT
QUIT
Begin DoDot:1
+3 ; Extract field #1 PARAMETER PANELS - Quit if ",190," already exists in the record . Add ,190 after ,180
+4 SET RORDATA=$$GET1^DIQ(799.34,RORRPT_",",1,"I")
+5 if RORDATA'["180"
QUIT
+6 IF RORDATA[",180,190"
Begin DoDot:2
+7 DO BMES^XPDUTL(" o New selection panel 190 already exists for report #"_RORRPT)
End DoDot:2
QUIT
+8 KILL RORFDA,RORMSG
+9 SET P1=$PIECE(RORDATA,",180")
SET P2=$PIECE(RORDATA,",180",2)
+10 SET RORFDA(799.34,RORRPT_",",1)=P1_",180,190"_P2
+11 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+12 IF $DATA(DIERR)
Begin DoDot:2
+13 KILL RORERR
+14 DO DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
+15 MERGE RORMSG=RORERR
+16 KILL RORERR
+17 SET RORERR(1)=" Update of report "_$PIECE($GET(^ROR(799.34,RORRPT,0)),U)_" with new panel"
+18 SET RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+19 SET RORERR(3)=""
+20 SET Z=0
SET CT=3
FOR
SET Z=$ORDER(RORMSG("DIERR",1,"TEXT",Z))
if 'Z
QUIT
SET CT=CT+1
SET RORERR(CT)=$JUSTIFY("",10)_$GET(RORMSG("DIERR",1,"TEXT",Z))
+21 SET CT=CT+1
SET RORERR(CT)=" "
+22 DO MES^XPDUTL(.RORERR)
End DoDot:2
QUIT
End DoDot:1
+23 DO COMPL
+24 QUIT
+25 ;
COMPL ;
+1 DO BMES^XPDUTL(" >> Step complete")
+2 QUIT
+3 ;
