RORP034 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 34 ;18 Nov 2018 1:38 PM
;;1.5;CLINICAL CASE REGISTRIES;**34**;Feb 17, 2006;Build 45
;
;*****************************************************************************
;*****************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- --------- ----------- ----------------------------------------
;ROR*1.5*34 Nov 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 34
; 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_"^RORP034")),";;",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 34
N CT,RORI,RORREG,REGIEN,Z
N RORPARM
S RORPARM("DEVELOPER")=1
D BMES^XPDUTL("POST INSTALL START")
;
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..COBICISTAT/DARUNAVIR/EMTRICITABINE/TENOFOVIR AF ")
D GENDRG
D BMES^XPDUTL(" >> Step complete")
;
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_"^RORP034")),";;",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 : COBICISTAT/DARUNAVIR/EMTRICITABINE/TENOFOVIR AF - "COBI/DARUNAVIR/EMTRIC/TAF" Released in PSN*4*
;
;
;
N DIC,X,DIK,DA,RORNAME,Y
S DIC=799.51,DIC(0)="MNZ"
F RORNAME="COBI/DARUNAVIR/EMTRIC/TAF" 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 ; --- Update ROR LIST ITEM file (#799.1) for new registriesList of new registries to initialize
;;VA LYMPHOMA
;;VA NASH
;;VA ILD
;;
;
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="LYMPHOMA","NASH","ILD" 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 LYMPHOMA
;;^^^202.80,201.90,C91.50,C91.51,C91.52
;;^^^C84.70,C84.71,C84.72,C84.73,C84.74,C84.75,C84.76,C84.77,C84.78,C84.79
;;^^^C84.60,C84.61,C84.62,C84.63,C84.64,C84.65,C84.66,C84.67,C84.68,C84.69
;;^^^C85.10,C85.11,C85.12,C85.13,C85.14,C85.15,C85.16,C85.17,C85.18,C85.19
;;^^^C83.50,C83.51,C83.52,C83.53,C83.54,C83.55,C83.56,C83.57,C83.58,C83.59
;;^^^C88.0,C88.3,C88.4
;;^^^C83.70,C83.71,C83.72,C83.73,C83.74,C83.75,C83.76,C83.77,C83.78,C83.79
;;^^^C83.10,C83.11,C83.12,C83.13,C83.14,C83.15,C83.16,C83.17,C83.18,C83.19
;;^^^C82.60,C82.61,C82.62,C82.63,C82.64,C82.65,C82.66,C82.67,C82.68,C82.69
;;^^^C84.A0,C84.A1,C84.A2,C84.A3,C84.A4,C84.A5,C84.A6,C84.A7,C84.A8,C84.A9
;;^^^C82.50,C82.51,C82.52,C82.53,C82.54,C82.55,C82.56,C82.57,C82.58,C82.59
;;^^^C83.30,C83.31,C83.32,C83.33,C83.34,C83.35,C83.36,C83.37,C83.38,C83.39
;;^^^C86.0,C86.1,C86.2,C86.3,C86.4,C86.5,C86.6
;;^^^C82.90,C82.91,C82.92,C82.93,C82.94,C82.95,C82.96,C82.97,C82.98,C82.99
;;^^^C82.00,C82.01,C82.02,C82.03,C82.04,C82.05,C82.06,C82.07,C82.08,C82.09
;;^^^C82.10,C82.11,C82.12,C82.13,C82.14,C82.15,C82.16,C82.17,C82.18,C82.19
;;^^^C82.20,C82.21,C82.22,C82.23,C82.24,C82.25,C82.26,C82.27,C82.28,C82.29
;;^^^C82.30,C82.31,C82.32,C82.33,C82.34,C82.35,C82.36,C82.37,C82.38,C82.39
;;^^^C82.40,C82.41,C82.42,C82.43,C82.44,C82.45,C82.46,C82.47,C82.48,C82.49
;;^^^C82.80,C82.81,C82.82,C82.83,C82.84,C82.85,C82.86,C82.87,C82.88,C82.89
;;^^^C85.90,C85.91,C85.92,C85.93,C85.94,C85.95,C85.96,C85.97,C85.98,C85.99
;;^^^C96.A
;;^^^C81.90,C81.91,C81.92,C81.93,C81.94,C81.95,C81.96,C81.97,C81.98,C81.99
;;^^^C81.30,C81.31,C81.32,C81.33,C81.34,C81.35,C81.36,C81.37,C81.38,C81.39
;;^^^C81.40,C81.41,C81.42,C81.43,C81.44,C81.45,C81.46,C81.47,C81.48,C81.49
;;^^^C81.20,C81.21,C81.22,C81.23,C81.24,C81.25,C81.26,C81.27,C81.28,C81.29
;;^^^C81.00,C81.01,C81.02,C81.03,C81.04,C81.05,C81.06,C81.07,C81.08,C81.09
;;^^^C81.10,C81.11,C81.12,C81.13,C81.14,C81.15,C81.16,C81.17,C81.18,C81.19
;;^^^C81.70,C81.71,C81.72,C81.73,C81.74,C81.75,C81.76,C81.77,C81.78,C81.79
;;^^^C83.80,C83.81,C83.82,C83.83,C83.84,C83.85,C83.86,C83.87,C83.88,C83.89
;;^^^C84.40,C84.41,C84.42,C84.43,C84.44,C84.45,C84.46,C84.47,C84.48,C84.49
;;^^^C83.00,C83.01,C83.02,C83.03,C83.04,C83.05,C83.06,C83.07,C83.08,C83.09
;;^^^C84.90,C84.91,C84.92,C84.93,C84.94,C84.95,C84.96,C84.97,C84.98,C84.99
;;^^^C84.Z0,C84.Z1,C84.Z2,C84.Z3,C84.Z4,C84.Z5,C84.Z6,C84.Z7,C84.Z8,C84.Z9
;;^^^C85.20,C85.21,C85.22,C85.23,C85.24,C85.25,C85.26,C85.27,C85.28,C85.29
;;^^^C83.90,C83.91,C83.92,C83.93,C83.94,C83.95,C83.96,C83.97,C83.98,C83.99
;;^^^C85.80,C85.81,C85.82,C85.83,C85.84,C85.85,C85.86,C85.87,C85.88,C85.89
;;VA NASH
;;^^^571.8,K75.81,571.40,571.41,571.49,K76.0
;;VA ILD
;;^^^501.,508.1,495.9,518.89,515.,516.0,516.1,516.2,516.30,516.31,516.32
;;^^^516.33,516.34,516.35,516.36,516.37,516.4,516.5,516.61,516.62,516.63
;;^^^516.64,516.69,516.9,517.8,714.81
;;^^^J84.10,J84.89,J84.01,J84.03,J84.02
;;^^^J84.111,J84.112,J84.113,J84.114,J84.115,J84.2,J84.116,J84.117
;;^^^J84.81,J84.82,J84.841,J84.842,J84.83,J84.843,J84.848,J84.9,D86.0,D86.1,D86.2
;;^^^J99.,M32.13,M33.01,M35.02,M33.11,M33.91,M33.21
;;^^^M05.19,M05.112,M05.111,M05.119,M05.121,M05.122,M05.129
;;^^^M05.131,M05.132,M05.139,M05.141,M05.142,M05.149,M05.151,M05.152,M05.159
;;^^^M05.161,M05.162,M05.169,M05.171,M05.172,M05.179,J61.,J70.1,J67.9
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_"^RORP034")),";;",2),U) Q:RORREG="" D
. S REGIEN=$$REGIEN^RORUTL02(RORREG)
. I REGIEN>0 D
.. F RORI1=1:1 S RORDATA=$P($T(@("LISTITEM+"_RORI1_"^RORP034")),";;",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[HRORP034 16927 printed Apr 09, 2024@20:46:46 Page 2
RORP034 ;ALB/MAF - CCR PRE/POST-INSTALL PATCH 34 ;18 Nov 2018 1:38 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**34**;Feb 17, 2006;Build 45
+2 ;
+3 ;*****************************************************************************
+4 ;*****************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- --------- ----------- ----------------------------------------
+9 ;ROR*1.5*34 Nov 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 34
+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_"^RORP034")),";;",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 34
+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 Future Appointments panel to reports")
+7 DO UPDPANEL
+8 DO BMES^XPDUTL(" >> Step complete")
+9 ;
+10 DO BMES^XPDUTL("Checking VA GENERIC drug file..COBICISTAT/DARUNAVIR/EMTRICITABINE/TENOFOVIR AF ")
+11 DO GENDRG
+12 DO BMES^XPDUTL(" >> Step complete")
+13 ;
+14 DO BMES^XPDUTL(">> Adding CPT and ICD-9 procedures to ROR ICD SEARCH file for new registries")
+15 DO UPDPROC
+16 DO BMES^XPDUTL(" >> Step complete")
+17 ;
+18 DO BMES^XPDUTL("Updating List Items for new registries")
+19 DO UPDLIST
+20 DO BMES^XPDUTL(" >> Step complete")
+21 ;
+22 DO BMES^XPDUTL(">> Initiating background job to set up registries added with this patch")
+23 NEW RORKIDS,RORERR,CT,DIERR
+24 SET RORKIDS=1
+25 FOR RORI=1:1
SET RORREG=$PIECE($PIECE($TEXT(@("NEWREG+"_RORI_"^RORP034")),";;",2),U)
if RORREG=""
QUIT
Begin DoDot:1
+26 SET REGIEN=$$REGIEN^RORUTL02(RORREG)
+27 if REGIEN'>0
QUIT
+28 IF $DATA(^XTMP("ROR_NO_INIT",REGIEN))
Begin DoDot:2
+29 SET RORERR(1)=" It appears new registry "_RORREG_"(ien #"_REGIEN_") has already been initialized"
+30 SET RORERR(2)=" You have chosen not to re-initialize this registry"
+31 SET RORERR(3)=" "
+32 DO MES^XPDUTL(.RORERR)
+33 KILL RORERR
End DoDot:2
QUIT
+34 ;
+35 KILL RORFDA,RORMSG,RORERR
+36 SET RORFDA(798.1,REGIEN_",",1)=2850101
+37 SET RORFDA(798.1,REGIEN_",",19.1)=""
+38 SET RORFDA(798.1,REGIEN_",",21.05)=""
+39 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+40 IF $DATA(DIERR)
Begin DoDot:2
+41 KILL RORERR
+42 MERGE RORERR=RORMSG
+43 DO DBS^RORERR("RORMSG",-112,,,798.1,REGIEN)
+44 MERGE RORMSG=RORERR
+45 KILL RORERR
+46 SET RORERR(1)=" New registry "_RORREG_"(ien #"_REGIEN_") encountered the following error"
+47 SET RORERR(2)=" and may not initialize correctly. Please report this error to your CCR contact:"
+48 SET RORERR(3)=""
+49 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))
+50 SET CT=CT+1
SET RORERR(CT)=" "
+51 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+52 DO ^RORSET02
+53 KILL ^XTMP("ROR_NO_INIT")
+54 DO BMES^XPDUTL(" >> Step complete")
+55 DO BMES^XPDUTL("Updating the Drug matching entries...")
DO EN^RORUTL22
+56 DO BMES^XPDUTL("Tasking nightly job to gather drug matching...")
DO TASK^RORUTL22
+57 DO CLEAN^DILF
+58 DO BMES^XPDUTL("POST INSTALL COMPLETE")
+59 QUIT
GENDRG ; --- Delete entry in ROR GENERIC DRUG with unresolved pointers
+1 ; clean up 799.51 if pointers are bad
+2 ; HIV registry : COBICISTAT/DARUNAVIR/EMTRICITABINE/TENOFOVIR AF - "COBI/DARUNAVIR/EMTRIC/TAF" Released in PSN*4*
+3 ;
+4 ;
+5 ;
+6 NEW DIC,X,DIK,DA,RORNAME,Y
+7 SET DIC=799.51
SET DIC(0)="MNZ"
+8 FOR RORNAME="COBI/DARUNAVIR/EMTRIC/TAF"
Begin DoDot:1
+9 SET X=RORNAME
DO ^DIC
if +Y<0
QUIT
+10 if +$PIECE(Y(0),U,4)>0
QUIT
+11 SET DA=+Y
SET DIK="^ROR(799.51,"
DO ^DIK
+12 DO BMES^XPDUTL("WARNING*** Missing entry in VA GENERIC file 50.6.")
End DoDot:1
+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 NEW CT,RORRPT,RORMSG,RORPAN,RORERR,RORFDA,Z,Z1,DIERR
+6 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=13
Begin DoDot:1
+7 SET Z1=$GET(^ROR(799.34,RORRPT,1))
+8 KILL RORFDA,RORMSG
+9 IF Z1[",24,29,"
Begin DoDot:2
+10 DO BMES^XPDUTL(" o New panel already exists for registry")
End DoDot:2
QUIT
+11 IF Z1'[",24,29,"
Begin DoDot:2
+12 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
+13 if '$DATA(RORFDA)
QUIT
+14 DO UPDATE^DIE("","RORFDA",,"RORMSG")
+15 IF $DATA(DIERR)
Begin DoDot:2
+16 KILL RORERR
+17 DO DBS^RORERR("RORMSG",-112,,,799.34,RORRPT)
+18 MERGE RORMSG=RORERR
+19 KILL RORERR
+20 SET RORERR(1)=" Update of report "_$PIECE($GET(^ROR(799.34,RORRPT,0)),U)_" with new panel"
+21 SET RORERR(2)=" encountered the following error. Please report this error to your CCR contact:"
+22 SET RORERR(3)=""
+23 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))
+24 SET CT=CT+1
SET RORERR(CT)=" "
+25 DO MES^XPDUTL(.RORERR)
End DoDot:2
End DoDot:1
+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 ;
+12 ;
+13 ;
+14 ;
NEWREG ; --- Update ROR LIST ITEM file (#799.1) for new registriesList of new registries to initialize
+1 ;;VA LYMPHOMA
+2 ;;VA NASH
+3 ;;VA ILD
+4 ;;
+5 ;
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="LYMPHOMA","NASH","ILD"
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 LYMPHOMA
+2 ;;^^^202.80,201.90,C91.50,C91.51,C91.52
+3 ;;^^^C84.70,C84.71,C84.72,C84.73,C84.74,C84.75,C84.76,C84.77,C84.78,C84.79
+4 ;;^^^C84.60,C84.61,C84.62,C84.63,C84.64,C84.65,C84.66,C84.67,C84.68,C84.69
+5 ;;^^^C85.10,C85.11,C85.12,C85.13,C85.14,C85.15,C85.16,C85.17,C85.18,C85.19
+6 ;;^^^C83.50,C83.51,C83.52,C83.53,C83.54,C83.55,C83.56,C83.57,C83.58,C83.59
+7 ;;^^^C88.0,C88.3,C88.4
+8 ;;^^^C83.70,C83.71,C83.72,C83.73,C83.74,C83.75,C83.76,C83.77,C83.78,C83.79
+9 ;;^^^C83.10,C83.11,C83.12,C83.13,C83.14,C83.15,C83.16,C83.17,C83.18,C83.19
+10 ;;^^^C82.60,C82.61,C82.62,C82.63,C82.64,C82.65,C82.66,C82.67,C82.68,C82.69
+11 ;;^^^C84.A0,C84.A1,C84.A2,C84.A3,C84.A4,C84.A5,C84.A6,C84.A7,C84.A8,C84.A9
+12 ;;^^^C82.50,C82.51,C82.52,C82.53,C82.54,C82.55,C82.56,C82.57,C82.58,C82.59
+13 ;;^^^C83.30,C83.31,C83.32,C83.33,C83.34,C83.35,C83.36,C83.37,C83.38,C83.39
+14 ;;^^^C86.0,C86.1,C86.2,C86.3,C86.4,C86.5,C86.6
+15 ;;^^^C82.90,C82.91,C82.92,C82.93,C82.94,C82.95,C82.96,C82.97,C82.98,C82.99
+16 ;;^^^C82.00,C82.01,C82.02,C82.03,C82.04,C82.05,C82.06,C82.07,C82.08,C82.09
+17 ;;^^^C82.10,C82.11,C82.12,C82.13,C82.14,C82.15,C82.16,C82.17,C82.18,C82.19
+18 ;;^^^C82.20,C82.21,C82.22,C82.23,C82.24,C82.25,C82.26,C82.27,C82.28,C82.29
+19 ;;^^^C82.30,C82.31,C82.32,C82.33,C82.34,C82.35,C82.36,C82.37,C82.38,C82.39
+20 ;;^^^C82.40,C82.41,C82.42,C82.43,C82.44,C82.45,C82.46,C82.47,C82.48,C82.49
+21 ;;^^^C82.80,C82.81,C82.82,C82.83,C82.84,C82.85,C82.86,C82.87,C82.88,C82.89
+22 ;;^^^C85.90,C85.91,C85.92,C85.93,C85.94,C85.95,C85.96,C85.97,C85.98,C85.99
+23 ;;^^^C96.A
+24 ;;^^^C81.90,C81.91,C81.92,C81.93,C81.94,C81.95,C81.96,C81.97,C81.98,C81.99
+25 ;;^^^C81.30,C81.31,C81.32,C81.33,C81.34,C81.35,C81.36,C81.37,C81.38,C81.39
+26 ;;^^^C81.40,C81.41,C81.42,C81.43,C81.44,C81.45,C81.46,C81.47,C81.48,C81.49
+27 ;;^^^C81.20,C81.21,C81.22,C81.23,C81.24,C81.25,C81.26,C81.27,C81.28,C81.29
+28 ;;^^^C81.00,C81.01,C81.02,C81.03,C81.04,C81.05,C81.06,C81.07,C81.08,C81.09
+29 ;;^^^C81.10,C81.11,C81.12,C81.13,C81.14,C81.15,C81.16,C81.17,C81.18,C81.19
+30 ;;^^^C81.70,C81.71,C81.72,C81.73,C81.74,C81.75,C81.76,C81.77,C81.78,C81.79
+31 ;;^^^C83.80,C83.81,C83.82,C83.83,C83.84,C83.85,C83.86,C83.87,C83.88,C83.89
+32 ;;^^^C84.40,C84.41,C84.42,C84.43,C84.44,C84.45,C84.46,C84.47,C84.48,C84.49
+33 ;;^^^C83.00,C83.01,C83.02,C83.03,C83.04,C83.05,C83.06,C83.07,C83.08,C83.09
+34 ;;^^^C84.90,C84.91,C84.92,C84.93,C84.94,C84.95,C84.96,C84.97,C84.98,C84.99
+35 ;;^^^C84.Z0,C84.Z1,C84.Z2,C84.Z3,C84.Z4,C84.Z5,C84.Z6,C84.Z7,C84.Z8,C84.Z9
+36 ;;^^^C85.20,C85.21,C85.22,C85.23,C85.24,C85.25,C85.26,C85.27,C85.28,C85.29
+37 ;;^^^C83.90,C83.91,C83.92,C83.93,C83.94,C83.95,C83.96,C83.97,C83.98,C83.99
+38 ;;^^^C85.80,C85.81,C85.82,C85.83,C85.84,C85.85,C85.86,C85.87,C85.88,C85.89
+39 ;;VA NASH
+40 ;;^^^571.8,K75.81,571.40,571.41,571.49,K76.0
+41 ;;VA ILD
+42 ;;^^^501.,508.1,495.9,518.89,515.,516.0,516.1,516.2,516.30,516.31,516.32
+43 ;;^^^516.33,516.34,516.35,516.36,516.37,516.4,516.5,516.61,516.62,516.63
+44 ;;^^^516.64,516.69,516.9,517.8,714.81
+45 ;;^^^J84.10,J84.89,J84.01,J84.03,J84.02
+46 ;;^^^J84.111,J84.112,J84.113,J84.114,J84.115,J84.2,J84.116,J84.117
+47 ;;^^^J84.81,J84.82,J84.841,J84.842,J84.83,J84.843,J84.848,J84.9,D86.0,D86.1,D86.2
+48 ;;^^^J99.,M32.13,M33.01,M35.02,M33.11,M33.91,M33.21
+49 ;;^^^M05.19,M05.112,M05.111,M05.119,M05.121,M05.122,M05.129
+50 ;;^^^M05.131,M05.132,M05.139,M05.141,M05.142,M05.149,M05.151,M05.152,M05.159
+51 ;;^^^M05.161,M05.162,M05.169,M05.171,M05.172,M05.179,J61.,J70.1,J67.9
+52 QUIT
+53 ;
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_"^RORP034")),";;",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_"^RORP034")),";;",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 ;
