source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXT03.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1ROREXT03 ;HCIOFO/SG - REGISTRY DATA EXTRACTION (OVERFLOW) ; 11/29/05 4:13pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;*****REGISTRY STATE CSR SEGMENT
7CSR(REGIEN) ;
8 N CS,RC,RORINFO,RORSEG,RPTSTATS,TMP
9 D ECH^RORHL7(.CS)
10 ;
11 ;--- Get the registry information
12 S RC=$$REGINFO^RORUTL17(REGIEN,"RORINFO") Q:RC<0 RC
13 S TMP=$$STATS^RORTSK12(REGIEN,.RPTSTATS)
14 ;
15 ;--- Initialize the segment
16 S RORSEG(0)="CSR"
17 ;
18 ;--- CSR-1 - Name of the registry and version of the CCR
19 S TMP=+$P(ROREXT("VERSION"),U) ; Version
20 S:$P(TMP,".",2)="" $P(TMP,".",2)="0"
21 S $P(TMP,".",3)=+$P(ROREXT("VERSION"),U,2) ; Patch Number
22 S $P(TMP,".",4)=+$$BUILD^ROR ; Build Number
23 S RORSEG(1)=$$ESCAPE^RORHL7($P($$REGNAME^RORUTL01(REGIEN),U))_CS_TMP
24 ;
25 ;--- CSR-3 - Institution
26 S RORSEG(3)=$$SITE^RORUTL03(CS)
27 ;
28 ;--- CSR-4 - Patient ID
29 S TMP="0"_CS_CS_CS_CS_"U"
30 S $P(TMP,CS,6)=+$G(RORINFO("NPP")) ; Number of pending patients
31 S $P(TMP,CS,7)=+$P(RPTSTATS,U) ; Number of reports
32 S RORSEG(4)=TMP
33 ;
34 ;--- Store the segment
35 D ADDSEG^RORHL7(.RORSEG)
36 Q 0
37 ;
38 ;***** REGISTRY STATE PID SEGMENT
39PID() ;
40 N CS,RORSEG
41 D ECH^RORHL7(.CS)
42 ;
43 ;--- Initialize the segment
44 S RORSEG(0)="PID"
45 ;
46 ;--- PID-3 DFN and Station Number
47 S RORSEG(3)="0"_CS_CS_CS_CS_"U"
48 ;
49 ;--- PID-5 Patient Name
50 S RORSEG(5)="PSEUDO"_CS_"PATIENT"
51 ;
52 ;--- Store the segment
53 D ADDSEG^RORHL7(.RORSEG)
54 Q 0
55 ;
56 ;***** GENERATES THE REGISTRY STATE HL7 MESSAGE
57 ;
58 ; REGIEN Registry IEN
59 ;
60 ; Return Values:
61 ; <0 Error code
62 ; 0 Ok
63 ; >0 Number of ignored errors
64 ;
65REGSTATE(REGIEN) ;
66 N RC
67 ;--- Output pseudo-patient's segments
68 S RC=$$PID() Q:RC<0 RC
69 S RC=$$CSR(REGIEN) Q:RC<0 RC
70 ;---
71 Q 0
72 ;
73 ;***** SENDS THE CURRENT HL7 BATCH
74 ;
75 ; .RGIENLST Reference to a local array containing registry
76 ; IENs as subscripts and IENs of the corresponding
77 ; patient's registry records as values.
78 ;
79 ; Return Values:
80 ; <0 Error Code
81 ; 0 Ok
82 ;
83SEND(RGIENLST) ;
84 N IENS,MID,RC,REGIEN,RORFDA,RORMSG,TMP
85 W:$G(RORPARM("DEBUG"))>1 !,"HL7 Batch ID: ",$G(ROREXT("HL7MID"))
86 S RC=$$SEND^RORHL7(.MID) Q:RC<0 RC
87 I 'RC,$G(MID)'="" D
88 . S ROREXT("NBM")=$G(ROREXT("NBM"))+1
89 . S TMP="HL7 batch message "_MID_" has been generated"
90 . D LOG^RORLOG(2,TMP)
91 . ;--- Add message reference to the LAST BATCH CONTROL ID
92 . ;--- multiples of the registries that are being processed
93 . S (RC,REGIEN)=0
94 . F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
95 . . K RORFDA,RORMSG S IENS="+1,"_REGIEN_","
96 . . ;--- LAST BATCH CONTROL ID
97 . . S RORFDA(798.122,IENS,.01)=MID
98 . . ;--- INTERNAL BATCH ID
99 . . S RORFDA(798.122,IENS,.02)=$G(ROREXT("HL7MID"))
100 . . ;--- Batch Date/Time
101 . . S TMP=+$G(ROREXT("HL7DT"))
102 . . S RORFDA(798.122,IENS,.03)=$S(TMP>0:TMP,1:$$NOW^XLFDT)
103 . . ;--- Create the record
104 . . D UPDATE^DIE(,"RORFDA",,"RORMSG")
105 . . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.122,IENS)
106 Q 0
107 ;
108 ;***** UPDATES THE REGISTRY RECORDS AFTER THE DATA EXTRACTION
109 ;
110 ; PTIEN Patient IEN (DFN)
111 ;
112 ; .RGIENLST Reference to a local array containing registry
113 ; IENs as subscripts and IENs of the corresponding
114 ; patient's registry records as values.
115 ;
116 ; BATCHID
117 ;
118 ; Return Values:
119 ; <0 Error Code
120 ; 0 Ok
121 ;
122UPDRECS(PTIEN,RGIENLST,BATCHID,ENDT) ;
123 N FS,IEN,IENS,RC,REGIEN,RORFDA,RORMSG
124 S (RC,REGIEN)=0
125 F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
126 . K RORFDA,RORMSG
127 . S IEN=+RGIENLST(REGIEN) Q:IEN'>0
128 . S IENS=IEN_","
129 . ;--- Store the Message ID in the registry
130 . S:BATCHID'="" RORFDA(798,IENS,10)=BATCHID
131 . ;--- Otherwise, populate the MESSAGE ID field with a fake ID.
132 . ; This will force the message status checkup process to
133 . ; update the DATA ACKNOWLEDGED UNTIL field so that the next
134 . ; data extraction process will not browse through the data
135 . ;--- already processed by the previous one.
136 . S:BATCHID="" RORFDA(798,IENS,10)=ROREXT("HL7MID")_"-0"
137 . ;--- Always update the DATA EXTRACTED UNTIL field
138 . S RORFDA(798,IENS,9.2)=ENDT
139 . ;--- Update the registry record
140 . D FILE^DIE(,"RORFDA","RORMSG")
141 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
142 ;---
143 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.