- 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 Feb 18, 2025@23:09:09 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