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

RORUPD06.m

Go to the documentation of this file. 
  1. RORUPD06 ;HCIOFO/SG - REGISTRY UPDATE (MISCELLANEOUS) ; 11/25/03 3:49pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** ADDS THE PATIENT TO THE REGISTRY (UNCONDITIONALLY)
  1.  ;
  1.  ; PATIEN        Patient IEN
  1.  ; REGNAME       Registry name
  1.  ; .RULES        Reference to a local array containing list of
  1.  ;               triggered selection rules: RULES(n)=RuleIEN^Date
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code (see MSGLIST^RORERR20)
  1.  ;        0  Ok
  1.  ;
  1. ADDPAT(PATIEN,REGNAME,RULES) ;
  1.  N RORERRDL      ; Default error location
  1.  N RORUPD        ; Update descriptor
  1.  N RORUPDPI      ; Closed root of the temporary storage
  1.  ;
  1.  N I,RC,REGIEN,REGLST,RORLRC,RORSRLST,RULEIEN,VSRLST
  1.  D INIT^RORUTL01("RORUPD")
  1.  D CLEAR^RORERR("ADDPAT^RORUPD06")
  1.  S RORUPDPI=$NA(^TMP("RORUPD",$J))
  1.  ;--- Check the registry name
  1.  Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
  1.  S REGIEN=$$REGIEN^RORUTL02(REGNAME)  Q:REGIEN<0 REGIEN
  1.  S REGLST(REGNAME)=REGIEN
  1.  ;--- Compile a list of IENs of valid selection rules
  1.  S I=""
  1.  F  S I=$O(^ROR(798.1,REGIEN,1,"B",I))  Q:I=""  D
  1.  . S RULEIEN=$$SRLIEN^RORUTL02(I)  S:RULEIEN>0 VSRLST(RULEIEN)=""
  1.  ;--- Prepare list of triggered selection rules
  1.  S I="",RC=0
  1.  F  S I=$O(RULES(I))  Q:I=""  D  Q:RC<0
  1.  . S RULEIEN=$P(RULES(I),U)
  1.  . I RULEIEN'>0            S RC=$$ERROR^RORERR(-45)  Q
  1.  . I '$D(VSRLST(RULEIEN))  S RC=$$ERROR^RORERR(-45)  Q
  1.  . S RORSRLST(RULEIEN)=$P(RULES(I),U,2)
  1.  Q:RC<0 RC
  1.  ;--- Prepare update descriptor
  1.  S RC=$$PREPARE1^RORUPR(.REGLST)
  1.  Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
  1.  ;--- Add the patient to the registry
  1.  S RC=$$ADDPDATA^RORUPD50(PATIEN)               Q:RC<0 RC
  1.  S RC=$$ADD^RORUPD50(PATIEN,REGIEN,"RORSRLST")  Q:RC<0 RC
  1.  ;--- Update patient demographic data
  1.  S RC=$$UPDPTDEM^RORUPD51(PATIEN)
  1.  Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
  1.  ;--- Cleanup
  1.  D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
  1.  Q 0
  1.  ;
  1.  ;***** CHECKS/UPDATES THE SINGLE PATIENT IN THE REGISTRY
  1.  ;
  1.  ; PATIEN        Patient IEN
  1.  ; REGNAME       Registry name
  1.  ;
  1.  ; .UPDBYRUL     Reference to a local array for the list of rules that
  1.  ;               the patient is selected by (output). The list has
  1.  ;               the following structure: UPDBYRUL(Rule#)=Date, where
  1.  ;               "Rule#" is an IEN of the selection rule in the file
  1.  ;               #798.2 and "Date" is the date when the patient has
  1.  ;               passed the selection rule for the first time.
  1.  ;
  1.  ; [CHKONLY]     If this optional parameter is undefined (default)
  1.  ;               or equals to zero then the function checks a patient
  1.  ;               against selection rules and adds him to the registry 
  1.  ;               if he passes at least one of the rules.
  1.  ;               Otherwise, the patient is only checked against the
  1.  ;               rules but registry is not updated.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code (see MSGLIST^RORERR20)
  1.  ;        0  Ok
  1.  ;
  1.  ; If a local array passed as the UPDBYRUL parameter is undefined
  1.  ; after return from the function then the patient has not pass any
  1.  ; selection rule.
  1.  ;
  1. UPDPAT(PATIEN,REGNAME,UPDBYRUL,CHKONLY) ;
  1.  N RORERRDL      ; Default error location
  1.  N RORLRC        ; List of Lab result codes to check
  1.  N RORUPD        ; Update descriptor
  1.  N RORUPDPI      ; Closed root of the temporary storage
  1.  N RORVALS       ; Calculated values
  1.  ;
  1.  N RC,REGIEN,REGLST
  1.  D INIT^RORUTL01("RORUPD")
  1.  D CLEAR^RORERR("UPDPAT^RORUPD06")
  1.  S RORUPDPI=$NA(^TMP("RORUPD",$J))
  1.  ;--- Check the registry name
  1.  Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
  1.  S REGLST(REGNAME)=""  K UPDBYRUL
  1.  ;--- Prepare selection rules
  1.  S RC=$$PREPARE^RORUPR(.REGLST)
  1.  Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
  1.  D:$G(RORPARM("DEBUG"))>1 DEBUG^RORUPDUT
  1.  ;--- Check the patient and update the registry
  1.  S RC=$$PROCPAT^RORUPD01(PATIEN,$G(CHKONLY))
  1.  Q:RC<0 $$ERROR^RORERR(-15,,,PATIEN)
  1.  ;--- Update patient demographic data
  1.  I '$G(CHKONLY)  D  Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
  1.  . S RC=$$UPDPTDEM^RORUPD51(PATIEN)
  1.  ;--- Load the list of triggered rules
  1.  S REGIEN=""
  1.  F  S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN))  Q:REGIEN=""  D
  1.  . M UPDBYRUL=@RORUPDPI@("U",PATIEN,2,REGIEN)
  1.  ;--- Cleanup
  1.  D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
  1.  Q 0