source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD09.m@ 1608

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1RORUPD09 ;HCIOFO/SG - PROCESSING OF THE 'PTF' FILE ; 8/3/05 9:50am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #3157 RPC^DGPTFAPI
7 ; #3545 Access to the "AAD" cross-reference and the field 80
8 ;
9 Q
10 ;
11 ;***** LOADS DATA ELEMENT VALUES
12 ;
13 ; IENS IENS of the current record
14 ;
15 ; Return values:
16 ; <0 Error code
17 ; 0 Ok
18 ;
19LOAD(IENS) ;
20 N RC S RC=0
21 ;--- API #1
22 I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
23 . S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
24 ;--- API #2
25 I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
26 . N API,DE,IN,IP,RORBUF,VT
27 . D RPC^DGPTFAPI(.RORBUF,+IENS)
28 . I $G(RORBUF(0))<0 S API="RPC^DGPTFAPI" D Q
29 . . S RC=$$ERROR^RORERR(-57,,,,RORBUF(0),API)
30 . ;---
31 . S DE=""
32 . F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
33 . . S VT=""
34 . . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
35 . . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,1) Q:IP'>0
36 . . . S IN=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
37 . . . S RORVALS("DV",RORFILE,DE,VT)=$P($G(RORBUF(IN)),U,IP)
38 Q 0
39 ;
40 ;***** PROCESSING OF THE 'PTF' FILE
41 ;
42 ; UPDSTART Date of the earliest update
43 ; PATIEN Patient IEN
44 ;
45 ; Return values:
46 ; <0 Error code
47 ; 0 Continue processing of the current patient
48 ; 1 Stop processing
49 ;
50PTF(UPDSTART,PATIEN) ;
51 N RORFILE ; File number
52 ;
53 N ADMDT,ADMIENS,EDT,IEN,LOCATION,NODE,RC,TMP
54 S RORFILE=45,EDT=RORUPD("DSEND")
55 ;--- Check the event references if the events are enabled
56 I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
57 . S RC=$$GET^RORUPP02(PATIEN,3,.UPDSTART,.EDT)
58 . S:RC>1 UPDSTART=UPDSTART\1,EDT=$$FMADD^XLFDT(EDT\1,1)
59 ;--- Subtract 1 second from the start date to include
60 ; it into the interval
61 S ADMDT=$$FMADD^XLFDT(UPDSTART,,,,-1)
62 ;
63 ;--- Browse through the admissions
64 S NODE=RORUPD("ROOT",RORFILE),NODE=$NA(@NODE@("AAD",PATIEN))
65 S RC=0
66 F S ADMDT=$O(@NODE@(ADMDT)) Q:(ADMDT="")!(ADMDT'<EDT) D Q:RC
67 . S IEN=""
68 . F S IEN=$O(@NODE@(ADMDT,IEN)) Q:IEN="" D Q:RC
69 . . S ADMIENS=IEN_","
70 . . ;--- Load necessary data elements
71 . . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
72 . . . S TMP=$$LOAD(ADMIENS)
73 . . . S TMP=$$GETDE^RORUPDUT(45,131)_$$GETDE^RORUPDUT(45,132)
74 . . . S LOCATION=$S(TMP'="":$$IEN^XUAF4(TMP),1:"")
75 . . ;--- Apply "before" rules
76 . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"B",ADMDT,$G(LOCATION))
77 . . I RC D INCEC^RORUPDUT(.RC) Q
78 . . ;--- Apply "after" rules
79 . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"A",ADMDT,$G(LOCATION))
80 . . I RC D INCEC^RORUPDUT(.RC) Q
81 ;
82 D CLRDES^RORUPDUT(RORFILE)
83 Q RC
84 ;
85 ;***** IMPLEMENTATION OF THE 'VA HEPC PTF' RULE
86PTFRULE(ICD) ;
87 N DATELMT,RC
88 S RC=0
89 F DATELMT=111,101,102,103,104,105,106,107,108,109,110 D Q:RC
90 . S RC=ICD[(","_$G(RORVALS("DV",45,DATELMT,"E"))_",")
91 Q RC
Note: See TracBrowser for help on using the repository browser.