Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORP028

RORP028.m

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