RORUPD06 ;HCIOFO/SG - REGISTRY UPDATE (MISCELLANEOUS) ; 11/25/03 3:49pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** ADDS THE PATIENT TO THE REGISTRY (UNCONDITIONALLY)
;
; PATIEN Patient IEN
; REGNAME Registry name
; .RULES Reference to a local array containing list of
; triggered selection rules: RULES(n)=RuleIEN^Date
;
; Return Values:
; <0 Error code (see MSGLIST^RORERR20)
; 0 Ok
;
ADDPAT(PATIEN,REGNAME,RULES) ;
N RORERRDL ; Default error location
N RORUPD ; Update descriptor
N RORUPDPI ; Closed root of the temporary storage
;
N I,RC,REGIEN,REGLST,RORLRC,RORSRLST,RULEIEN,VSRLST
D INIT^RORUTL01("RORUPD")
D CLEAR^RORERR("ADDPAT^RORUPD06")
S RORUPDPI=$NA(^TMP("RORUPD",$J))
;--- Check the registry name
Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
S REGIEN=$$REGIEN^RORUTL02(REGNAME) Q:REGIEN<0 REGIEN
S REGLST(REGNAME)=REGIEN
;--- Compile a list of IENs of valid selection rules
S I=""
F S I=$O(^ROR(798.1,REGIEN,1,"B",I)) Q:I="" D
. S RULEIEN=$$SRLIEN^RORUTL02(I) S:RULEIEN>0 VSRLST(RULEIEN)=""
;--- Prepare list of triggered selection rules
S I="",RC=0
F S I=$O(RULES(I)) Q:I="" D Q:RC<0
. S RULEIEN=$P(RULES(I),U)
. I RULEIEN'>0 S RC=$$ERROR^RORERR(-45) Q
. I '$D(VSRLST(RULEIEN)) S RC=$$ERROR^RORERR(-45) Q
. S RORSRLST(RULEIEN)=$P(RULES(I),U,2)
Q:RC<0 RC
;--- Prepare update descriptor
S RC=$$PREPARE1^RORUPR(.REGLST)
Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
;--- Add the patient to the registry
S RC=$$ADDPDATA^RORUPD50(PATIEN) Q:RC<0 RC
S RC=$$ADD^RORUPD50(PATIEN,REGIEN,"RORSRLST") Q:RC<0 RC
;--- Update patient demographic data
S RC=$$UPDPTDEM^RORUPD51(PATIEN)
Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
;--- Cleanup
D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
Q 0
;
;***** CHECKS/UPDATES THE SINGLE PATIENT IN THE REGISTRY
;
; PATIEN Patient IEN
; REGNAME Registry name
;
; .UPDBYRUL Reference to a local array for the list of rules that
; the patient is selected by (output). The list has
; the following structure: UPDBYRUL(Rule#)=Date, where
; "Rule#" is an IEN of the selection rule in the file
; #798.2 and "Date" is the date when the patient has
; passed the selection rule for the first time.
;
; [CHKONLY] If this optional parameter is undefined (default)
; or equals to zero then the function checks a patient
; against selection rules and adds him to the registry
; if he passes at least one of the rules.
; Otherwise, the patient is only checked against the
; rules but registry is not updated.
;
; Return Values:
; <0 Error code (see MSGLIST^RORERR20)
; 0 Ok
;
; If a local array passed as the UPDBYRUL parameter is undefined
; after return from the function then the patient has not pass any
; selection rule.
;
UPDPAT(PATIEN,REGNAME,UPDBYRUL,CHKONLY) ;
N RORERRDL ; Default error location
N RORLRC ; List of Lab result codes to check
N RORUPD ; Update descriptor
N RORUPDPI ; Closed root of the temporary storage
N RORVALS ; Calculated values
;
N RC,REGIEN,REGLST
D INIT^RORUTL01("RORUPD")
D CLEAR^RORERR("UPDPAT^RORUPD06")
S RORUPDPI=$NA(^TMP("RORUPD",$J))
;--- Check the registry name
Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
S REGLST(REGNAME)="" K UPDBYRUL
;--- Prepare selection rules
S RC=$$PREPARE^RORUPR(.REGLST)
Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
D:$G(RORPARM("DEBUG"))>1 DEBUG^RORUPDUT
;--- Check the patient and update the registry
S RC=$$PROCPAT^RORUPD01(PATIEN,$G(CHKONLY))
Q:RC<0 $$ERROR^RORERR(-15,,,PATIEN)
;--- Update patient demographic data
I '$G(CHKONLY) D Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
. S RC=$$UPDPTDEM^RORUPD51(PATIEN)
;--- Load the list of triggered rules
S REGIEN=""
F S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN)) Q:REGIEN="" D
. M UPDBYRUL=@RORUPDPI@("U",PATIEN,2,REGIEN)
;--- Cleanup
D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD06 4263 printed Apr 09, 2024@20:47:49 Page 2
RORUPD06 ;HCIOFO/SG - REGISTRY UPDATE (MISCELLANEOUS) ; 11/25/03 3:49pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** ADDS THE PATIENT TO THE REGISTRY (UNCONDITIONALLY)
+6 ;
+7 ; PATIEN Patient IEN
+8 ; REGNAME Registry name
+9 ; .RULES Reference to a local array containing list of
+10 ; triggered selection rules: RULES(n)=RuleIEN^Date
+11 ;
+12 ; Return Values:
+13 ; <0 Error code (see MSGLIST^RORERR20)
+14 ; 0 Ok
+15 ;
ADDPAT(PATIEN,REGNAME,RULES) ;
+1 ; Default error location
NEW RORERRDL
+2 ; Update descriptor
NEW RORUPD
+3 ; Closed root of the temporary storage
NEW RORUPDPI
+4 ;
+5 NEW I,RC,REGIEN,REGLST,RORLRC,RORSRLST,RULEIEN,VSRLST
+6 DO INIT^RORUTL01("RORUPD")
+7 DO CLEAR^RORERR("ADDPAT^RORUPD06")
+8 SET RORUPDPI=$NAME(^TMP("RORUPD",$JOB))
+9 ;--- Check the registry name
+10 if REGNAME?." "
QUIT $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
+11 SET REGIEN=$$REGIEN^RORUTL02(REGNAME)
if REGIEN<0
QUIT REGIEN
+12 SET REGLST(REGNAME)=REGIEN
+13 ;--- Compile a list of IENs of valid selection rules
+14 SET I=""
+15 FOR
SET I=$ORDER(^ROR(798.1,REGIEN,1,"B",I))
if I=""
QUIT
Begin DoDot:1
+16 SET RULEIEN=$$SRLIEN^RORUTL02(I)
if RULEIEN>0
SET VSRLST(RULEIEN)=""
End DoDot:1
+17 ;--- Prepare list of triggered selection rules
+18 SET I=""
SET RC=0
+19 FOR
SET I=$ORDER(RULES(I))
if I=""
QUIT
Begin DoDot:1
+20 SET RULEIEN=$PIECE(RULES(I),U)
+21 IF RULEIEN'>0
SET RC=$$ERROR^RORERR(-45)
QUIT
+22 IF '$DATA(VSRLST(RULEIEN))
SET RC=$$ERROR^RORERR(-45)
QUIT
+23 SET RORSRLST(RULEIEN)=$PIECE(RULES(I),U,2)
End DoDot:1
if RC<0
QUIT
+24 if RC<0
QUIT RC
+25 ;--- Prepare update descriptor
+26 SET RC=$$PREPARE1^RORUPR(.REGLST)
+27 if RC<0
QUIT $$ERROR^RORERR(-14,,,PATIEN)
+28 ;--- Add the patient to the registry
+29 SET RC=$$ADDPDATA^RORUPD50(PATIEN)
if RC<0
QUIT RC
+30 SET RC=$$ADD^RORUPD50(PATIEN,REGIEN,"RORSRLST")
if RC<0
QUIT RC
+31 ;--- Update patient demographic data
+32 SET RC=$$UPDPTDEM^RORUPD51(PATIEN)
+33 if RC<0
QUIT $$ERROR^RORERR(-16,,,PATIEN)
+34 ;--- Cleanup
+35 if '$GET(RORPARM("DEBUG"))
DO INIT^RORUTL01("RORUPD")
+36 QUIT 0
+37 ;
+38 ;***** CHECKS/UPDATES THE SINGLE PATIENT IN THE REGISTRY
+39 ;
+40 ; PATIEN Patient IEN
+41 ; REGNAME Registry name
+42 ;
+43 ; .UPDBYRUL Reference to a local array for the list of rules that
+44 ; the patient is selected by (output). The list has
+45 ; the following structure: UPDBYRUL(Rule#)=Date, where
+46 ; "Rule#" is an IEN of the selection rule in the file
+47 ; #798.2 and "Date" is the date when the patient has
+48 ; passed the selection rule for the first time.
+49 ;
+50 ; [CHKONLY] If this optional parameter is undefined (default)
+51 ; or equals to zero then the function checks a patient
+52 ; against selection rules and adds him to the registry
+53 ; if he passes at least one of the rules.
+54 ; Otherwise, the patient is only checked against the
+55 ; rules but registry is not updated.
+56 ;
+57 ; Return Values:
+58 ; <0 Error code (see MSGLIST^RORERR20)
+59 ; 0 Ok
+60 ;
+61 ; If a local array passed as the UPDBYRUL parameter is undefined
+62 ; after return from the function then the patient has not pass any
+63 ; selection rule.
+64 ;
UPDPAT(PATIEN,REGNAME,UPDBYRUL,CHKONLY) ;
+1 ; Default error location
NEW RORERRDL
+2 ; List of Lab result codes to check
NEW RORLRC
+3 ; Update descriptor
NEW RORUPD
+4 ; Closed root of the temporary storage
NEW RORUPDPI
+5 ; Calculated values
NEW RORVALS
+6 ;
+7 NEW RC,REGIEN,REGLST
+8 DO INIT^RORUTL01("RORUPD")
+9 DO CLEAR^RORERR("UPDPAT^RORUPD06")
+10 SET RORUPDPI=$NAME(^TMP("RORUPD",$JOB))
+11 ;--- Check the registry name
+12 if REGNAME?." "
QUIT $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
+13 SET REGLST(REGNAME)=""
KILL UPDBYRUL
+14 ;--- Prepare selection rules
+15 SET RC=$$PREPARE^RORUPR(.REGLST)
+16 if RC<0
QUIT $$ERROR^RORERR(-14,,,PATIEN)
+17 if $GET(RORPARM("DEBUG"))>1
DO DEBUG^RORUPDUT
+18 ;--- Check the patient and update the registry
+19 SET RC=$$PROCPAT^RORUPD01(PATIEN,$GET(CHKONLY))
+20 if RC<0
QUIT $$ERROR^RORERR(-15,,,PATIEN)
+21 ;--- Update patient demographic data
+22 IF '$GET(CHKONLY)
Begin DoDot:1
+23 SET RC=$$UPDPTDEM^RORUPD51(PATIEN)
End DoDot:1
if RC<0
QUIT $$ERROR^RORERR(-16,,,PATIEN)
+24 ;--- Load the list of triggered rules
+25 SET REGIEN=""
+26 FOR
SET REGIEN=$ORDER(@RORUPDPI@("U",PATIEN,2,REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+27 MERGE UPDBYRUL=@RORUPDPI@("U",PATIEN,2,REGIEN)
End DoDot:1
+28 ;--- Cleanup
+29 if '$GET(RORPARM("DEBUG"))
DO INIT^RORUTL01("RORUPD")
+30 QUIT 0
