source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORSETU2.m@ 1087

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1RORSETU2 ;HCIOFO/SG - SETUP UTILITIES (REGISTRY) ; 1/23/06 10:35am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** DRAWS THE BOUNDARY BETWEEN HISTORICAL AND REGULAR EXTRACTIONS
7 ;
8 ; REGIEN Registry IEN
9 ; .BNDRYDT Date that represents a boundary between historical
10 ; data extraction and regular data extracts is returned
11 ; via this parameter.
12 ;
13 ; Return Values:
14 ; <0 Error code
15 ; >=0 Statistics
16 ; ^1: Total number of processed records
17 ; ^2: Number of records processed with errors
18 ;
19 ; The function calculates a date that will be a boundary between
20 ; historical data extraction and regular data extractions. This date
21 ; is stored to all records of the registry. Moreover, the date is
22 ; returned as a value of the second parameter.
23 ;
24BNDRYDT(REGIEN,BNDRYDT) ;
25 N CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORFDA,RORMSG,TMP
26 S ROOT=$$ROOT^DILFD(798,,1)
27 ;--- Get the lag period
28 S LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
29 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
30 ;--- Calculate the date
31 S BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$S(LD1>0:LD1,1:1)-1)
32 ;--- Store the date into the records of the registry
33 S IEN="",(CNT,ECNT)=0
34 F S IEN=$O(@ROOT@("AC",REGIEN,IEN)) Q:IEN="" D
35 . S CNT=CNT+1,IENS=IEN_",",DATE=BNDRYDT
36 . ;--- Update the record
37 . S RORFDA(798,IENS,9.1)=DATE
38 . S RORFDA(798,IENS,9.2)=DATE
39 . D FILE^DIE(,"RORFDA","RORMSG")
40 . I $G(DIERR) D S ECNT=ECNT+1 Q
41 . . S RC=$$DBS^RORERR("RORMSG",-9)
42 Q $S(RC<0:RC,1:CNT_U_ECNT)
43 ;
44 ;***** CHECKS THE LAB SEARCH CRITERION
45 ;
46 ; LSNAME Name of the Lab search criterion
47 ;
48 ; This function uses the ^TMP("DILIST",$J) global node.
49 ;
50 ; Return Values:
51 ; <0 Error code
52 ; 0 Ok
53 ;
54LABSRCH(LSNAME) ;
55 N IEN,IENS,IR,LSICNT,RC,RORMSG,TMP
56 ;--- Find the definition
57 S IENS=$$FIND1^DIC(798.9,,"X",LSNAME,"B",,"RORMSG")_","
58 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
59 Q:IENS'>0 $$ERROR^RORERR(-54,,,,LSNAME)
60 ;--- Load the search indicators
61 D LIST^DIC(798.92,","_IENS,"@;1I",,,,,"B",,,,"RORMSG")
62 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
63 ;--- Check the search indicators
64 S IR="",LSICNT=0
65 F S IR=$O(^TMP("DILIST",$J,"ID",IR)) Q:IR="" D
66 . S:$G(^TMP("DILIST",$J,"ID",IR,1))>0 LSICNT=LSICNT+1
67 ;--- Process the errors (if any)
68 Q:LSICNT'>0 $$ERROR^RORERR(-55,,,,LSNAME)
69 Q 0
70 ;
71 ;***** PREPARES REGISTRY RECORDS
72 ;
73 ; RORREG Registry IEN and registry name separated by the '^'
74 ; (RegistryIEN^RegistryName).
75 ;
76 ; Return Values:
77 ; <0 Error code
78 ; 0 Ok
79 ;
80PREPARE(RORREG) ;
81 ;;Data extraction boundary (historical/regular) has been established.
82 ;;Parameters of the historical data extraction have been updated.
83 ;
84 N DATE,RC,TMP
85 ;--- Modify records of the registry
86 S RC=$$BNDRYDT(+RORREG,.DATE) Q:RC<0 RC
87 S TMP="Processed records: "_+RC_", Errors: "_+$P(RC,U,2)
88 D LOG^RORLOG(2,$P($T(PREPARE+1),";;",2),,TMP)
89 ;--- Update the registry parameters of historical data extraction
90 S RC=$$UPDHDTRP(+RORREG,DATE) Q:RC<0 RC
91 D LOG^RORLOG(2,$P($T(PREPARE+2),";;",2))
92 Q 0
93 ;
94 ;***** UPDATES REGISTRY PARAMETERS OF THE HISTORICAL DATA EXTRACTION
95 ;
96 ; REGIEN Registry IEN
97 ; HDTEDT Date that represents a boundary between historical
98 ; data extraction and regular data extracts
99 ;
100 ; Return Values:
101 ; <0 Error code
102 ; 0 Ok
103 ;
104UPDHDTRP(REGIEN,HDTEDT) ;
105 N IENS,RC,RORFDA,RORMSG
106 S IENS=REGIEN_","
107 ;--- Prepare the data
108 S RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT ; Timestamp
109 ;--- Update historical data extraction parameters
110 D FILE^DIE(,"RORFDA","RORMSG")
111 S RC=$$DBS^RORERR("RORMSG",-9)
112 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.