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

RORUPEX.m

Go to the documentation of this file.
  1. RORUPEX ;HCIOFO/SG - SELECTION RULE EXPRESSION PARSER ; 7/21/03 9:47am
  1. ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1. ;
  1. Q
  1. ;
  1. ;***** GETS THE NEXT CHARACTER FROM THE EXPRESSION
  1. GETCHAR ;
  1. S LOOK=$E(EXPR,EPTR),EPTR=EPTR+1
  1. Q
  1. ;
  1. ;***** TRANSLATES FIELD OR RULE MACRO TO MUMPS CODE
  1. ;
  1. ; The function returns a string containing MUMPS expression
  1. ; that implements the selection rule macro.
  1. ;
  1. GETMACRO() ;
  1. ;;AVG,CNT,E,GDF,GDL,I,LS,MAX,MIN,SDF,SDL,SUM
  1. ;
  1. Q:'$$MATCH("{") ""
  1. N BI,BUF,DATELMT,NAME,PFX,PFXLST,RC,RORMSG,SFX,TMP,XCODE
  1. S PFXLST=","_$P($T(GETMACRO+1),";;",2)_","
  1. S BI=1,RC=0
  1. F D Q:RC
  1. . I LOOK="}" D GETCHAR S RC=1 Q
  1. . I LOOK=":" D GETCHAR S BI=BI+1 Q
  1. . I LOOK="{" D Q
  1. . . I BI<3 D SNTXERR("GETMACRO^RORUPEX") S RC=1 Q
  1. . . S BUF(BI)=$G(BUF(BI))_$$GETMACRO()
  1. . S BUF(BI)=$G(BUF(BI))_LOOK
  1. . D GETCHAR
  1. Q:ERRCODE<0 ""
  1. ;--- Get the parts of the macro
  1. S BI=1,(NAME,PFX,SFX)=""
  1. S TMP=$$UP^XLFSTR($$TRIM^XLFSTR($G(BUF(BI))))
  1. S:PFXLST[(","_TMP_",") PFX=TMP,BI=BI+1
  1. S NAME=$$TRIM^XLFSTR($G(BUF(BI))),BI=BI+1
  1. S SFX=$$TRIM^XLFSTR($G(BUF(BI))),BI=BI+1
  1. ;--- Data element value
  1. I (PFX="E")!(PFX="I") S XCODE="" D Q XCODE
  1. . S DATELMT=$S(+NAME=NAME:+NAME,1:$$DATACODE^RORUPDUT(FILE,NAME))
  1. . I DATELMT<0 S ERRCODE=DATELMT Q
  1. . S XCODE="$G(RORVALS(""DV"","_FILE_","_DATELMT_","""_PFX_"""))"
  1. . S RESULT("F",DATELMT,PFX)=""
  1. ;--- Lab Search (replace a name of the Lab Search with the IEN)
  1. I PFX="LS" D Q "$$RULE^RORUPD04("_TMP_")"
  1. . I FILE'=63 D SNTXERR("GETMACRO^RORUPEX") S TMP="" Q
  1. . S TMP="I '$P(^(0),U,2)" ; Only Active
  1. . S TMP=+$$FIND1^DIC(798.9,"","X",NAME,"B",TMP,"RORMSG")
  1. . S RC=$$DBS^RORERR("RORMSG",-9,,,798.9)
  1. . S:RC<0 ERRCODE=RC,TMP=0
  1. . S:TMP RESULT("L",TMP)=""
  1. ;--- Trigger date macros (set)
  1. I PFX="SDF" Q "$$SDF^RORUPDUT("""_NAME_""","_SFX_")"
  1. I PFX="SDL" Q "$$SDL^RORUPDUT("""_NAME_""","_SFX_")"
  1. ;--- Macros processed after this point cannot reference
  1. ; the rule that they are part of the expression of
  1. S RESULT("R",NAME)=""
  1. ;--- Trigger date macros (get)
  1. I (PFX="GDF")!(PFX="GDL") D Q XCODE
  1. . S XCODE="$$SRDT^RORUPDUT("""_NAME_""","""_PFX_""","_SFX_")"
  1. ;--- Value of the selection rule
  1. Q:PFX="" "$G(RORVALS(""SV"","""_NAME_"""))"
  1. Q "$G(RORVALS(""SV"","""_NAME_""","""_PFX_"""))"
  1. ;
  1. ;***** GETS A STRING CONSTANT FROM THE EXPRESSION
  1. ;
  1. ; The function returns a string argument from the expression.
  1. ;
  1. GETSTR() ;
  1. Q:'$$MATCH("""") ""
  1. N RC,STR
  1. S STR="",RC=0
  1. F D Q:RC
  1. . I LOOK="""" D Q:RC
  1. . . D GETCHAR
  1. . . I LOOK'="""" S RC=1 Q
  1. . . S STR=STR_""""
  1. . S STR=STR_LOOK
  1. . D GETCHAR
  1. Q STR
  1. ;
  1. ;***** INITIALIZES PARSING PROCESS
  1. INIT ;
  1. S EPTR=1,ERRCODE=0,RESULT=""
  1. D GETCHAR,SKIPWHT
  1. Q
  1. ;
  1. ;***** COMPARES LOOK-AHEAD CHARACTER TO THE ARGUMENT
  1. MATCH(CH) ;
  1. I LOOK=CH D GETCHAR Q 1
  1. D SNTXERR("MATCH^RORUPEX")
  1. Q 0
  1. ;
  1. ;***** PARSES THE EXPRESSION
  1. ;
  1. ; FILE File number
  1. ; EXPR Source expression
  1. ; .RESULT( Resulting MUMPS code
  1. ; "F", List of data elements to load
  1. ; DataCode)
  1. ; "L",LS#) List of Lab Search IENs
  1. ; "R",Rule#) List of rules that this expression depend on
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. PARSER(FILE,EXPR,RESULT) ;
  1. N EPTR ; Current position in the expression
  1. N ERRCODE ; Error code
  1. N LOOK ; Look-ahead character
  1. ;
  1. ;--- Check if the file exists and supported
  1. Q:'$$VFILE^DILFD(FILE) $$ERROR^RORERR(-58,"PARSER^RORUPEX",,,FILE)
  1. Q:'$D(^ROR(799.2,FILE)) $$ERROR^RORERR(-63,"PARSER^RORUPEX",,,FILE)
  1. ;--- Parse the expression
  1. D INIT
  1. F Q:LOOK="" D Q:ERRCODE<0
  1. . I LOOK="""" D Q
  1. . . S RESULT=RESULT_""""_$$GETSTR()_""""
  1. . I LOOK="{" D Q
  1. . . S RESULT=RESULT_$$GETMACRO()
  1. . S RESULT=RESULT_LOOK
  1. . D GETCHAR
  1. ;
  1. Q $S(ERRCODE<0:ERRCODE,1:0)
  1. ;
  1. ;***** PROCESSES A SYNTAX ERROR
  1. SNTXERR(PLACE,MSG) ;
  1. N I,INFO S I=0
  1. S:$G(MSG)'="" I=I+1,INFO(I)=MSG
  1. S I=I+1,INFO(I)="Position: "_EPTR
  1. S:LOOK'="" INFO(I)=INFO(I)_", Character: '"_LOOK_"'"
  1. S ERRCODE=$$ERROR^RORERR(-21,$G(PLACE),.INFO)
  1. Q
  1. ;
  1. ;***** SKIPS WHITE SPACES IN THE EXPRESSION
  1. SKIPWHT ;
  1. F Q:(" "'[LOOK)!(LOOK="") D GETCHAR
  1. Q