RORHL10 ;HOIFO/BH - HL7 SURGICAL PATHOLOGY DATA: OBR,OBX ; 3/13/06 9:24am ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24 ; ; This routine uses the following IAs: ; ; #525 Read access to the multiple #63.08 (controlled) ; #4343 $$SPATH^LA7UTL03 (controlled) ; Q ; ;***** SEARCHES FOR SURGICAL PATHOLOGY DATA ; ; RORDFN IEN of the patient in the PATIENT file (#2) ; ; .DXDTS Reference to a local variable where the ; data extraction time frames are stored. ; ; [CDSMODE] Search the data by: ; 0 completion/result date (default) ; 1 specimen collection date ; ; Return Values: ; <0 Error code ; 0 Ok ; >0 Non-fatal error(s) ; EN1(RORDFN,DXDTS,CDSMODE) ; N ERRCNT,IDX,LRDFN,RC,RORENDT,RORSTDT S (ERRCNT,RC)=0 ; S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0 ; S IDX=0 F S IDX=$O(DXDTS(9,IDX)) Q:IDX'>0 D Q:RC<0 . S RORSTDT=$P(DXDTS(9,IDX),U),RORENDT=$P(DXDTS(9,IDX),U,2) . ;--- . S RC=$S($G(CDSMODE):$$CD(),1:$$RAD()) . S:RC>0 ERRCNT=ERRCNT+RC ; Q $S(RC<0:RC,1:ERRCNT) ; ;***** SEARCHES BY SPECIMEN COLLECTION DATE CD() ; N ENDT,ERRCNT,IDT,STDT S ERRCNT=0 S STDT=9999999-RORSTDT S ENDT=9999999-RORENDT ;--- S IDT=$O(^LR(LRDFN,"SP",STDT)) F S IDT=$O(^LR(LRDFN,"SP",IDT),-1) Q:'IDT!(IDT'>ENDT) D . S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1 Q ERRCNT ; ;***** SEARCHES BY COMPLETION (RESULT) DATE RAD() ; N ERRCNT,IDT,RCDT S ERRCNT=0 ;--- S IDT=0 F S IDT=$O(^LR(LRDFN,"SP",IDT)) Q:IDT'>0 D . S RCDT=$P($G(^LR(LRDFN,"SP",IDT,0)),U,3) . I RCDT'0 Non-fatal error(s) ; OBR(RORIENS) ; N CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP S (ERRCNT,RC)=0 D ECH^RORHL7(.CS) ;--- Check the parameters S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_"," ; ;--- Load the data (with a temporary fix for invalid ;--- output transform of the .01 field - ROR*1*8) D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG") I $G(DIERR) D S ERRCNT=ERRCNT+1 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS) D GETS^DIQ(63.08,RORIENS,".03;.06;.07;.08","IE","ROROUT","RORMSG") I $G(DIERR) D S ERRCNT=ERRCNT+1 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS) ; ;--- Initialize the segment S RORSEG(0)="OBR" ; ;--- OBR-3 - Surgical Pathology Acc # I $G(ROROUT(63.08,RORIENS,.06,"E"))="" D Q RC . S RC=$$ERROR^RORERR(-95,,,,63.08,RORIENS,.06) S RORSEG(3)=ROROUT(63.08,RORIENS,.06,"E") ; ;--- OBR-4 - SP CPT Code S RORSEG(4)="88300"_CS_"LEVEL I - SURGICAL PAT"_CS_"C4" ; ;--- OBR-7 - Date/Time Specimen Taken S TMP=$$FMTHL7^XLFDT($G(ROROUT(63.08,RORIENS,.01,"I"))) Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01) S RORSEG(7)=TMP ; ;--- OBR-8 - Date Report Completed S TMP=$G(ROROUT(63.08,RORIENS,.03,"I")) S RORSEG(8)=$$FM2HL^RORHL7(TMP) ; ;--- OBR-16 - Surgeon/Physican S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I")) ; ;--- OBR-24 - Service Section ID S RORSEG(24)="SP" ; ; OBR-44 - Divsion S TMP=$G(ROROUT(63.08,RORIENS,.08,"I")) S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0) S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS) ; ;--- Store the segment D ADDSEG^RORHL7(.RORSEG) Q ERRCNT ; ;***** OBX SEGMENT BUILDER ; ; LRDFN Patient Lab DFN ; RORIENS IENS of SP Entry ; ; Return Values: ; <0 Error code ; 0 Ok ; >0 Non-fatal error(s) ; OBX(LRDFN,RORIENS) ; N CS,ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTMP,RPS,TMP S (ERRCNT,RC)=0 D ECH^RORHL7(.CS,,.RPS) S RORTMP=$$ALLOC^RORTMP() ;--- I $$SPATH^LA7UTL03(LRDFN,RORIENS,RORTMP,"RORMSG") D . D SPECIMEN . D SETOBXWP($$SEGID("BCH","Brief clinical History",CS),"CHIS") . D SETOBXWP($$SEGID("PDIAG","Preoperative Diagnosis",CS),"PREDX") . D SETOBXWP($$SEGID("OF","Operative Findings",CS),"OPERDX") . S TMP=$$SEGID("POPDIAG","Postoperative Diagnosis",CS) . D SETOBXWP(TMP,"POSTDX") . D SETOBXWP($$SEGID("GDESC","Gross Decription",CS),"GROSSD") . D SETOBXWP($$SEGID("MDESC","Microscopic Description",CS),"MICROD") . S TMP=$$SEGID("SPDIAG","Surgical Pathology Diagnosis",CS) . D SETOBXWP(TMP,"SURGP") . D ICD(RPS) E D:$D(RORMSG)>1 . N I,INFO S TMP="" . F I=1:1 S TMP=$O(RORMSG(TMP)) Q:TMP="" S INFO(I)=RORMSG(TMP) . S RC=$$ERROR^RORERR(-56,,.INFO,,0,"$$SPATH^LA7UTL03") ;--- D FREE^RORTMP(RORTMP) Q $S(RC<0:RC,1:ERRCNT) ; ;***** MAKES SPECIMEN OBX SPECIMEN ; N INDEX,RORSPEC,SPECID S INDEX="",SPECID=$$SEGID("SPEC","Specimen",CS) F S INDEX=$O(@RORTMP@("SPEC",INDEX)) Q:INDEX="" D . S RORSPEC=$G(@RORTMP@("SPEC",INDEX)) . D:RORSPEC'="" SETOBX(SPECID,RORSPEC) Q ; ;***** ICD-9 ICD(RPS) ; N CNT,ICDLST,INDEX,RORICD,TMP S ICDID=$$SEGID("ICD9","ICD9",CS) S (INDEX,RORICD)="",CNT=0 F S INDEX=$O(@RORTMP@("ICD9",INDEX)) Q:INDEX="" D . S TMP=$G(@RORTMP@("ICD9",INDEX)) . S:TMP'="" CNT=CNT+1,$P(RORICD,RPS,CNT)=TMP D:RORICD'="" SETOBX(ICDID,RORICD) Q ; ;***** CONSTRUCTS SEGMENT IDENTIFIER SEGID(CODE,NAME,CS) ; Q CODE_CS_NAME_CS_"VA080" ; ;***** CREATE AND STORE THE OBX SEGMENTS SETOBX(OBX3,OBX5) ; N RORSEG ;--- Initialize the segment S RORSEG(0)="OBX" ;--- OBX-2 - Value Type S RORSEG(2)="FT" ;--- OBX-3 - Observation Identifier S RORSEG(3)=OBX3 ;--- OBX-5 - Observation Value S RORSEG(5)=$$ESCAPE^RORHL7(OBX5) ;--- OBX-11 - Observation Result Status S RORSEG(11)="F" ;--- Store the segment D ADDSEG^RORHL7(.RORSEG) Q ; SETOBXWP(OBX3,SUBS) ; N BR,CNT,I,I1,RORSEG,TMP S BR=$E(HLECH,3)_".br"_$E(HLECH,3) Q:$D(@RORTMP@(SUBS))<10 ;--- Initialize the segment S RORSEG(0)="OBX" ;--- OBX-2 - Value Type S RORSEG(2)="FT" ;--- OBX-3 - Observation Identifier S RORSEG(3)=OBX3 ;--- OBX-5 - Observation Value S I=$O(@RORTMP@(SUBS,"")),CNT=0 F Q:I="" S I1=$O(@RORTMP@(SUBS,I)) D S I=I1 . S TMP=$$ESCAPE^RORHL7(@RORTMP@(SUBS,I)) . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP) ;--- OBX-11 - Observation Result Status S RORSEG(11)="F" ;--- Store the segment D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG) Q