| [613] | 1 | ROREXT03 ;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
 | 
|---|
 | 7 | CSR(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
 | 
|---|
 | 39 | PID() ;
 | 
|---|
 | 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 |  ;
 | 
|---|
 | 65 | REGSTATE(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 |  ;
 | 
|---|
 | 83 | SEND(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 |  ;
 | 
|---|
 | 122 | UPDRECS(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)
 | 
|---|