| [613] | 1 | RORUPD06 ;HCIOFO/SG - REGISTRY UPDATE (MISCELLANEOUS) ; 11/25/03 3:49pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** ADDS THE PATIENT TO THE REGISTRY (UNCONDITIONALLY)
|
|---|
| 7 | ;
|
|---|
| 8 | ; PATIEN Patient IEN
|
|---|
| 9 | ; REGNAME Registry name
|
|---|
| 10 | ; .RULES Reference to a local array containing list of
|
|---|
| 11 | ; triggered selection rules: RULES(n)=RuleIEN^Date
|
|---|
| 12 | ;
|
|---|
| 13 | ; Return Values:
|
|---|
| 14 | ; <0 Error code (see MSGLIST^RORERR20)
|
|---|
| 15 | ; 0 Ok
|
|---|
| 16 | ;
|
|---|
| 17 | ADDPAT(PATIEN,REGNAME,RULES) ;
|
|---|
| 18 | N RORERRDL ; Default error location
|
|---|
| 19 | N RORUPD ; Update descriptor
|
|---|
| 20 | N RORUPDPI ; Closed root of the temporary storage
|
|---|
| 21 | ;
|
|---|
| 22 | N I,RC,REGIEN,REGLST,RORLRC,RORSRLST,RULEIEN,VSRLST
|
|---|
| 23 | D INIT^RORUTL01("RORUPD")
|
|---|
| 24 | D CLEAR^RORERR("ADDPAT^RORUPD06")
|
|---|
| 25 | S RORUPDPI=$NA(^TMP("RORUPD",$J))
|
|---|
| 26 | ;--- Check the registry name
|
|---|
| 27 | Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
|
|---|
| 28 | S REGIEN=$$REGIEN^RORUTL02(REGNAME) Q:REGIEN<0 REGIEN
|
|---|
| 29 | S REGLST(REGNAME)=REGIEN
|
|---|
| 30 | ;--- Compile a list of IENs of valid selection rules
|
|---|
| 31 | S I=""
|
|---|
| 32 | F S I=$O(^ROR(798.1,REGIEN,1,"B",I)) Q:I="" D
|
|---|
| 33 | . S RULEIEN=$$SRLIEN^RORUTL02(I) S:RULEIEN>0 VSRLST(RULEIEN)=""
|
|---|
| 34 | ;--- Prepare list of triggered selection rules
|
|---|
| 35 | S I="",RC=0
|
|---|
| 36 | F S I=$O(RULES(I)) Q:I="" D Q:RC<0
|
|---|
| 37 | . S RULEIEN=$P(RULES(I),U)
|
|---|
| 38 | . I RULEIEN'>0 S RC=$$ERROR^RORERR(-45) Q
|
|---|
| 39 | . I '$D(VSRLST(RULEIEN)) S RC=$$ERROR^RORERR(-45) Q
|
|---|
| 40 | . S RORSRLST(RULEIEN)=$P(RULES(I),U,2)
|
|---|
| 41 | Q:RC<0 RC
|
|---|
| 42 | ;--- Prepare update descriptor
|
|---|
| 43 | S RC=$$PREPARE1^RORUPR(.REGLST)
|
|---|
| 44 | Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
|
|---|
| 45 | ;--- Add the patient to the registry
|
|---|
| 46 | S RC=$$ADDPDATA^RORUPD50(PATIEN) Q:RC<0 RC
|
|---|
| 47 | S RC=$$ADD^RORUPD50(PATIEN,REGIEN,"RORSRLST") Q:RC<0 RC
|
|---|
| 48 | ;--- Update patient demographic data
|
|---|
| 49 | S RC=$$UPDPTDEM^RORUPD51(PATIEN)
|
|---|
| 50 | Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
|
|---|
| 51 | ;--- Cleanup
|
|---|
| 52 | D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
|
|---|
| 53 | Q 0
|
|---|
| 54 | ;
|
|---|
| 55 | ;***** CHECKS/UPDATES THE SINGLE PATIENT IN THE REGISTRY
|
|---|
| 56 | ;
|
|---|
| 57 | ; PATIEN Patient IEN
|
|---|
| 58 | ; REGNAME Registry name
|
|---|
| 59 | ;
|
|---|
| 60 | ; .UPDBYRUL Reference to a local array for the list of rules that
|
|---|
| 61 | ; the patient is selected by (output). The list has
|
|---|
| 62 | ; the following structure: UPDBYRUL(Rule#)=Date, where
|
|---|
| 63 | ; "Rule#" is an IEN of the selection rule in the file
|
|---|
| 64 | ; #798.2 and "Date" is the date when the patient has
|
|---|
| 65 | ; passed the selection rule for the first time.
|
|---|
| 66 | ;
|
|---|
| 67 | ; [CHKONLY] If this optional parameter is undefined (default)
|
|---|
| 68 | ; or equals to zero then the function checks a patient
|
|---|
| 69 | ; against selection rules and adds him to the registry
|
|---|
| 70 | ; if he passes at least one of the rules.
|
|---|
| 71 | ; Otherwise, the patient is only checked against the
|
|---|
| 72 | ; rules but registry is not updated.
|
|---|
| 73 | ;
|
|---|
| 74 | ; Return Values:
|
|---|
| 75 | ; <0 Error code (see MSGLIST^RORERR20)
|
|---|
| 76 | ; 0 Ok
|
|---|
| 77 | ;
|
|---|
| 78 | ; If a local array passed as the UPDBYRUL parameter is undefined
|
|---|
| 79 | ; after return from the function then the patient has not pass any
|
|---|
| 80 | ; selection rule.
|
|---|
| 81 | ;
|
|---|
| 82 | UPDPAT(PATIEN,REGNAME,UPDBYRUL,CHKONLY) ;
|
|---|
| 83 | N RORERRDL ; Default error location
|
|---|
| 84 | N RORLRC ; List of Lab result codes to check
|
|---|
| 85 | N RORUPD ; Update descriptor
|
|---|
| 86 | N RORUPDPI ; Closed root of the temporary storage
|
|---|
| 87 | N RORVALS ; Calculated values
|
|---|
| 88 | ;
|
|---|
| 89 | N RC,REGIEN,REGLST
|
|---|
| 90 | D INIT^RORUTL01("RORUPD")
|
|---|
| 91 | D CLEAR^RORERR("UPDPAT^RORUPD06")
|
|---|
| 92 | S RORUPDPI=$NA(^TMP("RORUPD",$J))
|
|---|
| 93 | ;--- Check the registry name
|
|---|
| 94 | Q:REGNAME?." " $$ERROR^RORERR(-10,,,PATIEN,REGNAME)
|
|---|
| 95 | S REGLST(REGNAME)="" K UPDBYRUL
|
|---|
| 96 | ;--- Prepare selection rules
|
|---|
| 97 | S RC=$$PREPARE^RORUPR(.REGLST)
|
|---|
| 98 | Q:RC<0 $$ERROR^RORERR(-14,,,PATIEN)
|
|---|
| 99 | D:$G(RORPARM("DEBUG"))>1 DEBUG^RORUPDUT
|
|---|
| 100 | ;--- Check the patient and update the registry
|
|---|
| 101 | S RC=$$PROCPAT^RORUPD01(PATIEN,$G(CHKONLY))
|
|---|
| 102 | Q:RC<0 $$ERROR^RORERR(-15,,,PATIEN)
|
|---|
| 103 | ;--- Update patient demographic data
|
|---|
| 104 | I '$G(CHKONLY) D Q:RC<0 $$ERROR^RORERR(-16,,,PATIEN)
|
|---|
| 105 | . S RC=$$UPDPTDEM^RORUPD51(PATIEN)
|
|---|
| 106 | ;--- Load the list of triggered rules
|
|---|
| 107 | S REGIEN=""
|
|---|
| 108 | F S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN)) Q:REGIEN="" D
|
|---|
| 109 | . M UPDBYRUL=@RORUPDPI@("U",PATIEN,2,REGIEN)
|
|---|
| 110 | ;--- Cleanup
|
|---|
| 111 | D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("RORUPD")
|
|---|
| 112 | Q 0
|
|---|
