RORP037 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 37 ;31 AUG 2020 1:07 PM
;;1.5;CLINICAL CASE REGISTRIES;**37**;Feb 17, 2006;Build 9
;
;*****************************************************************************
;*****************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- --------- ----------- ----------------------------------------
;ROR*1.5*37 AUG 2020 M FERRARESE Added routine for env check, pre/post
; install Adding RECENT PATIENTS registry
;******************************************************************************
;******************************************************************************
;
; SUPPORTED CALLS:
; RTN^%ZTLOAD #10063
; BMES^XPDUTL #10141
; OWNSKEY^XUSRB #3277 (supported)
; BLD^DIALOG #2050
; UPDATE^DIE #2053
; FMADD^XLFDT #10103
; ADD^XPAR #2263
; CLEAN^DILF #2054
; FILE^DICN #10009 (supported)
; UPDATE^DIE #2053 (supported)
ENV ; --- Environment check
S XPDNOQUE=1 ; disable queuing
Q
;
PRE ; --- Pre-Install routine for Patch 37
; 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")
;
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 OPTION^%ZTLOAD("ROR INITIALIZE",.RORBUF)
S ZTSK=0 F S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK D I $G(ZTSK(1))=2 S RC=-1 Q
. D STAT^%ZTLOAD
S ZTSK=0 F S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK K @RORBUF@(ZTSK) ;clean up
;--- 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)
; Is ROR TASK option running
D BMES^XPDUTL(" *** Checking to be sure ROR TASK is not running")
S RC=0 K RORBUF
D OPTION^%ZTLOAD("ROR TASK",.RORBUF) ;returns data in ^TMP($J)
S ZTSK=0
F S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK D I $G(ZTSK(1))=2 S RC=-76 Q
. D STAT^%ZTLOAD
;don't want to K ^TMP($J). May kill something that is needed elsewhere.
S ZTSK=0 F S ZTSK=$O(@RORBUF@(ZTSK)) Q:'ZTSK K @RORBUF@(ZTSK)
;--- Display error message if option is running
I RC<0 D S XPDABORT=2 Q
. K RORMES
. D BMES^XPDUTL($$MSG^RORERR20(RC,,,"ROR TASK"))
. D BMES^XPDUTL("")
. S RORMES(1)=" >> ROR TASK is already running. Task # is "_ZTSK
. S RORMES(2)=" This task must complete 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_"^RORP037")),";;",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 Y<0 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 ; --- Post-Install routine for Patch 37
N CT,RORI,RORREG,REGIEN,Z
N RORPARM
S RORPARM("DEVELOPER")=1
D BMES^XPDUTL("POST INSTALL START")
;
D BMES^XPDUTL(">> Adding Admission and visit fields to ROR METADATA file")
D UPDMETA
D BMES^XPDUTL(" >> Step complete")
;
D BMES^XPDUTL(">> Adding new LOINC codes to the VA COVID19 registry parameters")
D LOINC
D BMES^XPDUTL(" >> Step complete")
;
D BMES^XPDUTL(">> Adding data to the EXTRACT RESULTS multiple for the VA COVID19 registry parameters")
D COVLOINC
D BMES^XPDUTL(" >> Step complete")
;
D BMES^XPDUTL(">> Adding new selection rule to SELECTION RULE multiple for the VA COVID19 registry parameters")
D COVSEL
D BMES^XPDUTL(" >> Step complete")
;
D BMES^XPDUTL("Updating List Items for new registries")
D UPDLIST
D BMES^XPDUTL(" >> Step complete")
;
D BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
N RORKIDS,RORERR,CT,DIERR
S RORKIDS=1
F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP037")),";;",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)=" It appears new registry "_RORREG_"(ien #"_REGIEN_") has already been 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)
I '$O(^XTMP("ROR_NO_INIT",0)) D ^RORSET02 ;don't initialize if the user doesn't want to
K ^XTMP("ROR_NO_INIT")
D BMES^XPDUTL(" >> Step complete")
D CLEAN^DILF
D BMES^XPDUTL("POST INSTALL COMPLETE")
Q
;
UPDMETA ;
; Add 1 new Data Element to file 45 in the ROR METADATA file (delete first if they already exist)
N DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR,RORPARM,RORFLG
S RORPARM("DEVELOPER")=1
F RORI=1:1:1 S RORDATA=$P($T(META45+RORI),";;",2) D
. S RORDATA(RORI)=RORDATA
. S X=$P(RORDATA,U),DA(1)=45,DIC="^ROR(799.2,"_DA(1)_",2," D ^DIC
. I Y>0 S DA(1)=45,DIK="^ROR(799.2,"_DA(1)_",2,",DA=+Y D ^DIK
S RORIEN(1)=45,RORDATA=0
F RORI=1:1 S RORDATA=$P($T(META45+RORI),";;",2) Q:RORDATA="" D
. S RORIENS="+"_(RORI+1)_",45,"
. S RORFDA(799.22,RORIENS,.01)=$P(RORDATA,U)
. S RORFDA(799.22,RORIENS,.02)=$P(RORDATA,U,2)
. S RORFDA(799.22,RORIENS,2)=$P(RORDATA,U,3)
. S RORFDA(799.22,RORIENS,4)=$P(RORDATA,U,4)
. S RORFDA(799.22,RORIENS,1)=$P(RORDATA,U,5)
. S RORFDA(799.22,RORIENS,6)=$P(RORDATA,U,6)
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
I $D(DIERR) S RORFLG=1 D RORERR
;Add 1 new Data Element to file 9000010 in the ROR METADATA file (delete first if they already exist)
N DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR
F RORI=1:1:1 S RORDATA=$P($T(METAVST+RORI),";;",2) D
. S RORDATA(RORI)=RORDATA
. S X=$P(RORDATA,U),DA(1)=9000010,DIC="^ROR(799.2,"_DA(1)_",2," D ^DIC
. I Y>0 S DA(1)=9000010,DIK="^ROR(799.2,"_DA(1)_",2,",DA=+Y D ^DIK
S RORIEN(1)=9000010,RORDATA=0
F RORI=1:1 S RORDATA=$P($T(METAVST+RORI),";;",2) Q:RORDATA="" D
. S RORIENS="+"_(RORI+1)_",9000010,"
. S RORFDA(799.22,RORIENS,.01)=$P(RORDATA,U)
. S RORFDA(799.22,RORIENS,.02)=$P(RORDATA,U,2)
. S RORFDA(799.22,RORIENS,2)=$P(RORDATA,U,3)
. S RORFDA(799.22,RORIENS,4)=$P(RORDATA,U,4)
. S RORFDA(799.22,RORIENS,1)=$P(RORDATA,U,5)
. S RORFDA(799.22,RORIENS,6)=$P(RORDATA,U,6)
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
I $D(DIERR) D RORERR
Q
;
LOINC ;Add new LOINC codes to the VA COVID19 lab search criterion in
;ROR LAB SEARCH file #798.9. Don't add them if they already exist. Don't
;add the 'dash' or the number following it (checksum)
;**********************************************************************
N DIC,RORIEN,X,Y
S RORIEN=$O(^ROR(798.9,"B","VA COVID19",0)) I 'RORIEN D ;COVID19 top level IEN
. S DIC(0)="",DIC="^ROR(798.9,",X="VA COVID19" D FILE^DICN S RORIEN=$P(Y,U,1)
. I RORIEN>0 N RORFDA,RORMSG D
. . S RORFDA(798.9,RORIEN_",",.09)=0 ;National registry
. . S RORFDA(798.9,RORIEN_",",1)=0 ; Active
. . D UPDATE^DIE(,"RORFDA",,"RORMSG")
. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.9)
. K DIC,X,Y
.Q
Q:RORIEN<0
N I,COV19IEN,RORDATA,RORLOINC,RORTAG,ROR K RORMSG1
S COV19IEN=$O(^ROR(798.9,"B","VA COVID19",0))
;--- add LOINC codes to the VA COVID19 search criteria
F I=1:1 S RORTAG="COVID19+"_I,ROR=$P($T(@RORTAG),";;",2) Q:ROR="" D
. S RORLOINC=$P(ROR,"-",1)
. ;don't add if it's already in the global
. Q:($D(^ROR(798.9,COV19IEN,1,"B",RORLOINC)))
. S RORDATA(1,798.92,"+2,"_COV19IEN_",",.01)=$G(RORLOINC)
. S RORDATA(1,798.92,"+2,"_COV19IEN_",",1)=6
. D UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
K RORDATA,RORMSG1
;
Q
GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
; clean up 799.51 if pointers are bad
; New HIV registry Drugs :
;
;
;
;N DIC,X,DIK,DA,RORNAME,Y
;S DIC=799.51,DIC(0)="MNZ"
;F RORNAME="DORAVIRINE","DORAVIRINE/LAMIVUD/TENOFOVIR","DOLUTEGRAVIR/LAMIVUDINE" D
;.S X=RORNAME D ^DIC Q:+Y<0
;.Q:+$P(Y(0),U,4)>0
;.S DA=+Y,DIK="^ROR(799.51," D ^DIK
;.D BMES^XPDUTL("WARNING*** Missing entry in VA GENERIC file 50.6.")
Q
;
UPDPANEL ;
; For parameter panel field, add 29, after ,24, right below the Additional Identifiers panel for
; Diagnosis ( REPORT CODE 13)
; Procedure ( REPORT CODE 15)
;
;N CT,RORRPT,RORMSG,RORPAN,RORERR,RORFDA,Z,Z1,DIERR
;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)
;. S Z1=$G(^ROR(799.34,RORRPT,1))
;. K RORFDA,RORMSG
;. I Z1[",24,29," D Q
;. .D BMES^XPDUTL(" o New panel already exists for registry")
;. I Z1'[",24,29," D
;. . I Z1[",24,",Z1'[",24,29," S RORFDA(799.34,RORRPT_",",1)=$P(Z1,",24,")_",24,29,"_$P(Z1,",24,",2)
;. Q:'$D(RORFDA)
;. D UPDATE^DIE("","RORFDA",,"RORMSG")
;. I $D(DIERR) D
;.. 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)
Q
;
POSQ3(DIR) ; --- Sets the DIR array from the post-install question #3 (suspension start time)
K:$G(XPDQUES("POSQ2"))'=1 DIR
Q:'$D(DIR)
D BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
Q
;
POSQ4(DIR) ; --- Sets the DIR array from the post-install question #4 (suspension end time)
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
;
POSQ5(DIR) ; --- Updates the DIR array from the post-install question #5 (schedule time for ROR INITIALIZE task)
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
;
NEWREG ; --- List of new registries to initialize
;;VA RECENT PATIENTS
;;
;
UPDPROC ; --- Adds ICD dx/procedure codes and CPT codes to the new registries in ROR ICD SEARCH (#798.5)
; Delete if already there ,"COVID19"
;N CT,I1,DA,DIK,X,Y,Z,RORDATA,RORFDA,RORI,RORPROC,RORREG,RORIEN,RORFDA1
;F RORI="COVID19" S DIC="^ROR(798.5,",X="VA "_RORI,DIC(0)="" D ^DIC I Y>0 D
;. S DIK="^ROR(798.5,",DA=+Y D ^DIK
;F RORI=1:1 S RORDATA=$P($T(ICDPROC+RORI),";;",2) Q:RORDATA="" D
;. S RORREG=$P(RORDATA,U)
;. I RORREG'="" D Q
;.. ; add new registry top level entry
;.. D:$D(RORFDA) ADD7985(.RORFDA,RORIEN,$P($G(^ROR(798.1,+$G(RORIEN),0)),U)) ;Store 'previous registry' if RORFDA exists
;.. K RORFDA1
;.. S RORFDA1(798.5,"+1,",.01)=RORREG,RORIEN="",CT=0
;.. D ADD7985(.RORFDA1,.RORIEN,RORREG)
;.. S Z=+$O(RORIEN(0)),Z=$G(RORIEN(Z))
;.. K RORIEN,RORFDA1 S RORIEN=Z
;. I $P(RORDATA,U,2)'="" D Q ; Add ICD-codes to the entry
;.. S RORPROC=$P(RORDATA,U,2)
;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.52,"+"_CT_","_RORIEN_",",.01)=X
;. I $P(RORDATA,U,3)'="" D Q ; Add ICPT codes to the entry
;.. S RORPROC=$P(RORDATA,U,3)
;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.53,"+"_CT_","_RORIEN_",",.01)=X
;. I $P(RORDATA,U,4)'="" D Q ; Add ICD diagnosis codes to the entry
;.. S RORPROC=$P(RORDATA,U,4)
;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.51,"+"_CT_","_RORIEN_",",.01)=X
;.. ;
;TEST I $D(RORFDA) D ADD7985(.RORFDA,RORIEN,RORREG)
;D CLEAN^DILF
Q
;
ADD7985(RORFDA,RORIEN,RORREG) ; Adds procedures to the entries in the files
;N RORMSG,DIERR
;D UPDATE^DIE("E","RORFDA","RORIEN","RORMSG")
;I $G(DIERR) D
;. N Z,CT,RORERR
;. M RORERR=RORMSG
;. D DBS^RORERR("RORMSG",-112,,,798.5,RORREG)
;. M RORMSG=RORERR
;. K RORERR
;. S RORERR(1)=" Adding procedures for new registry "_RORREG_" encountered the"
;. S RORERR(2)=" 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)
Q
;
ICDPROC ; Registry name^PTF ICD Procedure codes, separated by commas^PTF CPT codes, separated by commas^ ICD DIAGNOSIS codes
;;
;;
Q
;
UPDLIST ; --- Update ROR LIST ITEM file (#799.1) for new registries
N RORI,RORI1,RORREG,RORDATA,REGIEN,Z,CT,DIERR,RORFDA,RORMSG,RORERR
F RORI=1:1 S RORREG=$P($P($T(@("NEWREG+"_RORI_"^RORP037")),";;",2),U) Q:RORREG="" D
. S REGIEN=$$REGIEN^RORUTL02(RORREG)
. I REGIEN>0 D
.. F RORI1=1:1 S RORDATA=$P($T(@("LISTITEM+"_RORI1_"^RORP037")),";;",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
;
LISTITEM ; --- Entries to add to ROR LIST ITEM 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
;;Recent Patients Medications^4^99
;;Recent Patients Lab Tests^3^1
;;
;
Q
;
;**********************************************************************
;New LOINC codes
;**********************************************************************
COVID19 ;
;;94307-6
;;94308-4
;;94309-2
;;94310-0
;;94311-8
;;94314-2
;;94315-9
;;94316-7
;;94500-6
;;94502-2
;;94533-7
;;94534-5
;;94558-4
;;94559-2
;;94565-9
;;94639-2
;;94640-0
;;94641-8
;;94647-5
;;94660-8
;;94756-4
;;94757-2
;;94758-0
;;94759-8
;;94760-6
;;94765-5
;;94766-3
;;94767-1
;;94819-0
;;94822-4
;;94845-5
;;95209-3
;;95406-5
;;95409-9
;;
;
;******************************************************************************
; Data to be added to ROR METADATA file (#799.2)
; DATA NAME^CODE^REQUIRED^VALUE TYPE^LOADER API^FIELD NUMBER
;******************************************************************************
META45 ; Data added to file 45 PTF
;;ADMISSION DATE^154^1^Internal^1^2
;;
;
Q
METAVST ; Data added to file 9000010 VISIT
;;VISIT/ADMIT DATE&TIME^155^1^Internal^1^.01
;;
;
Q
COLO ; Data added to file 798.1 subfile EXTRACTED RESULTS
;;*^^CH
;;
;
Q
SELRL ; NEW SELECTION RULE TO ADD
;;VA COVID19 LAB
;;
;
Q
RORERR ; ERROR
K RORERR
M RORERR=RORMSG
D DBS^RORERR("RORMSG",-112,,,799.22,RORIEN(1))
M RORMSG=RORERR
K RORERR
I $D(RORFLG) D
. S RORERR(1)=" Update to ROR METADATA "_RORIEN(1)_" entry has <<FAILED>>"
I $D(RORFLG1) D
. S RORERR(1)=" Update to LOINC and SUBSCRIPTS subfields has <<FAILED>>"
I $D(RORFLG2) D
. S RORERR(1)=" Update to SELECTION RULE multiple has <<FAILED>>"
S RORERR(2)=" "
S RORERR(3)=" Please report this error to your CCR contact:"
S RORERR(4)=" "
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)
Q
;
COVLOINC ; Adding data to the EXTRACTED RESULTS multiple. adding to the LOINC and SUBSCRIPTS Subfields.
N DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG1
S RORIEN=$O(^ROR(798.1,"B","VA COVID19",0)) Q:'RORIEN ;COVID19 top level IEN
S RORPARM("DEVELOPER")=1
F RORI=1:1:1 S RORDATA=$P($T(COLO+RORI),";;",2) D
. S RORDATA(RORI)=RORDATA
. S X=$P(RORDATA,U),DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",8," D ^DIC
. I Y>0 S DA(1)=52,DIK="^ROR(798.1,"_DA(1)_",8,",DA=+Y D ^DIK
S DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",8," D ^DIC
S RORIEN(1)=52
S RORIENS="+2"_","_RORIEN_","
S RORFDA(798.112,RORIENS,.01)="*"
S RORFDA(798.112,RORIENS,.03)="CH"
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
I $D(DIERR) S RORFLG1=1 D RORERR
Q
COVSEL ; Adding new selection to the SELECTION RULE multiple of 798.1 for COVID19
N DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG2
S RORIEN=$O(^ROR(798.1,"B","VA COVID19",0)) Q:'RORIEN ;COVID19 top level IEN
S RORPARM("DEVELOPER")=1
F RORI=1:1:1 S RORDATA=$P($T(SELRL+RORI),";;",2) D
. S RORDATA(RORI)=RORDATA
. S X=$P(RORDATA,U),DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",1," D ^DIC
. I Y>0 S DA(1)=RORIEN,DIK="^ROR(798.1,"_DA(1)_",1,",DA=+Y D ^DIK
S DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",1," D ^DIC
S RORIEN(1)=RORIEN
S RORIENS="+2"_","_RORIEN_","
S RORFDA(798.13,RORIENS,.01)=RORDATA
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
I $D(DIERR) S RORFLG2=1 D RORERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORP037 19984 printed Apr 09, 2024@20:50:18 Page 2
RORP037 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 37 ;31 AUG 2020 1:07 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**37**;Feb 17, 2006;Build 9
+2 ;
+3 ;*****************************************************************************
+4 ;*****************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- --------- ----------- ----------------------------------------
+9 ;ROR*1.5*37 AUG 2020 M FERRARESE Added routine for env check, pre/post
+10 ; install Adding RECENT PATIENTS registry
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ;
+14 ; SUPPORTED CALLS:
+15 ; RTN^%ZTLOAD #10063
+16 ; BMES^XPDUTL #10141
+17 ; OWNSKEY^XUSRB #3277 (supported)
+18 ; BLD^DIALOG #2050
+19 ; UPDATE^DIE #2053
+20 ; FMADD^XLFDT #10103
+21 ; ADD^XPAR #2263
+22 ; CLEAN^DILF #2054
+23 ; FILE^DICN #10009 (supported)
+24 ; UPDATE^DIE #2053 (supported)
ENV ; --- Environment check
+1 ; disable queuing
SET XPDNOQUE=1
+2 QUIT
+3 ;
PRE ; --- Pre-Install routine for Patch 37
+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 ;
+12 NEW RC,ZTSK,RORBUF,RORMES
+13 ; Check for ROR INITIALIZE task running
+14 DO BMES^XPDUTL(" *** Checking to be sure ROR INITIALIZE task is not already running")
+15 SET RC=0
+16 DO OPTION^%ZTLOAD("ROR INITIALIZE",.RORBUF)
+17 SET ZTSK=0
FOR
SET ZTSK=$ORDER(@RORBUF@(ZTSK))
if 'ZTSK
QUIT
Begin DoDot:1
+18 DO STAT^%ZTLOAD
End DoDot:1
IF $GET(ZTSK(1))=2
SET RC=-1
QUIT
+19 ;clean up
SET ZTSK=0
FOR
SET ZTSK=$ORDER(@RORBUF@(ZTSK))
if 'ZTSK
QUIT
KILL @RORBUF@(ZTSK)
+20 ;--- Display error message if option is running
+21 IF RC<0
Begin DoDot:1
+22 KILL RORMES
+23 DO BMES^XPDUTL($$MSG^RORERR20(RC,,XPDNM))
+24 DO BMES^XPDUTL("")
+25 SET RORMES(1)=" >> ROR INITIALIZE task is already running. Task # is "_ZTSK
+26 SET RORMES(2)=" This task must complete or be terminated before the install can continue"
+27 SET RORMES(3)=" Restart this patch install when this task is not running"
+28 SET RORMES(4)=" "
+29 DO MES^XPDUTL(.RORMES)
End DoDot:1
SET XPDABORT=2
QUIT
+30 ; Is ROR TASK option running
+31 DO BMES^XPDUTL(" *** Checking to be sure ROR TASK is not running")
+32 SET RC=0
KILL RORBUF
+33 ;returns data in ^TMP($J)
DO OPTION^%ZTLOAD("ROR TASK",.RORBUF)
+34 SET ZTSK=0
+35 FOR
SET ZTSK=$ORDER(@RORBUF@(ZTSK))
if 'ZTSK
QUIT
Begin DoDot:1
+36 DO STAT^%ZTLOAD
End DoDot:1
IF $GET(ZTSK(1))=2
SET RC=-76
QUIT
+37 ;don't want to K ^TMP($J). May kill something that is needed elsewhere.
+38 SET ZTSK=0
FOR
SET ZTSK=$ORDER(@RORBUF@(ZTSK))
if 'ZTSK
QUIT
KILL @RORBUF@(ZTSK)
+39 ;--- Display error message if option is running
+40 IF RC<0
Begin DoDot:1
+41 KILL RORMES
+42 DO BMES^XPDUTL($$MSG^RORERR20(RC,,,"ROR TASK"))
+43 DO BMES^XPDUTL("")
+44 SET RORMES(1)=" >> ROR TASK is already running. Task # is "_ZTSK
+45 SET RORMES(2)=" This task must complete before the install can continue."
+46 SET RORMES(3)=" Restart this patch install when this task is not running."
+47 SET RORMES(4)=" "
+48 DO MES^XPDUTL(.RORMES)
End DoDot:1
SET XPDABORT=2
QUIT
+49 SET RORPARM("DEVELOPER")=1
+50 NEW RORI,REGIEN,RORREG,Z,X,Y,DIR
+51 ; Will contain any pre-initialized registries not to be reinitialized
KILL ^XTMP("ROR_NO_INIT")
+52 DO XTMPHDR^RORUTL01("ROR_NO_INIT",7,"CCR REGISTRIES NOT TO BE RE-INITIALIZED")
+53 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP037")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+54 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+55 ; new registry doesn't yet exist
if REGIEN'>0
QUIT
+56 ; Check if registry is already initiated (has a value in HDT field)
+57 SET Z=$$GET1^DIQ(798.1,REGIEN_",",21.05,"I")
+58 IF Z'=""
Begin DoDot:2
+59 SET DIR(0)="YA"
SET DIR("A",1)=" >> New registry "_RORREG_"(ien #"_REGIEN_") has already completed initialization"
+60 SET DIR("A")="Do you want to rerun its initialization?: "
SET DIR("B")="NO"
+61 WRITE !
DO ^DIR
KILL DIR
WRITE !
+62 IF Y<0
SET XPDABORT=2
KILL ^XTMP("ROR_NO_INIT")
DO BMES^XPDUTL("INSTALL ABORTED")
QUIT
+63 IF Y'=1
SET ^XTMP("ROR_NO_INIT",REGIEN)=""
End DoDot:2
QUIT
End DoDot:1
if $GET(XPDABORT)
QUIT
+64 QUIT
+65 ;
POST ; --- Post-Install routine for Patch 37
+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 Admission and visit fields to ROR METADATA file")
+7 DO UPDMETA
+8 DO BMES^XPDUTL(" >> Step complete")
+9 ;
+10 DO BMES^XPDUTL(">> Adding new LOINC codes to the VA COVID19 registry parameters")
+11 DO LOINC
+12 DO BMES^XPDUTL(" >> Step complete")
+13 ;
+14 DO BMES^XPDUTL(">> Adding data to the EXTRACT RESULTS multiple for the VA COVID19 registry parameters")
+15 DO COVLOINC
+16 DO BMES^XPDUTL(" >> Step complete")
+17 ;
+18 DO BMES^XPDUTL(">> Adding new selection rule to SELECTION RULE multiple for the VA COVID19 registry parameters")
+19 DO COVSEL
+20 DO BMES^XPDUTL(" >> Step complete")
+21 ;
+22 DO BMES^XPDUTL("Updating List Items for new registries")
+23 DO UPDLIST
+24 DO BMES^XPDUTL(" >> Step complete")
+25 ;
+26 DO BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
+27 NEW RORKIDS,RORERR,CT,DIERR
+28 SET RORKIDS=1
+29 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP037")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+30 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+31 if REGIEN'>0
QUIT
+32 IF $DATA(^XTMP("ROR_NO_INIT",REGIEN))
Begin DoDot:2
+33 SET RORERR(1)=" It appears new registry "_RORREG_"(ien #"_REGIEN_") has already been initialized"
+34 SET RORERR(2)=" You have chosen not to re-initialize this registry"
+35 SET RORERR(3)=" "
+36 DO MES^XPDUTL(.RORERR)
+37 KILL RORERR
End DoDot:2
QUIT
+38 ;
+39 KILL RORFDA,RORMSG,RORERR
+40 SET RORFDA(798.1,REGIEN_",",1)=2850101
+41 SET RORFDA(798.1,REGIEN_",",19.1)=""
+42 SET RORFDA(798.1,REGIEN_",",21.05)=""
+43 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+44 IF $DATA(DIERR)
Begin DoDot:2
+45 KILL RORERR
+46 MERGE RORERR=RORMSG
+47 DO DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
+48 MERGE RORMSG=RORERR
+49 KILL RORERR
+50 SET RORERR(1)=" New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
+51 SET RORERR(2)=" and may not initialize correctly. Please report this error to your CCR contact:"
+52 SET RORERR(3)=""
+53 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))
+54 SET CT=CT+1
SET RORERR(CT)=" "
+55 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+56 ;don't initialize if the user doesn't want to
IF '$ORDER(^XTMP("ROR_NO_INIT",0))
DO ^RORSET02
+57 KILL ^XTMP("ROR_NO_INIT")
+58 DO BMES^XPDUTL(" >> Step complete")
+59 DO CLEAN^DILF
+60 DO BMES^XPDUTL("POST INSTALL COMPLETE")
+61 QUIT
+62 ;
UPDMETA ;
+1 ; Add 1 new Data Element to file 45 in the ROR METADATA file (delete first if they already exist)
+2 NEW DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR,RORPARM,RORFLG
+3 SET RORPARM("DEVELOPER")=1
+4 FOR RORI=1:1:1
SET RORDATA=$PIECE($TEXT(META45+RORI),";;",2)
Begin DoDot:1
+5 SET RORDATA(RORI)=RORDATA
+6 SET X=$PIECE(RORDATA,U)
SET DA(1)=45
SET DIC="^ROR(799.2,"_DA(1)_",2,"
DO ^DIC
+7 IF Y>0
SET DA(1)=45
SET DIK="^ROR(799.2,"_DA(1)_",2,"
SET DA=+Y
DO ^DIK
End DoDot:1
+8 SET RORIEN(1)=45
SET RORDATA=0
+9 FOR RORI=1:1
SET RORDATA=$PIECE($TEXT(META45+RORI),";;",2)
if RORDATA=""
QUIT
Begin DoDot:1
+10 SET RORIENS="+"_(RORI+1)_",45,"
+11 SET RORFDA(799.22,RORIENS,.01)=$PIECE(RORDATA,U)
+12 SET RORFDA(799.22,RORIENS,.02)=$PIECE(RORDATA,U,2)
+13 SET RORFDA(799.22,RORIENS,2)=$PIECE(RORDATA,U,3)
+14 SET RORFDA(799.22,RORIENS,4)=$PIECE(RORDATA,U,4)
+15 SET RORFDA(799.22,RORIENS,1)=$PIECE(RORDATA,U,5)
+16 SET RORFDA(799.22,RORIENS,6)=$PIECE(RORDATA,U,6)
End DoDot:1
+17 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+18 IF $DATA(DIERR)
SET RORFLG=1
DO RORERR
+19 ;Add 1 new Data Element to file 9000010 in the ROR METADATA file (delete first if they already exist)
+20 NEW DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR
+21 FOR RORI=1:1:1
SET RORDATA=$PIECE($TEXT(METAVST+RORI),";;",2)
Begin DoDot:1
+22 SET RORDATA(RORI)=RORDATA
+23 SET X=$PIECE(RORDATA,U)
SET DA(1)=9000010
SET DIC="^ROR(799.2,"_DA(1)_",2,"
DO ^DIC
+24 IF Y>0
SET DA(1)=9000010
SET DIK="^ROR(799.2,"_DA(1)_",2,"
SET DA=+Y
DO ^DIK
End DoDot:1
+25 SET RORIEN(1)=9000010
SET RORDATA=0
+26 FOR RORI=1:1
SET RORDATA=$PIECE($TEXT(METAVST+RORI),";;",2)
if RORDATA=""
QUIT
Begin DoDot:1
+27 SET RORIENS="+"_(RORI+1)_",9000010,"
+28 SET RORFDA(799.22,RORIENS,.01)=$PIECE(RORDATA,U)
+29 SET RORFDA(799.22,RORIENS,.02)=$PIECE(RORDATA,U,2)
+30 SET RORFDA(799.22,RORIENS,2)=$PIECE(RORDATA,U,3)
+31 SET RORFDA(799.22,RORIENS,4)=$PIECE(RORDATA,U,4)
+32 SET RORFDA(799.22,RORIENS,1)=$PIECE(RORDATA,U,5)
+33 SET RORFDA(799.22,RORIENS,6)=$PIECE(RORDATA,U,6)
End DoDot:1
+34 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+35 IF $DATA(DIERR)
DO RORERR
+36 QUIT
+37 ;
LOINC ;Add new LOINC codes to the VA COVID19 lab search criterion in
+1 ;ROR LAB SEARCH file #798.9. Don't add them if they already exist. Don't
+2 ;add the 'dash' or the number following it (checksum)
+3 ;**********************************************************************
+4 NEW DIC,RORIEN,X,Y
+5 ;COVID19 top level IEN
SET RORIEN=$ORDER(^ROR(798.9,"B","VA COVID19",0))
IF 'RORIEN
Begin DoDot:1
+6 SET DIC(0)=""
SET DIC="^ROR(798.9,"
SET X="VA COVID19"
DO FILE^DICN
SET RORIEN=$PIECE(Y,U,1)
+7 IF RORIEN>0
NEW RORFDA,RORMSG
Begin DoDot:2
+8 ;National registry
SET RORFDA(798.9,RORIEN_",",.09)=0
+9 ; Active
SET RORFDA(798.9,RORIEN_",",1)=0
+10 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+11 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,798.9)
End DoDot:2
+12 KILL DIC,X,Y
+13 QUIT
End DoDot:1
+14 if RORIEN<0
QUIT
+15 NEW I,COV19IEN,RORDATA,RORLOINC,RORTAG,ROR
KILL RORMSG1
+16 SET COV19IEN=$ORDER(^ROR(798.9,"B","VA COVID19",0))
+17 ;--- add LOINC codes to the VA COVID19 search criteria
+18 FOR I=1:1
SET RORTAG="COVID19+"_I
SET ROR=$PIECE($TEXT(@RORTAG),";;",2)
if ROR=""
QUIT
Begin DoDot:1
+19 SET RORLOINC=$PIECE(ROR,"-",1)
+20 ;don't add if it's already in the global
+21 if ($DATA(^ROR(798.9,COV19IEN,1,"B",RORLOINC)))
QUIT
+22 SET RORDATA(1,798.92,"+2,"_COV19IEN_",",.01)=$GET(RORLOINC)
+23 SET RORDATA(1,798.92,"+2,"_COV19IEN_",",1)=6
+24 DO UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
End DoDot:1
+25 KILL RORDATA,RORMSG1
+26 ;
+27 QUIT
GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
+1 ; clean up 799.51 if pointers are bad
+2 ; New HIV registry Drugs :
+3 ;
+4 ;
+5 ;
+6 ;N DIC,X,DIK,DA,RORNAME,Y
+7 ;S DIC=799.51,DIC(0)="MNZ"
+8 ;F RORNAME="DORAVIRINE","DORAVIRINE/LAMIVUD/TENOFOVIR","DOLUTEGRAVIR/LAMIVUDINE" D
+9 ;.S X=RORNAME D ^DIC Q:+Y<0
+10 ;.Q:+$P(Y(0),U,4)>0
+11 ;.S DA=+Y,DIK="^ROR(799.51," D ^DIK
+12 ;.D BMES^XPDUTL("WARNING*** Missing entry in VA GENERIC file 50.6.")
+13 QUIT
+14 ;
UPDPANEL ;
+1 ; For parameter panel field, add 29, after ,24, right below the Additional Identifiers panel for
+2 ; Diagnosis ( REPORT CODE 13)
+3 ; Procedure ( REPORT CODE 15)
+4 ;
+5 ;N CT,RORRPT,RORMSG,RORPAN,RORERR,RORFDA,Z,Z1,DIERR
+6 ;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)
+7 ;. S Z1=$G(^ROR(799.34,RORRPT,1))
+8 ;. K RORFDA,RORMSG
+9 ;. I Z1[",24,29," D Q
+10 ;. .D BMES^XPDUTL(" o New panel already exists for registry")
+11 ;. I Z1'[",24,29," D
+12 ;. . I Z1[",24,",Z1'[",24,29," S RORFDA(799.34,RORRPT_",",1)=$P(Z1,",24,")_",24,29,"_$P(Z1,",24,",2)
+13 ;. Q:'$D(RORFDA)
+14 ;. D UPDATE^DIE("","RORFDA",,"RORMSG")
+15 ;. I $D(DIERR) D
+16 ;.. K RORERR
+17 ;.. D DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
+18 ;.. M RORMSG=RORERR
+19 ;.. K RORERR
+20 ;.. S RORERR(1)=" Update of report "_$P($G(^ROR(799.34,RORRPT,0)),U)_" with new panel"
+21 ;.. S RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+22 ;.. S RORERR(3)=""
+23 ;.. 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))
+24 ;.. S CT=CT+1,RORERR(CT)=" "
+25 ;.. D MES^XPDUTL(.RORERR)
+26 QUIT
+27 ;
POSQ3(DIR) ; --- Sets the DIR array from the post-install question #3 (suspension start time)
+1 if $GET(XPDQUES("POSQ2"))'=1
KILL DIR
+2 if '$DATA(DIR)
QUIT
+3 DO BLD^DIALOG(7980000.011,,,"DIR(""?"")","S")
+4 QUIT
+5 ;
POSQ4(DIR) ; --- Sets the DIR array from the post-install question #4 (suspension end time)
+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 ;
POSQ5(DIR) ; --- Updates the DIR array from the post-install question #5 (schedule time for ROR INITIALIZE task)
+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 ;
NEWREG ; --- List of new registries to initialize
+1 ;;VA RECENT PATIENTS
+2 ;;
+3 ;
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"
+2 ;N CT,I1,DA,DIK,X,Y,Z,RORDATA,RORFDA,RORI,RORPROC,RORREG,RORIEN,RORFDA1
+3 ;F RORI="COVID19" S DIC="^ROR(798.5,",X="VA "_RORI,DIC(0)="" D ^DIC I Y>0 D
+4 ;. S DIK="^ROR(798.5,",DA=+Y D ^DIK
+5 ;F RORI=1:1 S RORDATA=$P($T(ICDPROC+RORI),";;",2) Q:RORDATA="" D
+6 ;. S RORREG=$P(RORDATA,U)
+7 ;. I RORREG'="" D Q
+8 ;.. ; add new registry top level entry
+9 ;.. D:$D(RORFDA) ADD7985(.RORFDA,RORIEN,$P($G(^ROR(798.1,+$G(RORIEN),0)),U)) ;Store 'previous registry' if RORFDA exists
+10 ;.. K RORFDA1
+11 ;.. S RORFDA1(798.5,"+1,",.01)=RORREG,RORIEN="",CT=0
+12 ;.. D ADD7985(.RORFDA1,.RORIEN,RORREG)
+13 ;.. S Z=+$O(RORIEN(0)),Z=$G(RORIEN(Z))
+14 ;.. K RORIEN,RORFDA1 S RORIEN=Z
+15 ;. I $P(RORDATA,U,2)'="" D Q ; Add ICD-codes to the entry
+16 ;.. S RORPROC=$P(RORDATA,U,2)
+17 ;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.52,"+"_CT_","_RORIEN_",",.01)=X
+18 ;. I $P(RORDATA,U,3)'="" D Q ; Add ICPT codes to the entry
+19 ;.. S RORPROC=$P(RORDATA,U,3)
+20 ;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.53,"+"_CT_","_RORIEN_",",.01)=X
+21 ;. I $P(RORDATA,U,4)'="" D Q ; Add ICD diagnosis codes to the entry
+22 ;.. S RORPROC=$P(RORDATA,U,4)
+23 ;.. F I1=1:1:$L(RORPROC,",") S X=$P(RORPROC,",",I1) I X'="" S CT=CT+1,RORFDA(798.51,"+"_CT_","_RORIEN_",",.01)=X
+24 ;.. ;
+25 ;TEST I $D(RORFDA) D ADD7985(.RORFDA,RORIEN,RORREG)
+26 ;D CLEAN^DILF
+27 QUIT
+28 ;
ADD7985(RORFDA,RORIEN,RORREG) ; Adds procedures to the entries in the files
+1 ;N RORMSG,DIERR
+2 ;D UPDATE^DIE("E","RORFDA","RORIEN","RORMSG")
+3 ;I $G(DIERR) D
+4 ;. N Z,CT,RORERR
+5 ;. M RORERR=RORMSG
+6 ;. D DBS^RORERR("RORMSG",-112,,,798.5,RORREG)
+7 ;. M RORMSG=RORERR
+8 ;. K RORERR
+9 ;. S RORERR(1)=" Adding procedures for new registry "_RORREG_" encountered the"
+10 ;. S RORERR(2)=" following error. Please report this error to your CCR contact:"
+11 ;. S RORERR(3)=""
+12 ;. 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))
+13 ;. S CT=CT+1,RORERR(CT)=" "
+14 ;. D MES^XPDUTL(.RORERR)
+15 QUIT
+16 ;
ICDPROC ; Registry name^PTF ICD Procedure codes, separated by commas^PTF CPT codes, separated by commas^ ICD DIAGNOSIS codes
+1 ;;
+2 ;;
+3 QUIT
+4 ;
UPDLIST ; --- Update ROR LIST ITEM file (#799.1) for new registries
+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_"^RORP037")),";;",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_"^RORP037")),";;",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 ;
LISTITEM ; --- Entries to add to ROR LIST ITEM 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 ;;Recent Patients Medications^4^99
+10 ;;Recent Patients Lab Tests^3^1
+11 ;;
+12 ;
+13 QUIT
+14 ;
+15 ;**********************************************************************
+16 ;New LOINC codes
+17 ;**********************************************************************
COVID19 ;
+1 ;;94307-6
+2 ;;94308-4
+3 ;;94309-2
+4 ;;94310-0
+5 ;;94311-8
+6 ;;94314-2
+7 ;;94315-9
+8 ;;94316-7
+9 ;;94500-6
+10 ;;94502-2
+11 ;;94533-7
+12 ;;94534-5
+13 ;;94558-4
+14 ;;94559-2
+15 ;;94565-9
+16 ;;94639-2
+17 ;;94640-0
+18 ;;94641-8
+19 ;;94647-5
+20 ;;94660-8
+21 ;;94756-4
+22 ;;94757-2
+23 ;;94758-0
+24 ;;94759-8
+25 ;;94760-6
+26 ;;94765-5
+27 ;;94766-3
+28 ;;94767-1
+29 ;;94819-0
+30 ;;94822-4
+31 ;;94845-5
+32 ;;95209-3
+33 ;;95406-5
+34 ;;95409-9
+35 ;;
+36 ;
+37 ;******************************************************************************
+38 ; Data to be added to ROR METADATA file (#799.2)
+39 ; DATA NAME^CODE^REQUIRED^VALUE TYPE^LOADER API^FIELD NUMBER
+40 ;******************************************************************************
META45 ; Data added to file 45 PTF
+1 ;;ADMISSION DATE^154^1^Internal^1^2
+2 ;;
+3 ;
+4 QUIT
METAVST ; Data added to file 9000010 VISIT
+1 ;;VISIT/ADMIT DATE&TIME^155^1^Internal^1^.01
+2 ;;
+3 ;
+4 QUIT
COLO ; Data added to file 798.1 subfile EXTRACTED RESULTS
+1 ;;*^^CH
+2 ;;
+3 ;
+4 QUIT
SELRL ; NEW SELECTION RULE TO ADD
+1 ;;VA COVID19 LAB
+2 ;;
+3 ;
+4 QUIT
RORERR ; ERROR
+1 KILL RORERR
+2 MERGE RORERR=RORMSG
+3 DO DBS^RORERR("RORMSG",-112,,,799.22,RORIEN(1))
+4 MERGE RORMSG=RORERR
+5 KILL RORERR
+6 IF $DATA(RORFLG)
Begin DoDot:1
+7 SET RORERR(1)=" Update to ROR METADATA "_RORIEN(1)_" entry has <<FAILED>>"
End DoDot:1
+8 IF $DATA(RORFLG1)
Begin DoDot:1
+9 SET RORERR(1)=" Update to LOINC and SUBSCRIPTS subfields has <<FAILED>>"
End DoDot:1
+10 IF $DATA(RORFLG2)
Begin DoDot:1
+11 SET RORERR(1)=" Update to SELECTION RULE multiple has <<FAILED>>"
End DoDot:1
+12 SET RORERR(2)=" "
+13 SET RORERR(3)=" Please report this error to your CCR contact:"
+14 SET RORERR(4)=" "
+15 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))
+16 SET CT=CT+1
SET RORERR(CT)=" "
+17 DO MES^XPDUTL(.RORERR)
+18 QUIT
+19 ;
COVLOINC ; Adding data to the EXTRACTED RESULTS multiple. adding to the LOINC and SUBSCRIPTS Subfields.
+1 NEW DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG1
+2 ;COVID19 top level IEN
SET RORIEN=$ORDER(^ROR(798.1,"B","VA COVID19",0))
if 'RORIEN
QUIT
+3 SET RORPARM("DEVELOPER")=1
+4 FOR RORI=1:1:1
SET RORDATA=$PIECE($TEXT(COLO+RORI),";;",2)
Begin DoDot:1
+5 SET RORDATA(RORI)=RORDATA
+6 SET X=$PIECE(RORDATA,U)
SET DA(1)=RORIEN
SET DIC="^ROR(798.1,"_DA(1)_",8,"
DO ^DIC
+7 IF Y>0
SET DA(1)=52
SET DIK="^ROR(798.1,"_DA(1)_",8,"
SET DA=+Y
DO ^DIK
End DoDot:1
+8 SET DA(1)=RORIEN
SET DIC="^ROR(798.1,"_DA(1)_",8,"
DO ^DIC
+9 SET RORIEN(1)=52
+10 SET RORIENS="+2"_","_RORIEN_","
+11 SET RORFDA(798.112,RORIENS,.01)="*"
+12 SET RORFDA(798.112,RORIENS,.03)="CH"
+13 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+14 IF $DATA(DIERR)
SET RORFLG1=1
DO RORERR
+15 QUIT
COVSEL ; Adding new selection to the SELECTION RULE multiple of 798.1 for COVID19
+1 NEW DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG2
+2 ;COVID19 top level IEN
SET RORIEN=$ORDER(^ROR(798.1,"B","VA COVID19",0))
if 'RORIEN
QUIT
+3 SET RORPARM("DEVELOPER")=1
+4 FOR RORI=1:1:1
SET RORDATA=$PIECE($TEXT(SELRL+RORI),";;",2)
Begin DoDot:1
+5 SET RORDATA(RORI)=RORDATA
+6 SET X=$PIECE(RORDATA,U)
SET DA(1)=RORIEN
SET DIC="^ROR(798.1,"_DA(1)_",1,"
DO ^DIC
+7 IF Y>0
SET DA(1)=RORIEN
SET DIK="^ROR(798.1,"_DA(1)_",1,"
SET DA=+Y
DO ^DIK
End DoDot:1
+8 SET DA(1)=RORIEN
SET DIC="^ROR(798.1,"_DA(1)_",1,"
DO ^DIC
+9 SET RORIEN(1)=RORIEN
+10 SET RORIENS="+2"_","_RORIEN_","
+11 SET RORFDA(798.13,RORIENS,.01)=RORDATA
+12 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+13 IF $DATA(DIERR)
SET RORFLG2=1
DO RORERR
+14 QUIT
