ROREXT03 ;HCIOFO/SG - REGISTRY DATA EXTRACTION (OVERFLOW) ; 11/29/05 4:13pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;*****REGISTRY STATE CSR SEGMENT
CSR(REGIEN) ;
N CS,RC,RORINFO,RORSEG,RPTSTATS,TMP
D ECH^RORHL7(.CS)
;
;--- Get the registry information
S RC=$$REGINFO^RORUTL17(REGIEN,"RORINFO") Q:RC<0 RC
S TMP=$$STATS^RORTSK12(REGIEN,.RPTSTATS)
;
;--- Initialize the segment
S RORSEG(0)="CSR"
;
;--- CSR-1 - Name of the registry and version of the CCR
S TMP=+$P(ROREXT("VERSION"),U) ; Version
S:$P(TMP,".",2)="" $P(TMP,".",2)="0"
S $P(TMP,".",3)=+$P(ROREXT("VERSION"),U,2) ; Patch Number
S $P(TMP,".",4)=+$$BUILD^ROR ; Build Number
S RORSEG(1)=$$ESCAPE^RORHL7($P($$REGNAME^RORUTL01(REGIEN),U))_CS_TMP
;
;--- CSR-3 - Institution
S RORSEG(3)=$$SITE^RORUTL03(CS)
;
;--- CSR-4 - Patient ID
S TMP="0"_CS_CS_CS_CS_"U"
S $P(TMP,CS,6)=+$G(RORINFO("NPP")) ; Number of pending patients
S $P(TMP,CS,7)=+$P(RPTSTATS,U) ; Number of reports
S RORSEG(4)=TMP
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q 0
;
;***** REGISTRY STATE PID SEGMENT
PID() ;
N CS,RORSEG
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="PID"
;
;--- PID-3 DFN and Station Number
S RORSEG(3)="0"_CS_CS_CS_CS_"U"
;
;--- PID-5 Patient Name
S RORSEG(5)="PSEUDO"_CS_"PATIENT"
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q 0
;
;***** GENERATES THE REGISTRY STATE HL7 MESSAGE
;
; REGIEN Registry IEN
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of ignored errors
;
REGSTATE(REGIEN) ;
N RC
;--- Output pseudo-patient's segments
S RC=$$PID() Q:RC<0 RC
S RC=$$CSR(REGIEN) Q:RC<0 RC
;---
Q 0
;
;***** SENDS THE CURRENT HL7 BATCH
;
; .RGIENLST Reference to a local array containing registry
; IENs as subscripts and IENs of the corresponding
; patient's registry records as values.
;
; Return Values:
; <0 Error Code
; 0 Ok
;
SEND(RGIENLST) ;
N IENS,MID,RC,REGIEN,RORFDA,RORMSG,TMP
W:$G(RORPARM("DEBUG"))>1 !,"HL7 Batch ID: ",$G(ROREXT("HL7MID"))
S RC=$$SEND^RORHL7(.MID) Q:RC<0 RC
I 'RC,$G(MID)'="" D
. S ROREXT("NBM")=$G(ROREXT("NBM"))+1
. S TMP="HL7 batch message "_MID_" has been generated"
. D LOG^RORLOG(2,TMP)
. ;--- Add message reference to the LAST BATCH CONTROL ID
. ;--- multiples of the registries that are being processed
. S (RC,REGIEN)=0
. F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
. . K RORFDA,RORMSG S IENS="+1,"_REGIEN_","
. . ;--- LAST BATCH CONTROL ID
. . S RORFDA(798.122,IENS,.01)=MID
. . ;--- INTERNAL BATCH ID
. . S RORFDA(798.122,IENS,.02)=$G(ROREXT("HL7MID"))
. . ;--- Batch Date/Time
. . S TMP=+$G(ROREXT("HL7DT"))
. . S RORFDA(798.122,IENS,.03)=$S(TMP>0:TMP,1:$$NOW^XLFDT)
. . ;--- Create the record
. . D UPDATE^DIE(,"RORFDA",,"RORMSG")
. . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.122,IENS)
Q 0
;
;***** UPDATES THE REGISTRY RECORDS AFTER THE DATA EXTRACTION
;
; PTIEN Patient IEN (DFN)
;
; .RGIENLST Reference to a local array containing registry
; IENs as subscripts and IENs of the corresponding
; patient's registry records as values.
;
; BATCHID
;
; Return Values:
; <0 Error Code
; 0 Ok
;
UPDRECS(PTIEN,RGIENLST,BATCHID,ENDT) ;
N FS,IEN,IENS,RC,REGIEN,RORFDA,RORMSG
S (RC,REGIEN)=0
F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
. K RORFDA,RORMSG
. S IEN=+RGIENLST(REGIEN) Q:IEN'>0
. S IENS=IEN_","
. ;--- Store the Message ID in the registry
. S:BATCHID'="" RORFDA(798,IENS,10)=BATCHID
. ;--- Otherwise, populate the MESSAGE ID field with a fake ID.
. ; This will force the message status checkup process to
. ; update the DATA ACKNOWLEDGED UNTIL field so that the next
. ; data extraction process will not browse through the data
. ;--- already processed by the previous one.
. S:BATCHID="" RORFDA(798,IENS,10)=ROREXT("HL7MID")_"-0"
. ;--- Always update the DATA EXTRACTED UNTIL field
. S RORFDA(798,IENS,9.2)=ENDT
. ;--- Update the registry record
. D FILE^DIE(,"RORFDA","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
;---
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROREXT03 4404 printed Apr 09, 2024@20:47:25 Page 2
ROREXT03 ;HCIOFO/SG - REGISTRY DATA EXTRACTION (OVERFLOW) ; 11/29/05 4:13pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;*****REGISTRY STATE CSR SEGMENT
CSR(REGIEN) ;
+1 NEW CS,RC,RORINFO,RORSEG,RPTSTATS,TMP
+2 DO ECH^RORHL7(.CS)
+3 ;
+4 ;--- Get the registry information
+5 SET RC=$$REGINFO^RORUTL17(REGIEN,"RORINFO")
if RC<0
QUIT RC
+6 SET TMP=$$STATS^RORTSK12(REGIEN,.RPTSTATS)
+7 ;
+8 ;--- Initialize the segment
+9 SET RORSEG(0)="CSR"
+10 ;
+11 ;--- CSR-1 - Name of the registry and version of the CCR
+12 ; Version
SET TMP=+$PIECE(ROREXT("VERSION"),U)
+13 if $PIECE(TMP,".",2)=""
SET $PIECE(TMP,".",2)="0"
+14 ; Patch Number
SET $PIECE(TMP,".",3)=+$PIECE(ROREXT("VERSION"),U,2)
+15 ; Build Number
SET $PIECE(TMP,".",4)=+$$BUILD^ROR
+16 SET RORSEG(1)=$$ESCAPE^RORHL7($PIECE($$REGNAME^RORUTL01(REGIEN),U))_CS_TMP
+17 ;
+18 ;--- CSR-3 - Institution
+19 SET RORSEG(3)=$$SITE^RORUTL03(CS)
+20 ;
+21 ;--- CSR-4 - Patient ID
+22 SET TMP="0"_CS_CS_CS_CS_"U"
+23 ; Number of pending patients
SET $PIECE(TMP,CS,6)=+$GET(RORINFO("NPP"))
+24 ; Number of reports
SET $PIECE(TMP,CS,7)=+$PIECE(RPTSTATS,U)
+25 SET RORSEG(4)=TMP
+26 ;
+27 ;--- Store the segment
+28 DO ADDSEG^RORHL7(.RORSEG)
+29 QUIT 0
+30 ;
+31 ;***** REGISTRY STATE PID SEGMENT
PID() ;
+1 NEW CS,RORSEG
+2 DO ECH^RORHL7(.CS)
+3 ;
+4 ;--- Initialize the segment
+5 SET RORSEG(0)="PID"
+6 ;
+7 ;--- PID-3 DFN and Station Number
+8 SET RORSEG(3)="0"_CS_CS_CS_CS_"U"
+9 ;
+10 ;--- PID-5 Patient Name
+11 SET RORSEG(5)="PSEUDO"_CS_"PATIENT"
+12 ;
+13 ;--- Store the segment
+14 DO ADDSEG^RORHL7(.RORSEG)
+15 QUIT 0
+16 ;
+17 ;***** GENERATES THE REGISTRY STATE HL7 MESSAGE
+18 ;
+19 ; REGIEN Registry IEN
+20 ;
+21 ; Return Values:
+22 ; <0 Error code
+23 ; 0 Ok
+24 ; >0 Number of ignored errors
+25 ;
REGSTATE(REGIEN) ;
+1 NEW RC
+2 ;--- Output pseudo-patient's segments
+3 SET RC=$$PID()
if RC<0
QUIT RC
+4 SET RC=$$CSR(REGIEN)
if RC<0
QUIT RC
+5 ;---
+6 QUIT 0
+7 ;
+8 ;***** SENDS THE CURRENT HL7 BATCH
+9 ;
+10 ; .RGIENLST Reference to a local array containing registry
+11 ; IENs as subscripts and IENs of the corresponding
+12 ; patient's registry records as values.
+13 ;
+14 ; Return Values:
+15 ; <0 Error Code
+16 ; 0 Ok
+17 ;
SEND(RGIENLST) ;
+1 NEW IENS,MID,RC,REGIEN,RORFDA,RORMSG,TMP
+2 if $GET(RORPARM("DEBUG"))>1
WRITE !,"HL7 Batch ID: ",$GET(ROREXT("HL7MID"))
+3 SET RC=$$SEND^RORHL7(.MID)
if RC<0
QUIT RC
+4 IF 'RC
IF $GET(MID)'=""
Begin DoDot:1
+5 SET ROREXT("NBM")=$GET(ROREXT("NBM"))+1
+6 SET TMP="HL7 batch message "_MID_" has been generated"
+7 DO LOG^RORLOG(2,TMP)
+8 ;--- Add message reference to the LAST BATCH CONTROL ID
+9 ;--- multiples of the registries that are being processed
+10 SET (RC,REGIEN)=0
+11 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:2
+12 KILL RORFDA,RORMSG
SET IENS="+1,"_REGIEN_","
+13 ;--- LAST BATCH CONTROL ID
+14 SET RORFDA(798.122,IENS,.01)=MID
+15 ;--- INTERNAL BATCH ID
+16 SET RORFDA(798.122,IENS,.02)=$GET(ROREXT("HL7MID"))
+17 ;--- Batch Date/Time
+18 SET TMP=+$GET(ROREXT("HL7DT"))
+19 SET RORFDA(798.122,IENS,.03)=$SELECT(TMP>0:TMP,1:$$NOW^XLFDT)
+20 ;--- Create the record
+21 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+22 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.122,IENS)
End DoDot:2
if RC<0
QUIT
End DoDot:1
+23 QUIT 0
+24 ;
+25 ;***** UPDATES THE REGISTRY RECORDS AFTER THE DATA EXTRACTION
+26 ;
+27 ; PTIEN Patient IEN (DFN)
+28 ;
+29 ; .RGIENLST Reference to a local array containing registry
+30 ; IENs as subscripts and IENs of the corresponding
+31 ; patient's registry records as values.
+32 ;
+33 ; BATCHID
+34 ;
+35 ; Return Values:
+36 ; <0 Error Code
+37 ; 0 Ok
+38 ;
UPDRECS(PTIEN,RGIENLST,BATCHID,ENDT) ;
+1 NEW FS,IEN,IENS,RC,REGIEN,RORFDA,RORMSG
+2 SET (RC,REGIEN)=0
+3 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+4 KILL RORFDA,RORMSG
+5 SET IEN=+RGIENLST(REGIEN)
if IEN'>0
QUIT
+6 SET IENS=IEN_","
+7 ;--- Store the Message ID in the registry
+8 if BATCHID'=""
SET RORFDA(798,IENS,10)=BATCHID
+9 ;--- Otherwise, populate the MESSAGE ID field with a fake ID.
+10 ; This will force the message status checkup process to
+11 ; update the DATA ACKNOWLEDGED UNTIL field so that the next
+12 ; data extraction process will not browse through the data
+13 ;--- already processed by the previous one.
+14 if BATCHID=""
SET RORFDA(798,IENS,10)=ROREXT("HL7MID")_"-0"
+15 ;--- Always update the DATA EXTRACTED UNTIL field
+16 SET RORFDA(798,IENS,9.2)=ENDT
+17 ;--- Update the registry record
+18 DO FILE^DIE(,"RORFDA","RORMSG")
+19 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
End DoDot:1
if RC<0
QUIT
+20 ;---
+21 QUIT $SELECT(RC<0:RC,1:0)
