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

RORP037.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;*****************************************************************************
  1. ;*****************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- --------- ----------- ----------------------------------------
  1. ;ROR*1.5*37 AUG 2020 M FERRARESE Added routine for env check, pre/post
  1. ; install Adding RECENT PATIENTS registry
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. ; SUPPORTED CALLS:
  1. ; RTN^%ZTLOAD #10063
  1. ; BMES^XPDUTL #10141
  1. ; OWNSKEY^XUSRB #3277 (supported)
  1. ; BLD^DIALOG #2050
  1. ; UPDATE^DIE #2053
  1. ; FMADD^XLFDT #10103
  1. ; ADD^XPAR #2263
  1. ; CLEAN^DILF #2054
  1. ; FILE^DICN #10009 (supported)
  1. ; UPDATE^DIE #2053 (supported)
  1. ENV ; --- Environment check
  1. S XPDNOQUE=1 ; disable queuing
  1. Q
  1. ;
  1. PRE ; --- Pre-Install routine for Patch 37
  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_"^RORP037")),";;",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 37
  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 Admission and visit fields to ROR METADATA file")
  1. D UPDMETA
  1. D BMES^XPDUTL(" >> Step complete")
  1. ;
  1. D BMES^XPDUTL(">> Adding new LOINC codes to the VA COVID19 registry parameters")
  1. D LOINC
  1. D BMES^XPDUTL(" >> Step complete")
  1. ;
  1. D BMES^XPDUTL(">> Adding data to the EXTRACT RESULTS multiple for the VA COVID19 registry parameters")
  1. D COVLOINC
  1. D BMES^XPDUTL(" >> Step complete")
  1. ;
  1. D BMES^XPDUTL(">> Adding new selection rule to SELECTION RULE multiple for the VA COVID19 registry parameters")
  1. D COVSEL
  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_"^RORP037")),";;",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 CLEAN^DILF
  1. D BMES^XPDUTL("POST INSTALL COMPLETE")
  1. Q
  1. ;
  1. UPDMETA ;
  1. ; Add 1 new Data Element to file 45 in the ROR METADATA file (delete first if they already exist)
  1. N DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR,RORPARM,RORFLG
  1. S RORPARM("DEVELOPER")=1
  1. F RORI=1:1:1 S RORDATA=$P($T(META45+RORI),";;",2) D
  1. . S RORDATA(RORI)=RORDATA
  1. . S X=$P(RORDATA,U),DA(1)=45,DIC="^ROR(799.2,"_DA(1)_",2," D ^DIC
  1. . I Y>0 S DA(1)=45,DIK="^ROR(799.2,"_DA(1)_",2,",DA=+Y D ^DIK
  1. S RORIEN(1)=45,RORDATA=0
  1. F RORI=1:1 S RORDATA=$P($T(META45+RORI),";;",2) Q:RORDATA="" D
  1. . S RORIENS="+"_(RORI+1)_",45,"
  1. . S RORFDA(799.22,RORIENS,.01)=$P(RORDATA,U)
  1. . S RORFDA(799.22,RORIENS,.02)=$P(RORDATA,U,2)
  1. . S RORFDA(799.22,RORIENS,2)=$P(RORDATA,U,3)
  1. . S RORFDA(799.22,RORIENS,4)=$P(RORDATA,U,4)
  1. . S RORFDA(799.22,RORIENS,1)=$P(RORDATA,U,5)
  1. . S RORFDA(799.22,RORIENS,6)=$P(RORDATA,U,6)
  1. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1. I $D(DIERR) S RORFLG=1 D RORERR
  1. ;Add 1 new Data Element to file 9000010 in the ROR METADATA file (delete first if they already exist)
  1. N DIERR,DA,DIC,DIK,X,Y,Z,RORIEN,RORFDA,RORI,RORDATA,RORIENS,RORMSG,Z,CT,RORERR
  1. F RORI=1:1:1 S RORDATA=$P($T(METAVST+RORI),";;",2) D
  1. . S RORDATA(RORI)=RORDATA
  1. . S X=$P(RORDATA,U),DA(1)=9000010,DIC="^ROR(799.2,"_DA(1)_",2," D ^DIC
  1. . I Y>0 S DA(1)=9000010,DIK="^ROR(799.2,"_DA(1)_",2,",DA=+Y D ^DIK
  1. S RORIEN(1)=9000010,RORDATA=0
  1. F RORI=1:1 S RORDATA=$P($T(METAVST+RORI),";;",2) Q:RORDATA="" D
  1. . S RORIENS="+"_(RORI+1)_",9000010,"
  1. . S RORFDA(799.22,RORIENS,.01)=$P(RORDATA,U)
  1. . S RORFDA(799.22,RORIENS,.02)=$P(RORDATA,U,2)
  1. . S RORFDA(799.22,RORIENS,2)=$P(RORDATA,U,3)
  1. . S RORFDA(799.22,RORIENS,4)=$P(RORDATA,U,4)
  1. . S RORFDA(799.22,RORIENS,1)=$P(RORDATA,U,5)
  1. . S RORFDA(799.22,RORIENS,6)=$P(RORDATA,U,6)
  1. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1. I $D(DIERR) D RORERR
  1. Q
  1. ;
  1. 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
  1. ;add the 'dash' or the number following it (checksum)
  1. ;**********************************************************************
  1. N DIC,RORIEN,X,Y
  1. S RORIEN=$O(^ROR(798.9,"B","VA COVID19",0)) I 'RORIEN D ;COVID19 top level IEN
  1. . S DIC(0)="",DIC="^ROR(798.9,",X="VA COVID19" D FILE^DICN S RORIEN=$P(Y,U,1)
  1. . I RORIEN>0 N RORFDA,RORMSG D
  1. . . S RORFDA(798.9,RORIEN_",",.09)=0 ;National registry
  1. . . S RORFDA(798.9,RORIEN_",",1)=0 ; Active
  1. . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
  1. . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.9)
  1. . K DIC,X,Y
  1. .Q
  1. Q:RORIEN<0
  1. N I,COV19IEN,RORDATA,RORLOINC,RORTAG,ROR K RORMSG1
  1. S COV19IEN=$O(^ROR(798.9,"B","VA COVID19",0))
  1. ;--- add LOINC codes to the VA COVID19 search criteria
  1. F I=1:1 S RORTAG="COVID19+"_I,ROR=$P($T(@RORTAG),";;",2) Q:ROR="" D
  1. . S RORLOINC=$P(ROR,"-",1)
  1. . ;don't add if it's already in the global
  1. . Q:($D(^ROR(798.9,COV19IEN,1,"B",RORLOINC)))
  1. . S RORDATA(1,798.92,"+2,"_COV19IEN_",",.01)=$G(RORLOINC)
  1. . S RORDATA(1,798.92,"+2,"_COV19IEN_",",1)=6
  1. . D UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
  1. K RORDATA,RORMSG1
  1. ;
  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 :
  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 RECENT PATIENTS
  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. ;;
  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_"^RORP037")),";;",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_"^RORP037")),";;",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. ;;Recent Patients Medications^4^99
  1. ;;Recent Patients Lab Tests^3^1
  1. ;;
  1. ;
  1. Q
  1. ;
  1. ;**********************************************************************
  1. ;New LOINC codes
  1. ;**********************************************************************
  1. COVID19 ;
  1. ;;94307-6
  1. ;;94308-4
  1. ;;94309-2
  1. ;;94310-0
  1. ;;94311-8
  1. ;;94314-2
  1. ;;94315-9
  1. ;;94316-7
  1. ;;94500-6
  1. ;;94502-2
  1. ;;94533-7
  1. ;;94534-5
  1. ;;94558-4
  1. ;;94559-2
  1. ;;94565-9
  1. ;;94639-2
  1. ;;94640-0
  1. ;;94641-8
  1. ;;94647-5
  1. ;;94660-8
  1. ;;94756-4
  1. ;;94757-2
  1. ;;94758-0
  1. ;;94759-8
  1. ;;94760-6
  1. ;;94765-5
  1. ;;94766-3
  1. ;;94767-1
  1. ;;94819-0
  1. ;;94822-4
  1. ;;94845-5
  1. ;;95209-3
  1. ;;95406-5
  1. ;;95409-9
  1. ;;
  1. ;
  1. ;******************************************************************************
  1. ; Data to be added to ROR METADATA file (#799.2)
  1. ; DATA NAME^CODE^REQUIRED^VALUE TYPE^LOADER API^FIELD NUMBER
  1. ;******************************************************************************
  1. META45 ; Data added to file 45 PTF
  1. ;;ADMISSION DATE^154^1^Internal^1^2
  1. ;;
  1. ;
  1. Q
  1. METAVST ; Data added to file 9000010 VISIT
  1. ;;VISIT/ADMIT DATE&TIME^155^1^Internal^1^.01
  1. ;;
  1. ;
  1. Q
  1. COLO ; Data added to file 798.1 subfile EXTRACTED RESULTS
  1. ;;*^^CH
  1. ;;
  1. ;
  1. Q
  1. SELRL ; NEW SELECTION RULE TO ADD
  1. ;;VA COVID19 LAB
  1. ;;
  1. ;
  1. Q
  1. RORERR ; ERROR
  1. K RORERR
  1. M RORERR=RORMSG
  1. D DBS^RORERR("RORMSG",-112,,,799.22,RORIEN(1))
  1. M RORMSG=RORERR
  1. K RORERR
  1. I $D(RORFLG) D
  1. . S RORERR(1)=" Update to ROR METADATA "_RORIEN(1)_" entry has <<FAILED>>"
  1. I $D(RORFLG1) D
  1. . S RORERR(1)=" Update to LOINC and SUBSCRIPTS subfields has <<FAILED>>"
  1. I $D(RORFLG2) D
  1. . S RORERR(1)=" Update to SELECTION RULE multiple has <<FAILED>>"
  1. S RORERR(2)=" "
  1. S RORERR(3)=" Please report this error to your CCR contact:"
  1. S RORERR(4)=" "
  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. COVLOINC ; Adding data to the EXTRACTED RESULTS multiple. adding to the LOINC and SUBSCRIPTS Subfields.
  1. N DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG1
  1. S RORIEN=$O(^ROR(798.1,"B","VA COVID19",0)) Q:'RORIEN ;COVID19 top level IEN
  1. S RORPARM("DEVELOPER")=1
  1. F RORI=1:1:1 S RORDATA=$P($T(COLO+RORI),";;",2) D
  1. . S RORDATA(RORI)=RORDATA
  1. . S X=$P(RORDATA,U),DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",8," D ^DIC
  1. . I Y>0 S DA(1)=52,DIK="^ROR(798.1,"_DA(1)_",8,",DA=+Y D ^DIK
  1. S DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",8," D ^DIC
  1. S RORIEN(1)=52
  1. S RORIENS="+2"_","_RORIEN_","
  1. S RORFDA(798.112,RORIENS,.01)="*"
  1. S RORFDA(798.112,RORIENS,.03)="CH"
  1. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1. I $D(DIERR) S RORFLG1=1 D RORERR
  1. Q
  1. COVSEL ; Adding new selection to the SELECTION RULE multiple of 798.1 for COVID19
  1. N DIERR,DA,X,Y,Z,RORIEN,RORFDA,RORDATA,RORIENS,RORMSG,CT,RORERR,RORPARM,RORFLG2
  1. S RORIEN=$O(^ROR(798.1,"B","VA COVID19",0)) Q:'RORIEN ;COVID19 top level IEN
  1. S RORPARM("DEVELOPER")=1
  1. F RORI=1:1:1 S RORDATA=$P($T(SELRL+RORI),";;",2) D
  1. . S RORDATA(RORI)=RORDATA
  1. . S X=$P(RORDATA,U),DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",1," D ^DIC
  1. . I Y>0 S DA(1)=RORIEN,DIK="^ROR(798.1,"_DA(1)_",1,",DA=+Y D ^DIK
  1. S DA(1)=RORIEN,DIC="^ROR(798.1,"_DA(1)_",1," D ^DIC
  1. S RORIEN(1)=RORIEN
  1. S RORIENS="+2"_","_RORIEN_","
  1. S RORFDA(798.13,RORIENS,.01)=RORDATA
  1. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1. I $D(DIERR) S RORFLG2=1 D RORERR
  1. Q