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

RORP036.m

Go to the documentation of this file. 
  1. RORP036 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 36 ;26 MAY 2020  1:07 PM
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**36**;Feb 17, 2006;Build 20
  1.  ;
  1.  ;*****************************************************************************
  1.  ;*****************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;  
  1.  ;PKG/PATCH    DATE       DEVELOPER    MODIFICATION
  1.  ;-----------  ---------  -----------  ----------------------------------------
  1.  ;ROR*1.5*36   Nov 2019   M FERRARESE  Added routine for env check, pre/post
  1.  ;                                     install Adding COVID19 registry          
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ; 
  1.  ; SUPPORTED CALLS:
  1.  ;  RTN^%ZTLOAD   #10063
  1.  ;  STAT^%ZTLOAD  #10063
  1.  ;  BMES^XPDUTL   #10141
  1.  ;  OWNSKEY^XUSRB #3277 (supported)  
  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.  ;  ADD^XPAR      #2263
  1.  ;  DEL^XPAR      #2263
  1.  ;  CLEAN^DILF    #2054
  1.  ;
  1. ENV ; --- Environment check
  1.  S XPDNOQUE=1 ; disable queuing
  1.  Q
  1.  ;
  1. PRE ; --- Pre-Install routine for Patch 36
  1.  ; CHECK FOR ROR VA IRM KEY, ABORT IF USER DOES NOT POSSESS
  1.  N RORKEYOK
  1.  D BMES^XPDUTL("Verifying installing user has the ROR VA IRM security key")
  1.  D OWNSKEY^XUSRB(.RORKEYOK,"ROR VA IRM",DUZ)
  1.  I '$G(RORKEYOK(0)) D  Q
  1.  . S XPDABORT=1
  1.  . D BMES^XPDUTL("****** INSTALL ABORTED!!! ******")
  1.  . D BMES^XPDUTL("This patch can only be installed by a user who is assigned the ROR VA IRM key")
  1.  . D BMES^XPDUTL("Restart the installation again once the appropriate key has been assigned")
  1.  D BMES^XPDUTL("  User has the ROR VA IRM key - OK to install")
  1.  ;
  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 OPTION^%ZTLOAD("ROR INITIALIZE",.RORBUF)
  1.  S ZTSK=0 F  S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK  D  I $G(ZTSK(1))=2 S RC=-1 Q
  1.  . D STAT^%ZTLOAD
  1.  S ZTSK=0 F  S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK  K @RORBUF@(ZTSK) ;clean up
  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.  ; Is ROR TASK option running
  1.  D BMES^XPDUTL("   *** Checking to be sure ROR TASK is not running")
  1.  S RC=0 K RORBUF
  1.  D OPTION^%ZTLOAD("ROR TASK",.RORBUF) ;returns data in ^TMP($J)
  1.  S ZTSK=0
  1.  F  S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK  D  I $G(ZTSK(1))=2 S RC=-76 Q
  1.  . D STAT^%ZTLOAD
  1.  ;don't want to K ^TMP($J). May kill something that is needed elsewhere.
  1.  S ZTSK=0 F  S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK  K @RORBUF@(ZTSK)
  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,,,"ROR TASK"))
  1.  . D BMES^XPDUTL("")
  1.  . S RORMES(1)="   >> ROR TASK is already running.  Task # is "_ZTSK
  1.  . S RORMES(2)="      This task must complete 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_"^RORP036")),";;",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 Y<0 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 ; --- Post-Install routine for Patch 36
  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 Future Appointments panel to reports")
  1.  ;D UPDPANEL
  1.  ;D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  ;D BMES^XPDUTL(">> Checking VA GENERIC drug file...")
  1.  ;D GENDRG
  1.  ;D BMES^XPDUTL("   >> Step complete
  1.  ;
  1.  D BMES^XPDUTL(">> Adding CPT and ICD-9 procedures to ROR ICD SEARCH file for new registries")
  1.  D UPDPROC
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL("Updating List Items for new registries")
  1.  D UPDLIST
  1.  D BMES^XPDUTL("    >> Step complete")
  1.  ;
  1.  D BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
  1.  N RORKIDS,RORERR,CT,DIERR
  1.  S RORKIDS=1
  1.  F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP036")),";;",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)="   It appears new registry "_RORREG_"(ien #"_REGIEN_") has already been 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.  I '$O(^XTMP("ROR_NO_INIT",0)) D ^RORSET02 ;don't initialize if the user doesn't want to
  1.  K ^XTMP("ROR_NO_INIT")
  1.  D BMES^XPDUTL("   >> Step complete")
  1.  ;D BMES^XPDUTL("Updating the Drug matching entries...") D EN^RORUTL22
  1.  ;D BMES^XPDUTL("Tasking nightly job to gather drug matching...") D TASK^RORUTL22
  1.  D CLEAN^DILF
  1.  D BMES^XPDUTL("POST INSTALL COMPLETE")
  1.  Q
  1. GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
  1.  ; clean up 799.51 if pointers are bad
  1.  ; New HIV registry Drugs : DORAVIRINE - DORAVIRINE/LAMIVUDINE/TENOFORVIR - DOLUTEGRAVIR/LAMIVUDINE
  1.  ;               
  1.  ;
  1.  ;
  1.  ;N DIC,X,DIK,DA,RORNAME,Y
  1.  ;S DIC=799.51,DIC(0)="MNZ"
  1.  ;F RORNAME="DORAVIRINE","DORAVIRINE/LAMIVUD/TENOFOVIR","DOLUTEGRAVIR/LAMIVUDINE" D
  1.  ;.S X=RORNAME D ^DIC Q:+Y<0
  1.  ;.Q:+$P(Y(0),U,4)>0
  1.  ;.S DA=+Y,DIK="^ROR(799.51," D ^DIK
  1.  ;.D BMES^XPDUTL("WARNING*** Missing entry in VA GENERIC file 50.6.")
  1.  Q
  1.  ; 
  1. UPDPANEL ;
  1.  ; For parameter panel field, add 29, after ,24, right below the Additional Identifiers panel for
  1.  ;      Diagnosis    ( REPORT CODE 13)
  1.  ;      Procedure    ( REPORT CODE 15)
  1.  ;
  1.  ;N CT,RORRPT,RORMSG,RORPAN,RORERR,RORFDA,Z,Z1,DIERR
  1.  ;S RORRPT=0 F  S RORRPT=$O(^ROR(799.34,RORRPT)) Q:'RORRPT  S RORPAN=$P($G(^ROR(799.34,RORRPT,0)),U,4) D:$S(RORPAN=13:1,RORPAN=15:1,1:0)
  1.  ;. S Z1=$G(^ROR(799.34,RORRPT,1))
  1.  ;. K RORFDA,RORMSG
  1.  ;. I Z1[",24,29," D  Q
  1.  ;. .D BMES^XPDUTL("   o New panel already exists for registry")
  1.  ;. I Z1'[",24,29," D 
  1.  ;. . I Z1[",24,",Z1'[",24,29," S RORFDA(799.34,RORRPT_",",1)=$P(Z1,",24,")_",24,29,"_$P(Z1,",24,",2)
  1.  ;. Q:'$D(RORFDA)
  1.  ;. D UPDATE^DIE("","RORFDA",,"RORMSG")
  1.  ;. I $D(DIERR) D
  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.  Q
  1.  ;
  1. POSQ3(DIR) ; --- Sets the DIR array from the post-install question #3 (suspension start time)
  1.  K:$G(XPDQUES("POSQ2"))'=1 DIR
  1.  Q:'$D(DIR)
  1.  D BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
  1.  Q
  1.  ;
  1. POSQ4(DIR) ; --- Sets the DIR array from the post-install question #4  (suspension end time)
  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. POSQ5(DIR) ; --- Updates the DIR array from the post-install question #5  (schedule time for ROR INITIALIZE task)
  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.  ;
  1. NEWREG ; --- List of new registries to initialize
  1.  ;;VA COVID19
  1.  ;;
  1.  ;
  1. UPDPROC ; --- Adds ICD dx/procedure codes and CPT codes to the new registries in ROR ICD SEARCH (#798.5)
  1.  ; Delete if already there  ,"COVID19"
  1.  N CT,I1,DA,DIK,X,Y,Z,RORDATA,RORFDA,RORI,RORPROC,RORREG,RORIEN,RORFDA1
  1.  F RORI="COVID19" S DIC="^ROR(798.5,",X="VA "_RORI,DIC(0)="" D ^DIC I Y>0 D
  1.  . S DIK="^ROR(798.5,",DA=+Y D ^DIK
  1.  F RORI=1:1 S RORDATA=$P($T(ICDPROC+RORI),";;",2) Q:RORDATA=""  D
  1.  . S RORREG=$P(RORDATA,U)
  1.  . I RORREG'="" D  Q
  1.  .. ; add new registry top level entry
  1.  .. D:$D(RORFDA) ADD7985(.RORFDA,RORIEN,$P($G(^ROR(798.1,+$G(RORIEN),0)),U)) ;Store 'previous registry' if RORFDA exists
  1.  .. K RORFDA1
  1.  .. S RORFDA1(798.5,"+1,",.01)=RORREG,RORIEN="",CT=0
  1.  .. D ADD7985(.RORFDA1,.RORIEN,RORREG)
  1.  .. S Z=+$O(RORIEN(0)),Z=$G(RORIEN(Z))
  1.  .. K RORIEN,RORFDA1 S RORIEN=Z
  1.  . I $P(RORDATA,U,2)'="" D  Q  ; Add ICD-codes to the entry
  1.  .. S RORPROC=$P(RORDATA,U,2)
  1.  .. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.52,"+"_CT_","_RORIEN_",",.01)=X
  1.  . I $P(RORDATA,U,3)'="" D  Q  ; Add ICPT codes to the entry
  1.  .. S RORPROC=$P(RORDATA,U,3)
  1.  .. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.53,"+"_CT_","_RORIEN_",",.01)=X
  1.  . I $P(RORDATA,U,4)'="" D  Q  ; Add ICD diagnosis codes to the entry
  1.  .. S RORPROC=$P(RORDATA,U,4)
  1.  .. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.51,"+"_CT_","_RORIEN_",",.01)=X
  1.  .. ;
  1. TEST I $D(RORFDA) D ADD7985(.RORFDA,RORIEN,RORREG)
  1.  D CLEAN^DILF
  1.  Q
  1.  ;
  1. ADD7985(RORFDA,RORIEN,RORREG) ; Adds procedures to the entries in the files
  1.  N RORMSG,DIERR
  1.  D UPDATE^DIE("E","RORFDA","RORIEN","RORMSG")
  1.  I $G(DIERR) D
  1.  . N Z,CT,RORERR
  1.  . M RORERR=RORMSG
  1.  . D DBS^RORERR("RORMSG",-112,,,798.5,RORREG)
  1.  . M RORMSG=RORERR
  1.  . K RORERR
  1.  . S RORERR(1)="     Adding procedures for new registry "_RORREG_" encountered the"
  1.  . S RORERR(2)="     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.  Q
  1.  ;
  1. ICDPROC ; Registry name^PTF ICD Procedure codes, separated by commas^PTF CPT codes, separated by commas^ ICD DIAGNOSIS codes
  1.  ;;VA COVID19
  1.  ;;^^^U07.1
  1.  Q
  1.  ;
  1. UPDLIST ; --- Update ROR LIST ITEM file (#799.1) for new registries
  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_"^RORP036")),";;",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_"^RORP036")),";;",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. LISTITEM ; --- Entries to add to ROR LIST ITEM 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.  ;;Default COVID-19^4^99
  1.  ;;COVID-19 Virus Tests^3^1
  1.  ;;COVID-19 Serology Tests^3^2
  1.  ;;
  1.  ;