- RORP033 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 33 ;18 Apr 2018 1:38 PM
- ;;1.5;CLINICAL CASE REGISTRIES;**33**;Feb 17, 2006;Build 81
- ;
- ;*****************************************************************************
- ;*****************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- --------- ----------- ----------------------------------------
- ;ROR*1.5*33 Mar 2018 M FERRARESE Added routine for env check, pre/post
- ; install
- ;******************************************************************************
- ;******************************************************************************
- ;
- ; SUPPORTED CALLS:
- ; RTN^%ZTLOAD #10063
- ; STAT^%ZTLOAD #10063
- ; BMES^XPDUTL #10141
- ; OWNSKEY^XUSRB #3277 (supported)
- ; MES^XPDUTL #10141
- ; BLD^DIALOG #2050
- ; UPDATE^DIE #2053
- ; FMADD^XLFDT #10103
- ; NOW^XLFDT #10103
- ; FMTE^XLFDT #10103
- ; ADD^XPAR #2263
- ; DEL^XPAR #2263
- ; CLEAN^DILF #2054
- ;
- ENV ; --- Environment check
- S XPDNOQUE=1 ; disable queuing
- Q
- ;
- PRE ; --- Pre-Install routine for Patch 32
- ; 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_"^RORP033")),";;",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 32
- N CT,RORI,RORREG,REGIEN,Z
- N RORPARM
- S RORPARM("DEVELOPER")=1
- D BMES^XPDUTL("POST INSTALL START")
- ;
- D BMES^XPDUTL(">> Adding new LOINC codes to the VA HIV registry parameters")
- D LOINC
- D BMES^XPDUTL(" >> Step complete")
- ;
- D BMES^XPDUTL(">> Adding new Future Appointments panel to reports")
- D UPDPANEL
- D BMES^XPDUTL(" >> Step complete")
- ;
- D BMES^XPDUTL("Checking VA GENERIC drug file..Bictegravir/emtricitabine/tenofovir alafenamide ")
- D BMES^XPDUTL(" ..Efavirenz/lamivudine/tenofovir disoproxil fumarate ")
- D BMES^XPDUTL(" ..Lamivudine/tenofovir disoproxil fumarate ")
- D GENDRG
- D BMES^XPDUTL(" >> Step complete")
- D CLEAN^DILF
- ;
- D BMES^XPDUTL(">> Adding CPT and ICD-9 procedures to ROR ICD SEARCH file for new registries")
- D UPDPROC
- 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_"^RORP033")),";;",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)
- D ^RORSET02
- K ^XTMP("ROR_NO_INIT")
- D BMES^XPDUTL(" >> Step complete")
- D BMES^XPDUTL("Updating the Drug matching entries...") D EN^RORUTL22
- D BMES^XPDUTL("Tasking nightly job to gather drug matching...") D TASK^RORUTL22
- D CLEAN^DILF
- D BMES^XPDUTL("POST INSTALL COMPLETE")
- Q
- GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
- ; clean up 799.51 if pointers are bad
- ; HIV registry : BICTEGRAVIR/EMTRICITABINE/TENOFOVIR ALAFENAMIDE - "BICTEGRAVIR/EMTRICITABINE/TENOFOVIRQW" Released in PSN*4*
- ; : EFAVIRENZ/LAMIVUDINE/TENOFOVIR DISOPROXIL FUMARATE - "EFAVIRENZ/LAMIVUDINE/TENOFOVIR" Released in PSN*4*
- ; : LAMIVUDINE/TENOFOVIR DISOPROXIL FUMARATE - "LAMIVUDINE/TENOFOVIR" Released in PSN*4*
- ;
- ;
- N DIC,X,DIK,DA,RORNAME,Y
- S DIC=799.51,DIC(0)="MNZ"
- F RORNAME="BICTEGRAVIR/EMTRICITABINE/TENOFOVIR","EFAVIRENZ/LAMIVUDINE/TENOFOVIR","LAMIVUDINE/TENOFOVIR" 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
- ;
- LOINC ;Add new LOINC codes to the VA HIV 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 I,HEPCIEN,HIVIEN,RORDATA,RORLOINC,RORTAG,ROR K RORMSG1,RORMSG2
- S HIVIEN=$O(^ROR(798.9,"B","VA HIV",0)) ;HIV top level IEN
- ;--- add LOINC codes to the VA HIV search criteria
- F I=1:1 S RORTAG="HIV+"_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,HIVIEN,1,"B",RORLOINC)))
- . S RORDATA(1,798.92,"+2,"_HIVIEN_",",.01)=$G(RORLOINC)
- . S RORDATA(1,798.92,"+2,"_HIVIEN_",",1)=6
- . D UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
- K RORDATA,RORMSG1,RORMSG2
- ;
- Q
- ;
- ;**********************************************************************
- ;New LOINC codes
- ;**********************************************************************
- HIV ;
- ;;28004-0
- ;;42768-2
- ;;48345-3
- ;;51866-2
- ;;56888-1
- ;;57975-5
- ;;58900-2
- ;;68961-2
- ;;69668-2
- ;;73906-0
- ;;75666-8
- ;;80203-3
- ;;81641-3
- ;;85037-0
- ;;
- ;
- UPDPANEL ;
- ; For parameter panel field, add 29, after ,24, right below the Additional Identifiers panel for
- ; Combined Meds and Labs (REPORT CODE=12)
- ; Hepatitis A Vaccine or Immunity (REPORT CODE=24)
- ; Hepatitis B Vaccine of Immunity (REPORT CODE=25)
- ; Liver Score by Range (REPORT CODE=19)
- ; Registry Lab Tests by Range (REPORT CODE=10)
- ; Renal Function by Range (REPORT CODE=20)
- ; BMI by Range (REPORT CODE=18)
- ;
- ; In the Hepatitis C registry right below the Additional Identifiers panel
- ; Potential DAA Candidates (REPORT CODE=21)
- ; BMI by Range (REPORT CODE=18)
- ;
- 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=10:1,RORPAN=12:1,RORPAN=18:1,RORPAN=19:1,RORPAN=20:1,RORPAN=21:1,RORPAN=24:1,RORPAN=25: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 ; --- Update ROR LIST ITEM file (#799.1) for new registriesList of new registries to initialize
- ;;VA TRANSPLANT HEART
- ;;VA TRANSPLANT INTESTINE
- ;;VA TRANSPLANT KIDNEY
- ;;VA TRANSPLANT LIVER
- ;;VA TRANSPLANT LUNG
- ;;VA TRANSPLANT PANCREAS
- ;;
- ;
- UPDPROC ; --- Update ROR LIST ITEM file (#799.1) for new registriesAdds ICD dx/procedure codes and CPT codes to the new registries in ROR ICD file
- ; Delete if already there
- N CT,I1,DA,DIK,X,Y,Z,RORDATA,RORFDA,RORI,RORPROC,RORREG,RORIEN,RORFDA1
- F RORI="TRANSPLANT HEART","TRANSPLANT INTESTINE","TRANSPLANT KIDNEY","TRANSPLANT LIVER","TRANSPLANT LUNG","TRANSPLANT PANCREAS" 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
- .. ;
- 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
- ;;VA TRANSPLANT HEART
- ;;^^^996.83,V42.1,V43.21,V43.22,T86.20,T86.21,T86.22,T86.23,T86.290,T86.298,T86.30,T86.31,T86.32,T86.33,T86.39,Z48.21,Z48.280,Z94.1,Z94.3
- ;;VA TRANSPLANT INTESTINE
- ;;^^^996.87,V42.84,Z94.82,T86.850,T86.851,T86.852,T86.858,T86.859,
- ;;VA TRANSPLANT KIDNEY
- ;;^^^V42.0,T86.10,T86.11,T86.12,T86.13,T86.19,Z48.22,Z94.0
- ;;VA TRANSPLANT LIVER
- ;;^^^996.82,V42.7,T86.40,T86.41,T86.42,T86.43,T86.49,Z48.23,Z94.4
- ;;VA TRANSPLANT LUNG
- ;;^^^996.84,V42.6,T86.30,T86.31,T86.32,T86.33,T86.39,T86.810,T86.811,T86.812,T86.818,T86.819,Z48.24,Z48.280,Z94.2
- ;;VA TRANSPLANT PANCREAS
- ;;^^^996.86,V42.83,Z94.83
- 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_"^RORP033")),";;",2),U) Q:RORREG="" D
- . S REGIEN=$$REGIEN^RORUTL02(RORREG)
- . I REGIEN>0 D
- .. F RORI1=1:1 S RORDATA=$P($T(@("LISTITEM+"_RORI1_"^RORP033")),";;",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
- ;;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORP033 16711 printed Jan 18, 2025@02:43:55 Page 2
- RORP033 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 33 ;18 Apr 2018 1:38 PM
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**33**;Feb 17, 2006;Build 81
- +2 ;
- +3 ;*****************************************************************************
- +4 ;*****************************************************************************
- +5 ; --- ROUTINE MODIFICATION LOG ---
- +6 ;
- +7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +8 ;----------- --------- ----------- ----------------------------------------
- +9 ;ROR*1.5*33 Mar 2018 M FERRARESE Added routine for env check, pre/post
- +10 ; install
- +11 ;******************************************************************************
- +12 ;******************************************************************************
- +13 ;
- +14 ; SUPPORTED CALLS:
- +15 ; RTN^%ZTLOAD #10063
- +16 ; STAT^%ZTLOAD #10063
- +17 ; BMES^XPDUTL #10141
- +18 ; OWNSKEY^XUSRB #3277 (supported)
- +19 ; MES^XPDUTL #10141
- +20 ; BLD^DIALOG #2050
- +21 ; UPDATE^DIE #2053
- +22 ; FMADD^XLFDT #10103
- +23 ; NOW^XLFDT #10103
- +24 ; FMTE^XLFDT #10103
- +25 ; ADD^XPAR #2263
- +26 ; DEL^XPAR #2263
- +27 ; CLEAN^DILF #2054
- +28 ;
- ENV ; --- Environment check
- +1 ; disable queuing
- SET XPDNOQUE=1
- +2 QUIT
- +3 ;
- PRE ; --- Pre-Install routine for Patch 32
- +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_"^RORP033")),";;",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 32
+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 new LOINC codes to the VA HIV registry parameters")
+7 DO LOINC
+8 DO BMES^XPDUTL(" >> Step complete")
+9 ;
+10 DO BMES^XPDUTL(">> Adding new Future Appointments panel to reports")
+11 DO UPDPANEL
+12 DO BMES^XPDUTL(" >> Step complete")
+13 ;
+14 DO BMES^XPDUTL("Checking VA GENERIC drug file..Bictegravir/emtricitabine/tenofovir alafenamide ")
+15 DO BMES^XPDUTL(" ..Efavirenz/lamivudine/tenofovir disoproxil fumarate ")
+16 DO BMES^XPDUTL(" ..Lamivudine/tenofovir disoproxil fumarate ")
+17 DO GENDRG
+18 DO BMES^XPDUTL(" >> Step complete")
+19 DO CLEAN^DILF
+20 ;
+21 DO BMES^XPDUTL(">> Adding CPT and ICD-9 procedures to ROR ICD SEARCH file for new registries")
+22 DO UPDPROC
+23 DO BMES^XPDUTL(" >> Step complete")
+24 ;
+25 DO BMES^XPDUTL("Updating List Items for new registries")
+26 DO UPDLIST
+27 DO BMES^XPDUTL(" >> Step complete")
+28 ;
+29 DO BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
+30 NEW RORKIDS,RORERR,CT,DIERR
+31 SET RORKIDS=1
+32 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP033")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+33 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+34 if REGIEN'>0
QUIT
+35 IF $DATA(^XTMP("ROR_NO_INIT",REGIEN))
Begin DoDot:2
+36 SET RORERR(1)=" It appears new registry "_RORREG_"(ien #"_REGIEN_") has already been initialized"
+37 SET RORERR(2)=" You have chosen not to re-initialize this registry"
+38 SET RORERR(3)=" "
+39 DO MES^XPDUTL(.RORERR)
+40 KILL RORERR
End DoDot:2
QUIT
+41 ;
+42 KILL RORFDA,RORMSG,RORERR
+43 SET RORFDA(798.1,REGIEN_",",1)=2850101
+44 SET RORFDA(798.1,REGIEN_",",19.1)=""
+45 SET RORFDA(798.1,REGIEN_",",21.05)=""
+46 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+47 IF $DATA(DIERR)
Begin DoDot:2
+48 KILL RORERR
+49 MERGE RORERR=RORMSG
+50 DO DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
+51 MERGE RORMSG=RORERR
+52 KILL RORERR
+53 SET RORERR(1)=" New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
+54 SET RORERR(2)=" and may not initialize correctly. Please report this error to your CCR contact:"
+55 SET RORERR(3)=""
+56 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))
+57 SET CT=CT+1
SET RORERR(CT)=" "
+58 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+59 DO ^RORSET02
+60 KILL ^XTMP("ROR_NO_INIT")
+61 DO BMES^XPDUTL(" >> Step complete")
+62 DO BMES^XPDUTL("Updating the Drug matching entries...")
DO EN^RORUTL22
+63 DO BMES^XPDUTL("Tasking nightly job to gather drug matching...")
DO TASK^RORUTL22
+64 DO CLEAN^DILF
+65 DO BMES^XPDUTL("POST INSTALL COMPLETE")
+66 QUIT
GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
+1 ; clean up 799.51 if pointers are bad
+2 ; HIV registry : BICTEGRAVIR/EMTRICITABINE/TENOFOVIR ALAFENAMIDE - "BICTEGRAVIR/EMTRICITABINE/TENOFOVIRQW" Released in PSN*4*
+3 ; : EFAVIRENZ/LAMIVUDINE/TENOFOVIR DISOPROXIL FUMARATE - "EFAVIRENZ/LAMIVUDINE/TENOFOVIR" Released in PSN*4*
+4 ; : LAMIVUDINE/TENOFOVIR DISOPROXIL FUMARATE - "LAMIVUDINE/TENOFOVIR" Released in PSN*4*
+5 ;
+6 ;
+7 NEW DIC,X,DIK,DA,RORNAME,Y
+8 SET DIC=799.51
SET DIC(0)="MNZ"
+9 FOR RORNAME="BICTEGRAVIR/EMTRICITABINE/TENOFOVIR","EFAVIRENZ/LAMIVUDINE/TENOFOVIR","LAMIVUDINE/TENOFOVIR"
Begin DoDot:1
+10 SET X=RORNAME
DO ^DIC
if +Y<0
QUIT
+11 if +$PIECE(Y(0),U,4)>0
QUIT
+12 SET DA=+Y
SET DIK="^ROR(799.51,"
DO ^DIK
+13 DO BMES^XPDUTL("WARNING*** Missing entry in VA GENERIC file 50.6.")
End DoDot:1
+14 QUIT
+15 ;
LOINC ;Add new LOINC codes to the VA HIV 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 I,HEPCIEN,HIVIEN,RORDATA,RORLOINC,RORTAG,ROR
KILL RORMSG1,RORMSG2
+5 ;HIV top level IEN
SET HIVIEN=$ORDER(^ROR(798.9,"B","VA HIV",0))
+6 ;--- add LOINC codes to the VA HIV search criteria
+7 FOR I=1:1
SET RORTAG="HIV+"_I
SET ROR=$PIECE($TEXT(@RORTAG),";;",2)
if ROR=""
QUIT
Begin DoDot:1
+8 SET RORLOINC=$PIECE(ROR,"-",1)
+9 ;don't add if it's already in the global
+10 if ($DATA(^ROR(798.9,HIVIEN,1,"B",RORLOINC)))
QUIT
+11 SET RORDATA(1,798.92,"+2,"_HIVIEN_",",.01)=$GET(RORLOINC)
+12 SET RORDATA(1,798.92,"+2,"_HIVIEN_",",1)=6
+13 DO UPDATE^DIE("","RORDATA(1)",,"RORMSG1")
End DoDot:1
+14 KILL RORDATA,RORMSG1,RORMSG2
+15 ;
+16 QUIT
+17 ;
+18 ;**********************************************************************
+19 ;New LOINC codes
+20 ;**********************************************************************
HIV ;
+1 ;;28004-0
+2 ;;42768-2
+3 ;;48345-3
+4 ;;51866-2
+5 ;;56888-1
+6 ;;57975-5
+7 ;;58900-2
+8 ;;68961-2
+9 ;;69668-2
+10 ;;73906-0
+11 ;;75666-8
+12 ;;80203-3
+13 ;;81641-3
+14 ;;85037-0
+15 ;;
+16 ;
UPDPANEL ;
+1 ; For parameter panel field, add 29, after ,24, right below the Additional Identifiers panel for
+2 ; Combined Meds and Labs (REPORT CODE=12)
+3 ; Hepatitis A Vaccine or Immunity (REPORT CODE=24)
+4 ; Hepatitis B Vaccine of Immunity (REPORT CODE=25)
+5 ; Liver Score by Range (REPORT CODE=19)
+6 ; Registry Lab Tests by Range (REPORT CODE=10)
+7 ; Renal Function by Range (REPORT CODE=20)
+8 ; BMI by Range (REPORT CODE=18)
+9 ;
+10 ; In the Hepatitis C registry right below the Additional Identifiers panel
+11 ; Potential DAA Candidates (REPORT CODE=21)
+12 ; BMI by Range (REPORT CODE=18)
+13 ;
+14 NEW CT,RORRPT,RORMSG,RORPAN,RORERR,RORFDA,Z,Z1,DIERR
+15 SET RORRPT=0
FOR
SET RORRPT=$ORDER(^ROR(799.34,RORRPT))
if 'RORRPT
QUIT
SET RORPAN=$PIECE($GET(^ROR(799.34,RORRPT,0)),U,4)
if $SELECT(RORPAN=10
Begin DoDot:1
+16 SET Z1=$GET(^ROR(799.34,RORRPT,1))
+17 KILL RORFDA,RORMSG
+18 IF Z1[",24,29,"
Begin DoDot:2
+19 DO BMES^XPDUTL(" o New panel already exists for registry")
End DoDot:2
QUIT
+20 IF Z1'[",24,29,"
Begin DoDot:2
+21 IF Z1[",24,"
IF Z1'[",24,29,"
SET RORFDA(799.34,RORRPT_",",1)=$PIECE(Z1,",24,")_",24,29,"_$PIECE(Z1,",24,",2)
End DoDot:2
+22 if '$DATA(RORFDA)
QUIT
+23 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+24 IF $DATA(DIERR)
Begin DoDot:2
+25 KILL RORERR
+26 DO DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
+27 MERGE RORMSG=RORERR
+28 KILL RORERR
+29 SET RORERR(1)=" Update of report "_$PIECE($GET(^ROR(799.34,RORRPT,0)),U)_" with new panel"
+30 SET RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+31 SET RORERR(3)=""
+32 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))
+33 SET CT=CT+1
SET RORERR(CT)=" "
+34 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
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 ;
+12 ;
+13 ;
+14 ;
NEWREG ; --- Update ROR LIST ITEM file (#799.1) for new registriesList of new registries to initialize
+1 ;;VA TRANSPLANT HEART
+2 ;;VA TRANSPLANT INTESTINE
+3 ;;VA TRANSPLANT KIDNEY
+4 ;;VA TRANSPLANT LIVER
+5 ;;VA TRANSPLANT LUNG
+6 ;;VA TRANSPLANT PANCREAS
+7 ;;
+8 ;
UPDPROC ; --- Update ROR LIST ITEM file (#799.1) for new registriesAdds ICD dx/procedure codes and CPT codes to the new registries in ROR ICD file
+1 ; Delete if already there
+2 NEW CT,I1,DA,DIK,X,Y,Z,RORDATA,RORFDA,RORI,RORPROC,RORREG,RORIEN,RORFDA1
+3 FOR RORI="TRANSPLANT HEART","TRANSPLANT INTESTINE","TRANSPLANT KIDNEY","TRANSPLANT LIVER","TRANSPLANT LUNG","TRANSPLANT PANCREAS"
SET DIC="^ROR(798.5,"
SET X="VA "_RORI
SET DIC(0)=""
DO ^DIC
IF Y>0
Begin DoDot:1
+4 SET DIK="^ROR(798.5,"
SET DA=+Y
DO ^DIK
End DoDot:1
+5 FOR RORI=1:1
SET RORDATA=$PIECE($TEXT(ICDPROC+RORI),";;",2)
if RORDATA=""
QUIT
Begin DoDot:1
+6 SET RORREG=$PIECE(RORDATA,U)
+7 IF RORREG'=""
Begin DoDot:2
+8 ; add new registry top level entry
+9 ;Store 'previous registry' if RORFDA exists
if $DATA(RORFDA)
DO ADD7985(.RORFDA,RORIEN,$PIECE($GET(^ROR(798.1,+$GET(RORIEN),0)),U))
+10 KILL RORFDA1
+11 SET RORFDA1(798.5,"+1,",.01)=RORREG
SET RORIEN=""
SET CT=0
+12 DO ADD7985(.RORFDA1,.RORIEN,RORREG)
+13 SET Z=+$ORDER(RORIEN(0))
SET Z=$GET(RORIEN(Z))
+14 KILL RORIEN,RORFDA1
SET RORIEN=Z
End DoDot:2
QUIT
+15 ; Add ICD-codes to the entry
IF $PIECE(RORDATA,U,2)'=""
Begin DoDot:2
+16 SET RORPROC=$PIECE(RORDATA,U,2)
+17 FOR I1=1:1:$LENGTH(RORPROC,",")
SET X=$PIECE(RORPROC,",",I1)
IF X'=""
SET CT=CT+1
SET RORFDA(798.52,"+"_CT_","_RORIEN_",",.01)=X
End DoDot:2
QUIT
+18 ; Add ICPT codes to the entry
IF $PIECE(RORDATA,U,3)'=""
Begin DoDot:2
+19 SET RORPROC=$PIECE(RORDATA,U,3)
+20 FOR I1=1:1:$LENGTH(RORPROC,",")
SET X=$PIECE(RORPROC,",",I1)
IF X'=""
SET CT=CT+1
SET RORFDA(798.53,"+"_CT_","_RORIEN_",",.01)=X
End DoDot:2
QUIT
+21 ; Add ICD diagnosis codes to the entry
IF $PIECE(RORDATA,U,4)'=""
Begin DoDot:2
+22 SET RORPROC=$PIECE(RORDATA,U,4)
+23 FOR I1=1:1:$LENGTH(RORPROC,",")
SET X=$PIECE(RORPROC,",",I1)
IF X'=""
SET CT=CT+1
SET RORFDA(798.51,"+"_CT_","_RORIEN_",",.01)=X
+24 ;
End DoDot:2
QUIT
End DoDot:1
+25 IF $DATA(RORFDA)
DO ADD7985(.RORFDA,RORIEN,RORREG)
+26 DO CLEAN^DILF
+27 QUIT
+28 ;
ADD7985(RORFDA,RORIEN,RORREG) ; Adds procedures to the entries in the files
+1 NEW RORMSG,DIERR
+2 DO UPDATE^DIE("E","RORFDA","RORIEN","RORMSG")
+3 IF $GET(DIERR)
Begin DoDot:1
+4 NEW Z,CT,RORERR
+5 MERGE RORERR=RORMSG
+6 DO DBS^RORERR("RORMSG",-112,,,798.5,RORREG)
+7 MERGE RORMSG=RORERR
+8 KILL RORERR
+9 SET RORERR(1)=" Adding procedures for new registry "_RORREG_" encountered the"
+10 SET RORERR(2)=" following error. Please report this error to your CCR contact:"
+11 SET RORERR(3)=""
+12 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))
+13 SET CT=CT+1
SET RORERR(CT)=" "
+14 DO MES^XPDUTL(.RORERR)
End DoDot:1
+15 QUIT
+16 ;
ICDPROC ; Registry name^PTF ICD Procedure codes, separated by commas^PTF CPT codes, separated by commas^ ICD DIAGNOSIS codes
+1 ;;VA TRANSPLANT HEART
+2 ;;^^^996.83,V42.1,V43.21,V43.22,T86.20,T86.21,T86.22,T86.23,T86.290,T86.298,T86.30,T86.31,T86.32,T86.33,T86.39,Z48.21,Z48.280,Z94.1,Z94.3
+3 ;;VA TRANSPLANT INTESTINE
+4 ;;^^^996.87,V42.84,Z94.82,T86.850,T86.851,T86.852,T86.858,T86.859,
+5 ;;VA TRANSPLANT KIDNEY
+6 ;;^^^V42.0,T86.10,T86.11,T86.12,T86.13,T86.19,Z48.22,Z94.0
+7 ;;VA TRANSPLANT LIVER
+8 ;;^^^996.82,V42.7,T86.40,T86.41,T86.42,T86.43,T86.49,Z48.23,Z94.4
+9 ;;VA TRANSPLANT LUNG
+10 ;;^^^996.84,V42.6,T86.30,T86.31,T86.32,T86.33,T86.39,T86.810,T86.811,T86.812,T86.818,T86.819,Z48.24,Z48.280,Z94.2
+11 ;;VA TRANSPLANT PANCREAS
+12 ;;^^^996.86,V42.83,Z94.83
+13 QUIT
+14 ;
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_"^RORP033")),";;",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_"^RORP033")),";;",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 ;;
+10 ;