source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD08.m@ 811

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1RORUPD08 ;HCIOFO/SG - PROCESSING OF 'VISIT' & 'V POV' FILES ; 10/27/05 11:08am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1554 POV^PXAPIIB
7 ; #1905 SELECTED^VSIT
8 ; #1906 LOOKUP^VSIT
9 ; #3990 $$CODEC^ICDCODE (supported)
10 ;
11 Q
12 ;
13 ;***** LOADS 'V POV' DATA ELEMENTS
14 ;
15 ; IENS IENS of the current record
16 ;
17 ; Return values:
18 ; <0 Error code
19 ; 0 Ok
20 ;
21LOADVPOV(IENS) ;
22 N RC S RC=0
23 ;--- API #1
24 I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
25 . S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
26 ;--- API #2
27 I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
28 . N BUF,DE,IP,RORMSG,TMP,VT
29 . S BUF=$G(RORVPLST(+IENS)),DE=""
30 . F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
31 . . S VT=""
32 . . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
33 . . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U)
34 . . . S:IP>0 RORVALS("DV",RORFILE,DE,VT)=$P(BUF,U,IP)
35 . ;--- External value of the POV field (.01)
36 . I $D(RORUPD("SR",RORFILE,"F",2,112,"E")) D Q:RC<0
37 . . S TMP=+$P(BUF,U) Q:TMP'>0
38 . . S TMP=$$CODEC^ICDCODE(TMP)
39 . . S RORVALS("DV",RORFILE,112,"E")=$S(TMP'<0:TMP,1:"")
40 Q 0
41 ;
42 ;***** LOAD 'VISIT' DATA ELEMENTS
43 ;
44 ; IENS IENS of the current record
45 ;
46 ; Return values:
47 ; <0 Error code
48 ; 0 Ok
49 ;
50LOADVSIT(IENS) ;
51 N RC S RC=0
52 ;--- API #1
53 I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
54 . S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
55 ;--- API #2
56 I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
57 . N API,DE,IN,IP,TMP,VSIT,VT
58 . S TMP=$$LOOKUP^VSIT(+IENS,"B",0)
59 . I TMP<0 S API="$$LOOKUP^VSIT" D Q
60 . . S RC=$$ERROR^RORERR(-57,,,,TMP,API)
61 . ;---
62 . S DE=""
63 . F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
64 . . S VT=""
65 . . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
66 . . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U) Q:IP'>0
67 . . . S IN=$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
68 . . . S RORVALS("DV",RORFILE,DE,VT)=$P($G(VSIT(IN)),U,IP)
69 . ;---
70 Q 0
71 ;
72 ;***** PROCESSING OF THE 'VISIT' FILE
73 ;
74 ; UPDSTART Date of the earliest update
75 ; PATIEN Patient IEN
76 ;
77 ; Return values:
78 ; <0 Error code
79 ; 0 Continue processing of the current patient
80 ; 1 Stop processing
81 ;
82 ; The function uses the ^TMP("VSIT",$J) global node.
83 ;
84VISIT(UPDSTART,PATIEN) ;
85 N RORFILE ; File number
86 ;
87 N DATE,DSEND,IEN,LOCATION,RC,TMP,VISIENS
88 S RORFILE=9000010,DSEND=RORUPD("DSEND")
89 ;--- Check the event references if the events are enabled
90 I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
91 . S RC=$$GET^RORUPP02(PATIEN,2,.UPDSTART,.DSEND)
92 . S:RC>1 UPDSTART=UPDSTART\1,DSEND=$$FMADD^XLFDT(DSEND\1,1)
93 ;--- Get a list of visits
94 D SELECTED^VSIT(PATIEN,UPDSTART,DSEND)
95 ;
96 ;--- Browse through the visits
97 S (IEN,RC)=0
98 F S IEN=$O(^TMP("VSIT",$J,IEN)) Q:IEN="" D Q:RC
99 . S VISIENS=IEN_",",TMP=+$O(^TMP("VSIT",$J,IEN,""))
100 . S DATE=$P($G(^TMP("VSIT",$J,IEN,TMP)),U)
101 . ;--- Load necessary data elements
102 . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
103 . . S TMP=$$LOADVSIT(VISIENS) Q:TMP<0
104 . . S LOCATION=$$GETDE^RORUPDUT(RORFILE,129)
105 . ;--- Apply "before" rules
106 . S RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"B",DATE,$G(LOCATION))
107 . I RC D INCEC^RORUPDUT(.RC) Q
108 . ;
109 . ;--- Process V POV file
110 . I $D(RORUPD("SR",9000010.07)) D I RC D INCEC^RORUPDUT(.RC) Q
111 . . S RC=$$VPOV(IEN,DATE,$G(LOCATION))
112 . ;
113 . ;--- Apply "after" rules
114 . S RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"A",DATE,$G(LOCATION))
115 . I RC D INCEC^RORUPDUT(.RC) Q
116 ;
117 K ^TMP("VSIT",$J)
118 D CLRDES^RORUPDUT(RORFILE)
119 Q RC
120 ;
121 ;***** PROCESSING OF THE 'V POV' FILE
122 ;
123 ; VISITIEN IEN of the visit (in the "VISIT" file)
124 ; DATE Visit date
125 ; LOCATION Institution IEN
126 ;
127 ; Return values:
128 ; <0 Error code
129 ; 0 Continue processing of the current patient
130 ; 1 Stop processing
131 ;
132VPOV(VISITIEN,DATE,LOCATION) ;
133 N RORFILE ; File number
134 N RORVPLST ; List of records in the file
135 ;
136 N IEN,NODE,RC,TMP,VPIENS
137 S RORFILE=9000010.07
138 D CLRVALS^RORUPDUT(RORFILE)
139 ;--- Get a list of records
140 D POV^PXAPIIB(VISITIEN,.RORVPLST)
141 ;
142 S (IEN,RC)=0
143 F S IEN=$O(RORVPLST(IEN)) Q:IEN="" D Q:RC
144 . S VPIENS=IEN_","
145 . ;--- Load necessary data elements
146 . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
147 . . S TMP=$$LOADVPOV(VPIENS)
148 . ;--- Apply "before" rules
149 . S RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"B",DATE,LOCATION)
150 . I RC D INCEC^RORUPDUT(.RC) Q
151 . ;--- Apply "after" rules
152 . S RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"A",DATE,LOCATION)
153 . I RC D INCEC^RORUPDUT(.RC) Q
154 ;
155 D CLRDES^RORUPDUT(RORFILE)
156 Q RC
Note: See TracBrowser for help on using the repository browser.