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

RORUPR1.m

Go to the documentation of this file.
  1. RORUPR1 ;HCIOFO/SG - SELECTION RULES PREPARATION ;11/20/05 4:56pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;**12,19,24,26**;Feb 17, 2006;Build 53
  1. ;
  1. ;01/04/2011 BAY/KAM ROR*1.5*12 Remedy Call 421530 Populate a variable
  1. ; to assist with Lab Test Result Code
  1. ; identification in GCPR^LA7QRY
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
  1. ;ROR*1.5*24 AUG 2014 T KOPP Change to lookup for selection rule names
  1. ; longer than 30 characters
  1. ; Added NEW of variable DIERR at FILETREE
  1. ; and METADATA
  1. ;ROR*1.5*26 APR 2015 T KOPP Added code to support PTF procedure rule
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. Q
  1. ;
  1. ;***** MARKS PARENT FILES TO PROCESS
  1. ;
  1. ; This function analyzes file dependencies defined by the 'ROR
  1. ; METADATA' file and guaranties that all necessary files will be
  1. ; processed during the registry update.
  1. ;
  1. FILETREE() ;
  1. N FILE,PF,RC,DIERR
  1. S FILE="",RC=0
  1. F S FILE=$O(RORUPD("SR",FILE)) Q:FILE="" D Q:RC<0
  1. . S PF=+FILE,RC=0
  1. . ;--- Follow a path that leads from this file to
  1. . ; the root of the "file-processing tree".
  1. . F D Q:RC
  1. . . ;--- Check if metadata for the file is defined
  1. . . I '$D(^ROR(799.2,PF)) D Q
  1. . . . S RC=$$ERROR^RORERR(-63,,,,PF)
  1. . . ;--- Get the number of the parent file
  1. . . S PF=+$$GET1^DIQ(799.2,PF_",",1,"I",,"RORMSG")
  1. . . I $G(DIERR) D Q
  1. . . . S RC=$$DBS^RORERR("RORMSG",-9)
  1. . . ;--- Stop if the root of the "file-processing tree" has been
  1. . . ; reached or the file is already marked for processing.
  1. . . ; Otherwise, mark the file and continue moving up.
  1. . . I 'PF!$D(RORUPD("SR",PF)) S RC=1 Q
  1. . . S RORUPD("SR",PF)=""
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** RETURNS LEVEL OF THE FILE IN 'THE FILE PROCESSING' TREE
  1. ;
  1. ; FILE File number
  1. ;
  1. FLEVEL(FILE) ;
  1. N LEVEL
  1. S LEVEL=1
  1. F S FILE=+$P($G(^ROR(799.2,FILE,0)),U,2) Q:'FILE S LEVEL=LEVEL+1
  1. Q LEVEL
  1. ;
  1. ;***** LOADS AND PREPARES LAB SEARCH INDICATORS
  1. ;
  1. ; Return Values:
  1. ; 0 Ok
  1. ; <0 Error code
  1. ;
  1. LABSRCH() ;
  1. N I,IND,IR,LRCODE,LSICNT,LSIEN,RC,RORBUF,RORMSG,TMP,VAL
  1. K RORLRC
  1. ;--- Browse through the list of Lab searches
  1. S LSIEN="",RC=0
  1. F S LSIEN=$O(@RORUPDPI@(4,LSIEN)) Q:LSIEN="" D Q:RC<0
  1. . K RORBUF S TMP=","_LSIEN_","
  1. . D LIST^DIC(798.92,TMP,"@;.01;.02;1I;2",,,,,"B",,,"RORBUF","RORMSG")
  1. . S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
  1. . ;--- Browse through the list of search indicators
  1. . S IR="",LSICNT=0
  1. . F S IR=$O(RORBUF("DILIST","ID",IR)) Q:IR="" D Q:RC<0
  1. . . K LRCODE
  1. . . ;--- Check if the indicator should be ignored
  1. . . S IND=$G(RORBUF("DILIST","ID",IR,1)) Q:IND'>0
  1. . . ;--- Get the result code (LOINC and/or NLT)
  1. . . S LRCODE=$G(RORBUF("DILIST","ID",IR,.01))
  1. . . I LRCODE>0 D Q:LRCODE<0 S LRCODE(LRCODE_"^LN")=""
  1. . . . S LRCODE=$$LNCODE^RORUTL02(LRCODE)
  1. . . S LRCODE=$G(RORBUF("DILIST","ID",IR,.02))
  1. . . S:LRCODE>0 LRCODE(LRCODE_"^NLT")=""
  1. . . ;--- Either LOINC or NLT must be defined
  1. . . Q:$D(LRCODE)<10
  1. . . M RORLRC("B")=LRCODE
  1. . . ;--- Prepare and store the search indicator
  1. . . S VAL=$G(RORBUF("DILIST","ID",IR,2))
  1. . . I VAL="",IND'=1,IND'=6 Q
  1. . . S LSICNT=LSICNT+1
  1. . . S LRCODE=""
  1. . . F S LRCODE=$O(LRCODE(LRCODE)) Q:LRCODE="" D
  1. . . . S I=$O(@RORUPDPI@("LS",LRCODE,LSIEN,""),-1)+1
  1. . . . S @RORUPDPI@("LS",LRCODE,LSIEN,I)=IND_U_VAL
  1. . Q:(RC<0)!(LSICNT>0)
  1. . ;--- Record a warning if no indicators are defined
  1. . S TMP=$$GET1^DIQ(798.9,LSIEN_",",.01,,,"RORMSG")
  1. . S TMP=$$ERROR^RORERR(-55,,,,TMP)
  1. Q:RC<0 RC
  1. ;--- Prepare a list of Lab result codes for GCPR^LA7QRY
  1. ;01/04/2011 BAY/KAM ROR*1.5*12 added RORLRC variable set to next line
  1. S LRCODE="",RORLRC="CH"
  1. F IR=1:1 S LRCODE=$O(RORLRC("B",LRCODE)) Q:LRCODE="" D
  1. . S RORLRC(IR)=LRCODE
  1. K RORLRC("B")
  1. Q 0
  1. ;
  1. ;***** LOADS SELECTION RULES DATA
  1. ;
  1. ; .REGLST Reference to a local array containing registry names
  1. ; as subscripts and optional registry IENs as values
  1. ;
  1. ; Return Values:
  1. ; 0 Ok
  1. ; <0 Error code
  1. ;
  1. LOAD(REGLST) ;
  1. N I,IENS,RC,REGIEN,REGNAME,RORBUF,RORMSG,RULENAME
  1. K RORUPD("LM1")
  1. S REGNAME="",RC=0
  1. F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
  1. . S REGIEN=+$G(REGLST(REGNAME))
  1. . I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
  1. . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
  1. . S @RORUPDPI@(2,REGIEN)=REGNAME
  1. . ;--- Load selection rules
  1. . K RORBUF S IENS=","_REGIEN_","
  1. . D LIST^DIC(798.13,IENS,"@;.01E","U",,,,"B",,,"RORBUF","RORMSG")
  1. . S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
  1. . S I=""
  1. . F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D Q:RC<0
  1. . . S RULENAME=RORBUF("DILIST","ID",I,.01)
  1. . . S RC=$$LOADRULE(RULENAME,REGIEN)
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** LOADS THE SELECTION RULE
  1. ;
  1. ; RULENAME Name of the rule
  1. ; REGIEN Registry IEN
  1. ; [LEVEL] Level of the rule (O for top level rules)
  1. ;
  1. ; Return Values:
  1. ; 0 Ok
  1. ; <0 Error code
  1. ;
  1. LOADRULE(RULENAME,REGIEN,LEVEL) ;
  1. ;--- Quit if the rule has already been loaded
  1. I $D(@RORUPDPI@(3,RULENAME)) D Q 0
  1. . S @RORUPDPI@(3,RULENAME,2,REGIEN)=""
  1. ;---
  1. N DATELMT,DEPRLC,EXPR,FILE,I,IENS,RORBUF,RORMSG,RULIEN,TMP
  1. ;--- Load the rule data
  1. ;D FIND^DIC(798.2,,"@;1;2I","X",RULENAME,2,"B",,,"RORBUF","RORMSG")
  1. D FIND^DIC(798.2,,"@;1;2I;7I","KO",RULENAME,2,,,,"RORBUF","RORMSG") ;load the new coding system internal value
  1. S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
  1. Q:$G(RORBUF("DILIST",0))<1 $$ERROR^RORERR(-3,,RULENAME)
  1. Q:$G(RORBUF("DILIST",0))>1 $$ERROR^RORERR(-4,,RULENAME)
  1. S RULIEN=+RORBUF("DILIST",2,1),IENS=","_RULIEN_","
  1. S FILE=+RORBUF("DILIST","ID",1,2)
  1. ;--- Put the rule data into the temporary global
  1. S @RORUPDPI@(1,FILE,"S",RULENAME)=""
  1. S @RORUPDPI@(3,RULENAME)=RULIEN_U_FILE_"^^"_'$G(LEVEL)
  1. S RC=$$PARSER^RORUPEX(FILE,RORBUF("DILIST","ID",1,1),.EXPR)
  1. Q:RC<0 RC
  1. S @RORUPDPI@(3,RULENAME,1)=EXPR
  1. S @RORUPDPI@(3,RULENAME,2,REGIEN)=""
  1. S @RORUPDPI@(3,RULENAME,4)=RORBUF("DILIST","ID",1,7) ;store the coding system
  1. M @RORUPDPI@(1,FILE,"F")=EXPR("F")
  1. S:'$G(LEVEL) RORUPD("LM1",RULENAME)=""
  1. M @RORUPDPI@(4)=EXPR("L")
  1. ;--- Load the rules that this rule depends on
  1. S DEPRLC=""
  1. F S DEPRLC=$O(EXPR("R",DEPRLC)) Q:DEPRLC="" D Q:RC<0
  1. . S RC=$$LOADRULE(DEPRLC,REGIEN,$G(LEVEL)+1)
  1. . S:RC'<0 @RORUPDPI@(3,RULENAME,3,DEPRLC)=""
  1. Q:RC<0 RC
  1. ;--- Load a list of additional data elements
  1. K EXPR,RORBUF,RORMSG
  1. D LIST^DIC(798.26,IENS,"@;.01I;1I",,,,,"B",,,"RORBUF","RORMSG")
  1. S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
  1. S I=""
  1. F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D
  1. . S DATELMT=RORBUF("DILIST","ID",I,.01)
  1. . S TMP=$G(RORBUF("DILIST","ID",I,1)) S:TMP="" TMP="EI"
  1. . S:TMP["E" @RORUPDPI@(1,FILE,"F",DATELMT,"E")=""
  1. . S:TMP["I" @RORUPDPI@(1,FILE,"F",DATELMT,"I")=""
  1. Q 0
  1. ;
  1. ;***** LOADS AND PREPARES THE METADATA
  1. METADATA() ;
  1. N API,DATELMT,DEFL,DIERR,FILE,I,IENS,IS,PIF,RC,ROOT,RORBUF,RORMSG,TMP,VT
  1. S RC=$$FILETREE() Q:RC<0 RC
  1. S DEFL="@;.02I;1I;4I;4.1;4.2;6I"
  1. ;--- Load and process the metadata
  1. S FILE="",RC=0
  1. F S FILE=$O(RORUPD("SR",FILE)) Q:FILE="" D Q:RC<0
  1. . S IENS=","_FILE_",",PIF=$NA(@RORUPDPI@(1,FILE))
  1. . ;--- Global root of the file
  1. . S RORUPD("ROOT",FILE)=$$ROOT^DILFD(FILE,,1)
  1. . ;--- Associate data elements with APIs
  1. . S DATELMT=""
  1. . F S DATELMT=$O(@PIF@("F",DATELMT)) Q:DATELMT="" D Q:RC<0
  1. . . ;--- Find and load defintion of the data element
  1. . . K RORBUF,RORMSG
  1. . . D FIND^DIC(799.22,IENS,DEFL,"X",DATELMT,,"C",,,"RORBUF","RORMSG")
  1. . . I $G(DIERR) D Q
  1. . . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.22,IENS)
  1. . . ;--- Check if search on this element is supported
  1. . . S API=+$G(RORBUF("DILIST","ID",1,1))
  1. . . I 'API D Q
  1. . . . S RC=$$ERROR^RORERR(-64,,,,FILE,DATELMT)
  1. . . ;--- Store the field number (if necessary)
  1. . . I API=1 D S RORUPD("SR",FILE,"F",API,DATELMT)=TMP
  1. . . . S TMP=$G(RORBUF("DILIST","ID",1,6))
  1. . . I API=3,FILE=45 D Q
  1. . . . S RORUPD("SR",45,"F",3,DATELMT)=0
  1. . . . S RORUPD("SR",45,"F",3,DATELMT,"I")="",RC=0
  1. . . ;--- Associate the data element with the API
  1. . . S VT=$G(RORBUF("DILIST","ID",1,4)),RC=0
  1. . . F I="E","I" I $D(@PIF@("F",DATELMT,I)) D Q:RC<0
  1. . . . ;--- Check if type of the requested value is supported
  1. . . . I VT'[I D Q
  1. . . . . S TMP=$$EXTERNAL^DILFD(799.22,4,,I,"RORMSG")
  1. . . . . S RC=$$ERROR^RORERR(-65,,,,FILE,DATELMT,TMP)
  1. . . . ;--- Add the API-Element pair to the list
  1. . . . S TMP=$G(RORBUF("DILIST","ID",1,$$VTFN(I)))
  1. . . . S RORUPD("SR",FILE,"F",API,DATELMT,I)=TMP
  1. . Q:RC<0
  1. . ;--- Add required elements (if any) to the list
  1. . K RORBUF,RORMSG
  1. . D FIND^DIC(799.22,IENS,DEFL,"X",1,,"AR",,,"RORBUF","RORMSG")
  1. . I $G(DIERR) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,,799.22,IENS)
  1. . S IS=""
  1. . F S IS=$O(RORBUF("DILIST","ID",IS)) Q:IS="" D
  1. . . S DATELMT=+$G(RORBUF("DILIST","ID",IS,.02)) Q:'DATELMT
  1. . . S API=+$G(RORBUF("DILIST","ID",IS,1)) Q:'API
  1. . . S VT=$G(RORBUF("DILIST","ID",IS,4))
  1. . . F I="E","I" D:VT[I
  1. . . . S TMP=$G(RORBUF("DILIST","ID",IS,$$VTFN(I)))
  1. . . . S RORUPD("SR",FILE,"F",API,DATELMT,I)=TMP
  1. . . ;--- Store the field number (if necessary)
  1. . . I API=1 D S RORUPD("SR",FILE,"F",API,DATELMT)=TMP
  1. . . . S TMP=$G(RORBUF("DILIST","ID",IS,6))
  1. . ;--- Compile a list of fields (separated by ';') for the GETS^DIQ
  1. . Q:$D(RORUPD("SR",FILE,"F",1))<10
  1. . S (DATELMT,RORBUF)=""
  1. . F S DATELMT=$O(RORUPD("SR",FILE,"F",1,DATELMT)) Q:DATELMT="" D
  1. . . S TMP=+$G(RORUPD("SR",FILE,"F",1,DATELMT))
  1. . . S:TMP>0 RORBUF=RORBUF_";"_TMP
  1. . S RORUPD("SR",FILE,"F",1)=$S(RORBUF'="":$P(RORBUF,";",2,999),1:"")
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** RETURNS FIELD NUMBER OF ADDITIONAL DATA
  1. VTFN(VT) ;
  1. Q $S(VT="E":4.1,1:4.2)