- 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 Feb 18, 2025@23:08:59 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 ;