source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPP01.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.1 KB
Line 
1RORUPP01 ;HCIOFO/SG - PATIENT EVENTS (ERRORS) ; 1/20/06 1:55pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; RORUPD("LM2", Static list of registries must be defined
5 ; Registry#) if you are going to use these functions.
6 ;
7 ; RORUPD("MAXPPCNT") This node should have a positive value if
8 ; you are going to use these functions.
9 ; Otherwise, 14 will be used by default.
10 ;
11 ; See source code of the ^RORUPD routine for detailed description
12 ; of these nodes.
13 ;
14 Q
15 ;
16 ;***** ADDS THE REFERENCES TO THE LIST
17 ;
18 ; PATIEN Patient IEN
19 ; DATE Date to start next registry update
20 ;
21 ; Return Values:
22 ; <0 Error code
23 ; 0 Ok
24 ;
25ADD(PATIEN,DATE) ;
26 N I,IENS,MAXCNT,RC,REGIEN,RORBUF,RORFDA,RORIEN,RORMSG,TMP,URLST
27 S MAXCNT=$$MAXCNT()
28 I $D(^RORDATA(798.3,PATIEN,1,"B"))>1 S RC=0 D Q:RC<0 RC
29 . ;--- Get a list of existing patient error records
30 . S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
31 . D LIST^DIC(798.31,IENS,"@;.01I;1I;2",,,,,"B",I,,"RORBUF","RORMSG")
32 . I $G(DIERR) D Q
33 . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
34 . Q:'$G(RORBUF("DILIST",0))
35 . ;--- Prepare FDA for records to update
36 . S I=""
37 . F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
38 . . S REGIEN=+$G(RORBUF("DILIST","ID",I,.01))
39 . . S URLST(REGIEN)=""
40 . . Q:$G(RORBUF("DILIST","ID",I,2))'<MAXCNT
41 . . S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
42 . . S TMP=$G(RORBUF("DILIST","ID",I,1))
43 . . S RORFDA(798.31,IENS,1)=$S(TMP&(TMP<DATE):TMP,1:DATE)
44 . . S RORFDA(798.31,IENS,2)=$G(RORBUF("DILIST","ID",I,2))+1
45 . Q:$D(RORFDA)<10
46 . ;--- Update the records
47 . D FILE^DIE("K","RORFDA","RORMSG")
48 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
49 ;--- Prepare FDA for records to create
50 S REGIEN="",I=1
51 F S REGIEN=$O(RORUPD("LM2",REGIEN)) Q:REGIEN="" D
52 . Q:$D(URLST(REGIEN))
53 . S I=I+1,IENS="+"_I_",?+1,"
54 . S RORFDA(798.31,IENS,.01)=REGIEN
55 . S RORFDA(798.31,IENS,1)=DATE
56 . S RORFDA(798.31,IENS,2)=1
57 ;--- Create the records
58 I $D(RORFDA)>1 S RC=0 D Q:RC<0 RC
59 . S (RORFDA(798.3,"?+1,",.01),RORIEN(1))=PATIEN
60 . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
61 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
62 Q 0
63 ;
64 ;***** RETURNS THE THRESHOLD VALUE OF THE ERROR COUNTER
65MAXCNT() ;
66 Q $S($G(RORUPD("MAXPPCNT"))>0:+RORUPD("MAXPPCNT"),1:14)
67 ;
68 ;***** REMOVES THE REFERNCES FROM THE LIST
69 ;
70 ; PATIEN Patient IEN
71 ; [ROR8LST] Closed root of an array containg list of registry
72 ; IENs as subscripts. $NA(RORUPD("LM2")) is used
73 ; by default. Only records associated with these
74 ; registries will be removed.
75 ;
76 ; Return Values:
77 ; <0 Error code
78 ; 0 Ok
79 ;
80REMOVE(PATIEN,ROR8LST) ;
81 Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 0
82 N I,IENS,RC,RORBUF,RORFDA,RORMSG
83 S:$G(ROR8LST)="" ROR8LST=$NA(RORUPD("LM2"))
84 S IENS=","_PATIEN_",",I="I $D(@ROR8LST@(+$P(^(0),U)))"
85 D LIST^DIC(798.31,IENS,"@",,,,,"B",I,,"RORBUF","RORMSG")
86 I $G(DIERR) D Q RC
87 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
88 Q:'$G(RORBUF("DILIST",0)) 0
89 S I=""
90 F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
91 . S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
92 . S RORFDA(798.31,IENS,.01)="@"
93 D FILE^DIE("K","RORFDA","RORMSG")
94 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.31)
95 Q 0
96 ;
97 ;***** RETURNS START DATE FOR THE DATA SCAN (IF ANY)
98 ;
99 ; PATIEN Patient IEN
100 ;
101 ; Return Values:
102 ; <0 Error code
103 ; "" There is no date for the patient in the file
104 ; >0 Start date
105 ;
106SDSDATE(PATIEN) ;
107 Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 ""
108 N CNT,DATE,I,IENS,MAXCNT,RC,RORBUF,RORMSG,TMP
109 ;--- Load the pending references (in chronological order)
110 S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
111 D LIST^DIC(798.31,IENS,"@;1I;2",,,,,"AD",I,,"RORBUF","RORMSG")
112 I $G(DIERR) D Q RC
113 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
114 Q:'$G(RORBUF("DILIST",0)) ""
115 ;--- Get and return the earliest date
116 S MAXCNT=$$MAXCNT()
117 S (DATE,I)="",CNT=0
118 F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D Q:CNT&DATE
119 . S:$G(RORBUF("DILIST","ID",I,2))<MAXCNT CNT=CNT+1
120 . S:'DATE DATE=$G(RORBUF("DILIST","ID",I,1))
121 Q $S('CNT:$$ERROR^RORERR(-66,,,PATIEN),1:DATE)
Note: See TracBrowser for help on using the repository browser.