RORP028 ;ALB/TK ENV CK, PRE and POST INSTALL - PATCH 28 ; 18 Feb 2016 6:23 PM
;;1.5;CLINICAL CASE REGISTRIES;**28**;Feb 17, 2006;Build 66
;
;*****************************************************************************
;*****************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- --------- ----------- ----------------------------------------
;ROR*1.5*28 APR 2016 T KOPP Added routine for env check, pre/post
; install
;
;******************************************************************************
;******************************************************************************
;
; SUPPORTED CALLS:
; RTN^%ZTLOAD #10063
; STAT^%ZTLOAD #10063
; BMES^XPDUTL #10141
; MES^XPDUTL #10141
; BLD^DIALOG #2050
; UPDATE^DIE #2053
; FMADD^XLFDT #10103
; NOW^XLFDT #10103
; FMTE^XLFDT #10103
; CLEAN^DILF #2054
; GET1^DIQ #2056
; ^DIR #10026
; FIND1^DIC #2051
;
ENV ; Environment check
S XPDNOQUE=1 ; disable queuing
Q
;
PRE ; Patch pre-install
N RC,ZTSK,RORBUF,RORMES
; Check for ROR INITIALIZE task running
D BMES^XPDUTL(" *** Checking to be sure ROR INITIALIZE task is not already running")
S RC=0
D RTN^%ZTLOAD("RORSET02","RORBUF")
S ZTSK="" F S ZTSK=$O(RORBUF(ZTSK)) Q:ZTSK="" D I $G(ZTSK(1))=2 S RC=-1 Q
. D STAT^%ZTLOAD
;--- Display error message if option is running
I RC<0 D S XPDABORT=2 Q
. K RORMES
. D BMES^XPDUTL($$MSG^RORERR20(RC,,XPDNM))
. D BMES^XPDUTL("")
. S RORMES(1)=" >> ROR INITIALIZE task is already running. Task # is "_ZTSK
. S RORMES(2)=" This task must complete or be terminated before the install can continue"
. S RORMES(3)=" Restart this patch install when this task is not running"
. S RORMES(4)=" "
. D MES^XPDUTL(.RORMES)
S RORPARM("DEVELOPER")=1
N RORI,REGIEN,RORREG,Z,X,Y,DIR
K ^XTMP("ROR_NO_INIT") ; Will contain any pre-initialized registries not to be reinitialized
D XTMPHDR^RORUTL01("ROR_NO_INIT",7,"CCR REGISTRIES NOT TO BE RE-INITIALIZED")
F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP028")),";;",2),U) Q:RORREG="" D Q:$G(XPDABORT)
. S REGIEN=$$REGIEN^RORUTL02(RORREG)
. Q:REGIEN'>0 ; new registry doesn't yet exist
. ; Check if registry is already initiated (has a value in HDT field)
. S Z=$$GET1^DIQ(798.1,REGIEN_",",21.05,"I")
. I Z'="" D Q
.. S DIR(0)="YA",DIR("A",1)=" >> New registry "_RORREG_"(ien #"_REGIEN_") has already completed initialization"
.. S DIR("A")="Do you want to rerun its initialization?: ",DIR("B")="NO"
.. W ! D ^DIR K DIR W !
.. I $D(DIRUT)!($D(DIROUT)) S XPDABORT=2 K ^XTMP("ROR_NO_INIT") D BMES^XPDUTL("INSTALL ABORTED") Q
.. I Y'=1 S ^XTMP("ROR_NO_INIT",REGIEN)=""
Q
;
POST ; Patch post-install
N CT,RORI,RORREG,REGIEN,Z
N RORPARM
S RORPARM("DEVELOPER")=1
D BMES^XPDUTL("POST INSTALL START")
;
D BMES^XPDUTL(">> Adding new panel to DAA Lab Monitoring report")
D NEWPANEL
; Update Knee/Hip replacement registries short description
D BMES^XPDUTL(">> Updating Short Description for 2 Registries")
D UPDNM
;
D BMES^XPDUTL(">> Updating List Items for new registries")
D UPDLIST,COMPL
;
D BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
N RORKIDS,RORERR,RORFDA,CT,DIERR,X,Y
S RORKIDS=1
F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP028")),";;",2),U) Q:RORREG="" D
. S REGIEN=$$REGIEN^RORUTL02(RORREG)
. Q:REGIEN'>0
. I $D(^XTMP("ROR_NO_INIT",REGIEN)) D Q
.. S RORERR(1)=" o New registry "_RORREG_"(ien #"_REGIEN_") is already initialized"
.. S RORERR(2)=" You have chosen not to re-initialize this registry"
.. S RORERR(3)=" "
.. D MES^XPDUTL(.RORERR)
.. K RORERR
. ;
. K RORFDA,RORMSG,RORERR
. S RORFDA(798.1,REGIEN_",",1)=2850101
. S RORFDA(798.1,REGIEN_",",19.1)=""
. S RORFDA(798.1,REGIEN_",",21.05)=""
. D UPDATE^DIE(,"RORFDA",,"RORMSG")
. I $D(DIERR) D
.. K RORERR
.. M RORERR=RORMSG
.. D DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
.. M RORMSG=RORERR
.. K RORERR
.. S RORERR(1)=" New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
.. S RORERR(2)=" and may not initialize correctly. 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 ^RORSET02
K ^XTMP("ROR_NO_INIT")
D COMPL
;
D BMES^XPDUTL(">> Setting flag for back pull of problem list for HIV/HEPC registries")
D XTMPHDR^RORUTL01("ROR_ONETIME_PROBLEM_LIST_EXTRACT",60,"ONE TIME PROBLEM LIST BACK PULL PATCH 28")
S ^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT",1)=1
D COMPL
;
D CLEAN^DILF
D BMES^XPDUTL("POST INSTALL COMPLETE")
Q
;
NEWREG ; List of new registries to initialize
;;VA CROHNS
;;VA DEMENTIA
;;VA HEPB
;;VA THYROID CA
;;VA UC
;;
;
NEWPANEL ; For DAA Lab Monitoring report - add panel 55 after ,24,
N RORRPT,RORMSG,RORPAN,RORERR,RORFDA,X,Y,DIERR
S RORRPT=$$FIND1^DIC(799.34,,"X","DAA Lab Monitoring")
S RORPAN=$G(^ROR(799.34,RORRPT,1))
K RORFDA,RORMSG
I RORPAN[",24,55," D Q
. D BMES^XPDUTL(" o New panel already exists for registry")
. D COMPL
I RORPAN'[",24,55," D
. S RORFDA(799.34,RORRPT_",",1)=$P(RORPAN,",24,")_",24,55,"_$P(RORPAN,",24,",2)
. 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
;
UPDNM ;
N DIERR,ROR,ROR1,ROR2,RORFDA,RORMSG,RORERR,X,Y
F ROR="VA TOTAL KNEE","VA TOTAL HIP" D
. S ROR1=$$FIND1^DIC(798.1,,"X",ROR)
. I ROR1'>0 D Q
.. D BMES^XPDUTL(" o "_ROR_" registry does not exist"),COMPL
. S ROR2=$P($G(^ROR(798.1,ROR1,0)),U,4)
. ;
. I ROR2[" Registry" D Q
.. D BMES^XPDUTL(" o "_ROR_" registry description was already updated")
. ;
. K RORFDA,RORMSG,DIERR,RORERR
. S ROR2=ROR2_" Registry"
. S RORFDA(798.1,ROR1_",",4)=ROR2
. D UPDATE^DIE("","RORFDA",,"RORMSG")
. I $D(DIERR) D Q
.. K RORERR
.. D DBS^RORERR("RORMSG",-112,,,798.1,ROR1)
.. M RORMSG=RORERR
.. K RORERR
.. S RORERR(1)=" Update of the "_ROR_" registry description was not successful"
.. S RORERR(2)=" 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 BMES^XPDUTL(" o "_ROR_" registry description updated")
D COMPL
Q
;
COMPL ;
D BMES^XPDUTL(" >> Step complete")
Q
;
LISTITEM ; Entries to add to file 799.1 text^group^code
;;eGFR by CKD-EPI^7^3
;;eGFR by MDRD^7^2
;;Creatinine clearance by Cockcroft-Gault^7^1
;;FIB-4^6^4
;;APRI^6^3
;;MELD-Na^6^2
;;MELD^6^1
;;BMI^5^1
;;Registry Lab^3^1
;;
;
; Update ROR LIST ITEM file (#799.1) for new registries
UPDLIST ;
N RORI,RORI1,RORREG,RORDATA,REGIEN,Z,CT,DIERR,RORFDA,RORMSG,RORERR
F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP028")),";;",2),U) Q:RORREG="" D
. S REGIEN=$$REGIEN^RORUTL02(RORREG)
. I REGIEN>0 D
.. F RORI1=1:1 S RORDATA=$P($T(@("LISTITEM+"_RORI1_"^RORP028")),";;",2) Q:RORDATA="" D
... Q:$D(^ROR(799.1,"KEY",+$P(RORDATA,U,2),REGIEN,+$P(RORDATA,U,3))) ; Entry already exists
... K RORFDA,RORMSG,RORERR,DIERR
... S RORFDA(799.1,"?+1,",.01)=$P(RORDATA,U)
... S RORFDA(799.1,"?+1,",.02)=$P(RORDATA,U,2)
... S RORFDA(799.1,"?+1,",.03)=REGIEN
... S RORFDA(799.1,"?+1,",.04)=$P(RORDATA,U,3)
... D UPDATE^DIE(,"RORFDA",,"RORMSG")
... I $G(DIERR) D
.... K RORERR
.... S RORERR(1)=" New entry for "_RORREG_"(ien #"_REGIEN_") encountered the following error"
.... S RORERR(2)=" and was not added to the ROR LIST ITEM file."
.... S RORERR(3)=" (Data = "_RORDATA_")"
.... S RORERR(4)=" Please report this error to your CCR contact:"
.... S RORERR(5)=""
.... S Z=0,CT=5 F S Z=$O(RORMSG("DIERR",1,"TEXT",Z)) Q:'Z S CT=CT+1,RORERR(CT)=$J("",6)_$G(RORMSG("DIERR",1,"TEXT",Z))
.... S CT=CT+1,RORERR(CT)=" "
.... D MES^XPDUTL(.RORERR)
Q
;
; Sets the DIR array from the post-install question #3 (suspension start time)
POSQ3(DIR) ;
K:$G(XPDQUES("POSQ2"))'=1 DIR
Q:'$D(DIR)
D BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
Q
;
; Sets the DIR array from the post-install question #4 (suspension end time)
POSQ4(DIR) ;
K:$G(XPDQUES("POSQ2"))'=1 DIR
Q:'$D(DIR)
S DIR("A")="Suspension end time"
; Make sure end time entered is later than end time start
S DIR(0)="D^::R^K:(Y#1)'>(XPDQUES(""POSQ3"")#1) X"
D BLD^DIALOG(7980000.012,,,"DIR(""?"")","S")
Q
;
; Updates the DIR array from the post-install question #5 (schedule time for ROR INITIALIZE task)
POSQ5(DIR) ;
Q:'$D(DIR)
N ROREDT
; Set earliest date to schedule to 15 minutes from 'NOW'
S ROREDT=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)
; Strip seconds
S ROREDT=$P(ROREDT,".",1)_"."_$E($P(ROREDT,".",2),1,4)
; Make sure future date/time is entered
S $P(DIR(0),U,3)=("K:Y<"_ROREDT_" X")
S DIR("B")=$$FMTE^XLFDT(ROREDT,2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORP028 9866 printed Apr 09, 2024@20:47:15 Page 2
RORP028 ;ALB/TK ENV CK, PRE and POST INSTALL - PATCH 28 ; 18 Feb 2016 6:23 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**28**;Feb 17, 2006;Build 66
+2 ;
+3 ;*****************************************************************************
+4 ;*****************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- --------- ----------- ----------------------------------------
+9 ;ROR*1.5*28 APR 2016 T KOPP Added routine for env check, pre/post
+10 ; install
+11 ;
+12 ;******************************************************************************
+13 ;******************************************************************************
+14 ;
+15 ; SUPPORTED CALLS:
+16 ; RTN^%ZTLOAD #10063
+17 ; STAT^%ZTLOAD #10063
+18 ; BMES^XPDUTL #10141
+19 ; MES^XPDUTL #10141
+20 ; BLD^DIALOG #2050
+21 ; UPDATE^DIE #2053
+22 ; FMADD^XLFDT #10103
+23 ; NOW^XLFDT #10103
+24 ; FMTE^XLFDT #10103
+25 ; CLEAN^DILF #2054
+26 ; GET1^DIQ #2056
+27 ; ^DIR #10026
+28 ; FIND1^DIC #2051
+29 ;
ENV ; Environment check
+1 ; disable queuing
SET XPDNOQUE=1
+2 QUIT
+3 ;
PRE ; Patch pre-install
+1 NEW RC,ZTSK,RORBUF,RORMES
+2 ; Check for ROR INITIALIZE task running
+3 DO BMES^XPDUTL(" *** Checking to be sure ROR INITIALIZE task is not already running")
+4 SET RC=0
+5 DO RTN^%ZTLOAD("RORSET02","RORBUF")
+6 SET ZTSK=""
FOR
SET ZTSK=$ORDER(RORBUF(ZTSK))
if ZTSK=""
QUIT
Begin DoDot:1
+7 DO STAT^%ZTLOAD
End DoDot:1
IF $GET(ZTSK(1))=2
SET RC=-1
QUIT
+8 ;--- Display error message if option is running
+9 IF RC<0
Begin DoDot:1
+10 KILL RORMES
+11 DO BMES^XPDUTL($$MSG^RORERR20(RC,,XPDNM))
+12 DO BMES^XPDUTL("")
+13 SET RORMES(1)=" >> ROR INITIALIZE task is already running. Task # is "_ZTSK
+14 SET RORMES(2)=" This task must complete or be terminated before the install can continue"
+15 SET RORMES(3)=" Restart this patch install when this task is not running"
+16 SET RORMES(4)=" "
+17 DO MES^XPDUTL(.RORMES)
End DoDot:1
SET XPDABORT=2
QUIT
+18 SET RORPARM("DEVELOPER")=1
+19 NEW RORI,REGIEN,RORREG,Z,X,Y,DIR
+20 ; Will contain any pre-initialized registries not to be reinitialized
KILL ^XTMP("ROR_NO_INIT")
+21 DO XTMPHDR^RORUTL01("ROR_NO_INIT",7,"CCR REGISTRIES NOT TO BE RE-INITIALIZED")
+22 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP028")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+23 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+24 ; new registry doesn't yet exist
if REGIEN'>0
QUIT
+25 ; Check if registry is already initiated (has a value in HDT field)
+26 SET Z=$$GET1^DIQ(798.1,REGIEN_",",21.05,"I")
+27 IF Z'=""
Begin DoDot:2
+28 SET DIR(0)="YA"
SET DIR("A",1)=" >> New registry "_RORREG_"(ien #"_REGIEN_") has already completed initialization"
+29 SET DIR("A")="Do you want to rerun its initialization?: "
SET DIR("B")="NO"
+30 WRITE !
DO ^DIR
KILL DIR
WRITE !
+31 IF $DATA(DIRUT)!($DATA(DIROUT))
SET XPDABORT=2
KILL ^XTMP("ROR_NO_INIT")
DO BMES^XPDUTL("INSTALL ABORTED")
QUIT
+32 IF Y'=1
SET ^XTMP("ROR_NO_INIT",REGIEN)=""
End DoDot:2
QUIT
End DoDot:1
if $GET(XPDABORT)
QUIT
+33 QUIT
+34 ;
POST ; Patch post-install
+1 NEW CT,RORI,RORREG,REGIEN,Z
+2 NEW RORPARM
+3 SET RORPARM("DEVELOPER")=1
+4 DO BMES^XPDUTL("POST INSTALL START")
+5 ;
+6 DO BMES^XPDUTL(">> Adding new panel to DAA Lab Monitoring report")
+7 DO NEWPANEL
+8 ; Update Knee/Hip replacement registries short description
+9 DO BMES^XPDUTL(">> Updating Short Description for 2 Registries")
+10 DO UPDNM
+11 ;
+12 DO BMES^XPDUTL(">> Updating List Items for new registries")
+13 DO UPDLIST
DO COMPL
+14 ;
+15 DO BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
+16 NEW RORKIDS,RORERR,RORFDA,CT,DIERR,X,Y
+17 SET RORKIDS=1
+18 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP028")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+19 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+20 if REGIEN'>0
QUIT
+21 IF $DATA(^XTMP("ROR_NO_INIT",REGIEN))
Begin DoDot:2
+22 SET RORERR(1)=" o New registry "_RORREG_"(ien #"_REGIEN_") is already initialized"
+23 SET RORERR(2)=" You have chosen not to re-initialize this registry"
+24 SET RORERR(3)=" "
+25 DO MES^XPDUTL(.RORERR)
+26 KILL RORERR
End DoDot:2
QUIT
+27 ;
+28 KILL RORFDA,RORMSG,RORERR
+29 SET RORFDA(798.1,REGIEN_",",1)=2850101
+30 SET RORFDA(798.1,REGIEN_",",19.1)=""
+31 SET RORFDA(798.1,REGIEN_",",21.05)=""
+32 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+33 IF $DATA(DIERR)
Begin DoDot:2
+34 KILL RORERR
+35 MERGE RORERR=RORMSG
+36 DO DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
+37 MERGE RORMSG=RORERR
+38 KILL RORERR
+39 SET RORERR(1)=" New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
+40 SET RORERR(2)=" and may not initialize correctly. Please report this error to your CCR contact:"
+41 SET RORERR(3)=""
+42 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))
+43 SET CT=CT+1
SET RORERR(CT)=" "
+44 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+45 DO ^RORSET02
+46 KILL ^XTMP("ROR_NO_INIT")
+47 DO COMPL
+48 ;
+49 DO BMES^XPDUTL(">> Setting flag for back pull of problem list for HIV/HEPC registries")
+50 DO XTMPHDR^RORUTL01("ROR_ONETIME_PROBLEM_LIST_EXTRACT",60,"ONE TIME PROBLEM LIST BACK PULL PATCH 28")
+51 SET ^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT",1)=1
+52 DO COMPL
+53 ;
+54 DO CLEAN^DILF
+55 DO BMES^XPDUTL("POST INSTALL COMPLETE")
+56 QUIT
+57 ;
NEWREG ; List of new registries to initialize
+1 ;;VA CROHNS
+2 ;;VA DEMENTIA
+3 ;;VA HEPB
+4 ;;VA THYROID CA
+5 ;;VA UC
+6 ;;
+7 ;
NEWPANEL ; For DAA Lab Monitoring report - add panel 55 after ,24,
+1 NEW RORRPT,RORMSG,RORPAN,RORERR,RORFDA,X,Y,DIERR
+2 SET RORRPT=$$FIND1^DIC(799.34,,"X","DAA Lab Monitoring")
+3 SET RORPAN=$GET(^ROR(799.34,RORRPT,1))
+4 KILL RORFDA,RORMSG
+5 IF RORPAN[",24,55,"
Begin DoDot:1
+6 DO BMES^XPDUTL(" o New panel already exists for registry")
+7 DO COMPL
End DoDot:1
QUIT
+8 IF RORPAN'[",24,55,"
Begin DoDot:1
+9 SET RORFDA(799.34,RORRPT_",",1)=$PIECE(RORPAN,",24,")_",24,55,"_$PIECE(RORPAN,",24,",2)
+10 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+11 IF $DATA(DIERR)
Begin DoDot:2
+12 KILL RORERR
+13 DO DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
+14 MERGE RORMSG=RORERR
+15 KILL RORERR
+16 SET RORERR(1)=" Update of report "_$PIECE($GET(^ROR(799.34,RORRPT,0)),U)_" with new panel"
+17 SET RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+18 SET RORERR(3)=""
+19 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))
+20 SET CT=CT+1
SET RORERR(CT)=" "
+21 DO MES^XPDUTL(.RORERR)
End DoDot:2
QUIT
End DoDot:1
+22 DO COMPL
+23 QUIT
+24 ;
UPDNM ;
+1 NEW DIERR,ROR,ROR1,ROR2,RORFDA,RORMSG,RORERR,X,Y
+2 FOR ROR="VA TOTAL KNEE","VA TOTAL HIP"
Begin DoDot:1
+3 SET ROR1=$$FIND1^DIC(798.1,,"X",ROR)
+4 IF ROR1'>0
Begin DoDot:2
+5 DO BMES^XPDUTL(" o "_ROR_" registry does not exist")
DO COMPL
End DoDot:2
QUIT
+6 SET ROR2=$PIECE($GET(^ROR(798.1,ROR1,0)),U,4)
+7 ;
+8 IF ROR2[" Registry"
Begin DoDot:2
+9 DO BMES^XPDUTL(" o "_ROR_" registry description was already updated")
End DoDot:2
QUIT
+10 ;
+11 KILL RORFDA,RORMSG,DIERR,RORERR
+12 SET ROR2=ROR2_" Registry"
+13 SET RORFDA(798.1,ROR1_",",4)=ROR2
+14 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+15 IF $DATA(DIERR)
Begin DoDot:2
+16 KILL RORERR
+17 DO DBS^RORERR("RORMSG",-112,,,798.1,ROR1)
+18 MERGE RORMSG=RORERR
+19 KILL RORERR
+20 SET RORERR(1)=" Update of the "_ROR_" registry description was not successful"
+21 SET RORERR(2)=" Please report this error to your CCR contact:"
+22 SET RORERR(3)=""
+23 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))
+24 SET CT=CT+1
SET RORERR(CT)=" "
+25 DO MES^XPDUTL(.RORERR)
End DoDot:2
QUIT
+26 DO BMES^XPDUTL(" o "_ROR_" registry description updated")
End DoDot:1
+27 DO COMPL
+28 QUIT
+29 ;
COMPL ;
+1 DO BMES^XPDUTL(" >> Step complete")
+2 QUIT
+3 ;
LISTITEM ; Entries to add to file 799.1 text^group^code
+1 ;;eGFR by CKD-EPI^7^3
+2 ;;eGFR by MDRD^7^2
+3 ;;Creatinine clearance by Cockcroft-Gault^7^1
+4 ;;FIB-4^6^4
+5 ;;APRI^6^3
+6 ;;MELD-Na^6^2
+7 ;;MELD^6^1
+8 ;;BMI^5^1
+9 ;;Registry Lab^3^1
+10 ;;
+11 ;
+12 ; Update ROR LIST ITEM file (#799.1) for new registries
UPDLIST ;
+1 NEW RORI,RORI1,RORREG,RORDATA,REGIEN,Z,CT,DIERR,RORFDA,RORMSG,RORERR
+2 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP028")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+3 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+4 IF REGIEN>0
Begin DoDot:2
+5 FOR RORI1=1:1
SET RORDATA=$PIECE($TEXT(@("LISTITEM+"_RORI1_"^RORP028")),";;",2)
if RORDATA=""
QUIT
Begin DoDot:3
+6 ; Entry already exists
if $DATA(^ROR(799.1,"KEY",+$PIECE(RORDATA,U,2),REGIEN,+$PIECE(RORDATA,U,3)))
QUIT
+7 KILL RORFDA,RORMSG,RORERR,DIERR
+8 SET RORFDA(799.1,"?+1,",.01)=$PIECE(RORDATA,U)
+9 SET RORFDA(799.1,"?+1,",.02)=$PIECE(RORDATA,U,2)
+10 SET RORFDA(799.1,"?+1,",.03)=REGIEN
+11 SET RORFDA(799.1,"?+1,",.04)=$PIECE(RORDATA,U,3)
+12 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:4
+14 KILL RORERR
+15 SET RORERR(1)=" New entry for "_RORREG_"(ien #"_REGIEN_") encountered the following error"
+16 SET RORERR(2)=" and was not added to the ROR LIST ITEM file."
+17 SET RORERR(3)=" (Data = "_RORDATA_")"
+18 SET RORERR(4)=" Please report this error to your CCR contact:"
+19 SET RORERR(5)=""
+20 SET Z=0
SET CT=5
FOR
SET Z=$ORDER(RORMSG("DIERR",1,"TEXT",Z))
if 'Z
QUIT
SET CT=CT+1
SET RORERR(CT)=$JUSTIFY("",6)_$GET(RORMSG("DIERR",1,"TEXT",Z))
+21 SET CT=CT+1
SET RORERR(CT)=" "
+22 DO MES^XPDUTL(.RORERR)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ; Sets the DIR array from the post-install question #3 (suspension start time)
POSQ3(DIR) ;
+1 if $GET(XPDQUES("POSQ2"))'=1
KILL DIR
+2 if '$DATA(DIR)
QUIT
+3 DO BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
+4 QUIT
+5 ;
+6 ; Sets the DIR array from the post-install question #4 (suspension end time)
POSQ4(DIR) ;
+1 if $GET(XPDQUES("POSQ2"))'=1
KILL DIR
+2 if '$DATA(DIR)
QUIT
+3 SET DIR("A")="Suspension end time"
+4 ; Make sure end time entered is later than end time start
+5 SET DIR(0)="D^::R^K:(Y#1)'>(XPDQUES(""POSQ3"")#1) X"
+6 DO BLD^DIALOG(7980000.012,,,"DIR(""?"")","S")
+7 QUIT
+8 ;
+9 ; Updates the DIR array from the post-install question #5 (schedule time for ROR INITIALIZE task)
POSQ5(DIR) ;
+1 if '$DATA(DIR)
QUIT
+2 NEW ROREDT
+3 ; Set earliest date to schedule to 15 minutes from 'NOW'
+4 SET ROREDT=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)
+5 ; Strip seconds
+6 SET ROREDT=$PIECE(ROREDT,".",1)_"."_$EXTRACT($PIECE(ROREDT,".",2),1,4)
+7 ; Make sure future date/time is entered
+8 SET $PIECE(DIR(0),U,3)=("K:Y<"_ROREDT_" X")
+9 SET DIR("B")=$$FMTE^XLFDT(ROREDT,2)
+10 QUIT
+11 ;
