source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD50.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1RORUPD50 ;HCIOFO/SG - UPDATE THE PATIENT IN THE REGISTRIES ; 8/2/05 9:14am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** ADDS THE PATIENT TO THE REGISTRY
7 ;
8 ; PATIEN Patient IEN
9 ; REGIEN Registry IEN
10 ;
11 ; [ROR8RULS] Closed root of a local array containing list of
12 ; triggered selection rules:
13 ; @ROR8RULS@(RuleIEN)=Date
14 ; If this parameter is not defined or equals to
15 ; an empty string, selection rules are loaded from
16 ; corresponding sub-node of the ^TMP("RORUPD",$J,"U").
17 ;
18 ; [[.]DOD] Date of death. If this parameter is undefined,
19 ; its value will be taken from the ROR PATIENT file.
20 ; If you are going to call this function several times
21 ; for the same patient (for different registries),
22 ; pass a reference to undefined local variable (the
23 ; DOD will be read from the file only once).
24 ;
25 ; Return values:
26 ; <0 Error code
27 ; 0 Ok
28 ; 1 Patient has already existed in the registry
29 ;
30ADD(PATIEN,REGIEN,ROR8RULS,DOD) ;
31 N I,IENS,IENS01,RC,RORFDA,RORIEN,RORMSG,RULEIEN,TMP
32 ;--- Quit if the patient is already in the registry
33 Q:$$PRRIEN^RORUTL01(PATIEN,REGIEN)>0 1
34 ;
35 ;--- Prepare registry data
36 K RORFDA S IENS="+1,"
37 S RORFDA(798,IENS,.01)=PATIEN ; Patient Name
38 S RORFDA(798,IENS,.02)=REGIEN ; Registry
39 S RORFDA(798,IENS,3)=4 ; Pending
40 S RORFDA(798,IENS,4)=1 ; Update Demographics
41 S RORFDA(798,IENS,5)=1 ; Update Local Data
42 S RORFDA(798,IENS,11)=1 ; Don't Send
43 ;--- Get the date of death
44 S:'($D(DOD)#10) DOD=$$GET1^DIQ(798.4,PATIEN_",",.351,"I",,"RORMSG")
45 ;--- Load list of triggered rules
46 S:$G(ROR8RULS)="" ROR8RULS=$NA(@RORUPDPI@("U",PATIEN,2,REGIEN))
47 S RULEIEN=""
48 F I=1:1 S RULEIEN=$O(@ROR8RULS@(RULEIEN)) Q:RULEIEN="" D
49 . S IENS01="+"_(1000+I)_","_IENS
50 . S RORFDA(798.01,IENS01,.01)=RULEIEN ; SELECTION RULE
51 . S TMP=$P(@ROR8RULS@(RULEIEN),U)\1
52 . S:TMP>0 RORFDA(798.01,IENS01,1)=TMP ; DATE
53 . S TMP=+$P(@ROR8RULS@(RULEIEN),U,2)
54 . S:TMP>0 RORFDA(798.01,IENS01,2)=TMP ; LOCATION
55 ;
56 ;--- Registry update transaction
57 S RC=0 D
58 . ;--- Call "before update" entry point
59 . S ENTRY=$G(RORUPD("UPD",REGIEN,1))
60 . I ENTRY'="" X "S RC="_ENTRY_"(.RORFDA,PATIEN,REGIEN)" Q:RC<0
61 . ;--- Make sure that the DON'T SEND flag is set for 'test' patient
62 . S:$$TESTPAT^RORUTL01(PATIEN) RORFDA(798,IENS,11)=1
63 . ;--- Update the registry
64 . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
65 . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9) Q
66 . ;--- Call "after update" entry point
67 . S ENTRY=$G(RORUPD("UPD",REGIEN,2))
68 . I ENTRY'="" X "S RC="_ENTRY_"(RORIEN(1),PATIEN,REGIEN)" Q:RC<0
69 Q:RC'<0 0
70 ;
71 ;--- Rollback the update in case of error(s)
72 N DA,DIK
73 S DIK=$$ROOT^DILFD(798),DA=$G(RORIEN(1))
74 D:DA>0 ^DIK
75 Q RC
76 ;
77 ;***** ADDS PATIENT DATA TO THE 'ROR PATIENT' FILE
78 ;
79 ; PATIEN Patient IEN
80 ;
81 ; Return values:
82 ; <0 Error code
83 ; 0 Ok
84 ; 1 Patient data have already existed
85 ;
86ADDPDATA(PATIEN) ;
87 N IENS,RC,RORBUF,RORPAT,RORIEN,RORMSG
88 ;--- Try to find patient data
89 D FIND^DIC(798.4,,"@","QUX",PATIEN,1,"B",,,"RORBUF","RORMSG")
90 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.4)
91 ;--- Patient data already exists in the file
92 Q:$G(RORBUF("DILIST",0)) 1
93 ;--- Check if the patient record in the file #2 is valid
94 S RC=$$CHKPTR^RORUTL05(PATIEN) Q:RC<0 RC
95 ;--- Prepare patient data
96 S IENS="+1,"
97 S RC=$$PATDATA^RORUPD52(PATIEN_",",.RORPAT,IENS) Q:RC<0 RC
98 S RORIEN(1)=PATIEN ; IEN of the new record
99 S RORPAT(798.4,IENS,.01)=PATIEN ; Patient Name
100 ;--- Add the patient record to the file
101 D UPDATE^DIE(,"RORPAT","RORIEN","RORMSG")
102 I $G(DIERR) D Q:RC
103 . S RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798.4)
104 Q 0
105 ;
106 ;***** ADDS THE PATIENT TO MARKED REGISTRIES
107 ;
108 ; PATIEN Patient IEN
109 ;
110 ; Return values:
111 ; <0 Error code
112 ; 0 Patient should not be added to the registry
113 ; >0 Patient has been added to the registry
114 ;
115UPDREG(PATIEN) ;
116 N DOD,ENTRY,INCTVDT,RC,REGIEN
117 ;--- Check if patient should be added to any registry
118 Q:$D(@RORUPDPI@("U",PATIEN,2))<10 0
119 ;--- Add patient data
120 S RC=$$ADDPDATA(PATIEN) Q:RC<0 RC
121 ;--- Update all marked registries
122 S REGIEN="",RC=0
123 F D Q:REGIEN="" S RC=$$ADD(PATIEN,REGIEN,,.DOD) Q:RC<0
124 . S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN))
125 Q $S(RC<0:RC,1:1)
Note: See TracBrowser for help on using the repository browser.