source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD06.m@ 1683

Last change on this file since 1683 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1RORUPD06 ;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 ;
17ADDPAT(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 ;
82UPDPAT(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
Note: See TracBrowser for help on using the repository browser.