RORHL06 ;HOIFO/BH,CRT - HL7 LIVER BIOPSY: OBR,OBX ; 3/13/06 9:23am
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #1995 $$CPT^ICPTCOD (supported)
; #10035 Read access to the PATIENT file (supported)
;
Q
;
;***** SEARCHES FOR LIVER BIOPSY DATA
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; RORSTDT Start Date (FileMan)
; RORENDT End Date (FileMan)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
; The function uses the ^UTILITY($J,"W") global node.
;
EN1(RORDFN,RORSTDT,RORENDT) ;
N ERRCNT,FLDS,IDT,IENS,K5,LRDFN,QUIT,RC,SPECIMEN
S (ERRCNT,RC)=0
;
;--- Check if the patient exists
S RORDFN=+$G(RORDFN)
I '$D(^DPT(RORDFN)) D Q RC
. S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
;
S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
;
S FLDS="1.1;1.4"
S RORENDT=$$INVDATE^RORUTL01(RORENDT)
S RORSTDT=$$INVDATE^RORUTL01(RORSTDT)
;
S IDT=$O(^LR(LRDFN,"SP",RORSTDT))
F S IDT=$O(^LR(LRDFN,"SP",IDT),-1) Q:'IDT!(IDT'>RORENDT) D Q:RC<0
. S K5=0,QUIT=0
. F S K5=$O(^LR(LRDFN,"SP",IDT,.1,K5)) Q:'K5 D Q:QUIT!(RC<0)
. . S IENS=K5_","_IDT_","_LRDFN_","
. . S SPECIMEN=$$GET1^DIQ(63.812,IENS,.01,"E",,"RORMSG")
. . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
. . . D DBS^RORERR("RORMSG",-9,,,63.812,IENS)
. . I $$UP^XLFSTR(SPECIMEN)["LIVER" D
. . . S IENS=IDT_","_LRDFN_","
. . . S TMP=$$OBR(IENS)
. . . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
. . . S TMP=$$OBX(IENS,FLDS)
. . . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
. . . S QUIT=1
;
Q $S(RC<0:RC,1:ERRCNT)
;
;***** LIVER BIOPSY OBR SEGMENT BUILDER
;
; RORIENS IENS of Liver Biopsy Record in File #63.08
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR(RORIENS) ;
N BUF,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,".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 Path Acc #
S RORSEG(3)=$G(ROROUT(63.08,RORIENS,.06,"E"))
;
;--- OBR-4 - Liver Biopsy CPT Code
S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
I TMP<0 D S ERRCNT=ERRCNT+1,TMP=""
. D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
S $P(BUF,CS,3)="C4"
S RORSEG(4)=BUF
;
;--- OBR-7 - Date/Time Specimen Taken
S TMP=$G(ROROUT(63.08,RORIENS,.01,"I"))
Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
S RORSEG(7)=$$FMTHL7^XLFDT(TMP)
;
;--- OBR-16 - Surgeon/Physician
S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
;
;--- OBR-24 - Service Section ID
S RORSEG(24)="SP"
;
;--- OBR-44 - Division
S TMP=$G(ROROUT(63.08,RORIENS,.08,"E"))
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 $S(RC<0:RC,1:ERRCNT)
;
;***** LIVER BIOPSY OBX SEGMENT(S) BUILDER
;
; RORIENS IENS of Liver Biopsy Record in File #63.08
; RORFLDS List of WP fields to return as OBX'es
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORIENS,RORFLDS) ;
N BUF,CS,DIWF,DIWL,DIWR,ERRCNT,FLD,I,RORII,PZ,RC,RORMSG,ROROUT,RORRES,RORSEG,SCS,TMP,X
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS,.SCS)
;--- Check the parameters
S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
;
;--- Load the data
D GETS^DIQ(63.08,RORIENS,RORFLDS,"EI","ROROUT","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-99,,,63.08,RORIENS)
;
;--- Initialize the segment
S RORSEG(0)="OBX"
;
;--- OBX-2
S RORSEG(2)="FT"
;
;--- OBX-11
S RORSEG(11)="F"
;
F PZ=1:1 S FLD=$P(RORFLDS,";",PZ) Q:FLD="" D Q:RC<0
. S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
. I TMP<0 D S ERRCNT=ERRCNT+1,TMP=""
. . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
. S $P(BUF,SCS,2)=$$GET1^DID(63.08,FLD,,"LABEL",,"RORMSG")
. S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
. S $P(BUF,CS,3)="C4"
. S RORSEG(3)=BUF
. ;---
. K ^UTILITY($J,"W")
. S DIWL=1,DIWR=72
. S RORII=0
. F S RORII=$O(ROROUT(63.08,RORIENS,FLD,RORII)) Q:'RORII D
. . S X=ROROUT(63.08,RORIENS,FLD,RORII) D ^DIWP
. ;---
. S I=0
. F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I D
. . S RORSEG(5)=$G(^UTILITY($J,"W",DIWL,I,0))
. . ;--- Store the segment
. . D ADDSEG^RORHL7(.RORSEG)
;
Q $S(RC<0:RC,1:ERRCNT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL06 4984 printed Dec 13, 2024@01:41:49 Page 2
RORHL06 ;HOIFO/BH,CRT - HL7 LIVER BIOPSY: OBR,OBX ; 3/13/06 9:23am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1995 $$CPT^ICPTCOD (supported)
+6 ; #10035 Read access to the PATIENT file (supported)
+7 ;
+8 QUIT
+9 ;
+10 ;***** SEARCHES FOR LIVER BIOPSY DATA
+11 ;
+12 ; RORDFN IEN of the patient in the PATIENT file (#2)
+13 ;
+14 ; RORSTDT Start Date (FileMan)
+15 ; RORENDT End Date (FileMan)
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ; >0 Non-fatal error(s)
+21 ;
+22 ; The function uses the ^UTILITY($J,"W") global node.
+23 ;
EN1(RORDFN,RORSTDT,RORENDT) ;
+1 NEW ERRCNT,FLDS,IDT,IENS,K5,LRDFN,QUIT,RC,SPECIMEN
+2 SET (ERRCNT,RC)=0
+3 ;
+4 ;--- Check if the patient exists
+5 SET RORDFN=+$GET(RORDFN)
+6 IF '$DATA(^DPT(RORDFN))
Begin DoDot:1
+7 SET RC=$$ERROR^RORERR(-36,,,RORDFN,2)
End DoDot:1
QUIT RC
+8 ;
+9 SET LRDFN=+$$LABREF^RORUTL18(RORDFN)
if LRDFN'>0
QUIT 0
+10 ;
+11 SET FLDS="1.1;1.4"
+12 SET RORENDT=$$INVDATE^RORUTL01(RORENDT)
+13 SET RORSTDT=$$INVDATE^RORUTL01(RORSTDT)
+14 ;
+15 SET IDT=$ORDER(^LR(LRDFN,"SP",RORSTDT))
+16 FOR
SET IDT=$ORDER(^LR(LRDFN,"SP",IDT),-1)
if 'IDT!(IDT'>RORENDT)
QUIT
Begin DoDot:1
+17 SET K5=0
SET QUIT=0
+18 FOR
SET K5=$ORDER(^LR(LRDFN,"SP",IDT,.1,K5))
if 'K5
QUIT
Begin DoDot:2
+19 SET IENS=K5_","_IDT_","_LRDFN_","
+20 SET SPECIMEN=$$GET1^DIQ(63.812,IENS,.01,"E",,"RORMSG")
+21 IF $GET(DIERR)
Begin DoDot:3
+22 DO DBS^RORERR("RORMSG",-9,,,63.812,IENS)
End DoDot:3
SET ERRCNT=ERRCNT+1
QUIT
+23 IF $$UP^XLFSTR(SPECIMEN)["LIVER"
Begin DoDot:3
+24 SET IENS=IDT_","_LRDFN_","
+25 SET TMP=$$OBR(IENS)
+26 IF TMP
SET ERRCNT=ERRCNT+1
if TMP<0
QUIT
+27 SET TMP=$$OBX(IENS,FLDS)
+28 IF TMP
SET ERRCNT=ERRCNT+1
if TMP<0
QUIT
+29 SET QUIT=1
End DoDot:3
End DoDot:2
if QUIT!(RC<0)
QUIT
End DoDot:1
if RC<0
QUIT
+30 ;
+31 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+32 ;
+33 ;***** LIVER BIOPSY OBR SEGMENT BUILDER
+34 ;
+35 ; RORIENS IENS of Liver Biopsy Record in File #63.08
+36 ;
+37 ; Return Values:
+38 ; <0 Error code
+39 ; 0 Ok
+40 ; >0 Non-fatal error(s)
+41 ;
OBR(RORIENS) ;
+1 NEW BUF,CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;--- Check the parameters
+5 if $EXTRACT(RORIENS,$LENGTH(RORIENS))'=","
SET RORIENS=RORIENS_","
+6 ;
+7 ;--- Load the data (with a temporary fix for invalid
+8 ;--- output transform of the .01 field - ROR*1*8)
+9 DO GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
+10 IF $GET(DIERR)
Begin DoDot:1
+11 DO DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+12 DO GETS^DIQ(63.08,RORIENS,".06;.07;.08","IE","ROROUT","RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:1
+14 DO DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+15 ;
+16 ;--- Initialize the segment
+17 SET RORSEG(0)="OBR"
+18 ;
+19 ;--- OBR-3 - Surgical Path Acc #
+20 SET RORSEG(3)=$GET(ROROUT(63.08,RORIENS,.06,"E"))
+21 ;
+22 ;--- OBR-4 - Liver Biopsy CPT Code
+23 SET BUF=47000
SET TMP=$$CPT^ICPTCOD(BUF)
+24 IF TMP<0
Begin DoDot:1
+25 DO ERROR^RORERR(-57,,$PIECE(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
End DoDot:1
SET ERRCNT=ERRCNT+1
SET TMP=""
+26 SET $PIECE(BUF,CS,2)=$$ESCAPE^RORHL7($PIECE(TMP,U,3))
+27 SET $PIECE(BUF,CS,3)="C4"
+28 SET RORSEG(4)=BUF
+29 ;
+30 ;--- OBR-7 - Date/Time Specimen Taken
+31 SET TMP=$GET(ROROUT(63.08,RORIENS,.01,"I"))
+32 if TMP'>0
QUIT $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
+33 SET RORSEG(7)=$$FMTHL7^XLFDT(TMP)
+34 ;
+35 ;--- OBR-16 - Surgeon/Physician
+36 SET RORSEG(16)=$GET(ROROUT(63.08,RORIENS,.07,"I"))
+37 ;
+38 ;--- OBR-24 - Service Section ID
+39 SET RORSEG(24)="SP"
+40 ;
+41 ;--- OBR-44 - Division
+42 SET TMP=$GET(ROROUT(63.08,RORIENS,.08,"E"))
+43 SET IEN=$SELECT(TMP'="":+$ORDER(^SC("B",TMP,0)),1:0)
+44 SET RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
+45 ;
+46 ;--- Store the segment
+47 DO ADDSEG^RORHL7(.RORSEG)
+48 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+49 ;
+50 ;***** LIVER BIOPSY OBX SEGMENT(S) BUILDER
+51 ;
+52 ; RORIENS IENS of Liver Biopsy Record in File #63.08
+53 ; RORFLDS List of WP fields to return as OBX'es
+54 ;
+55 ; Return Values:
+56 ; <0 Error code
+57 ; 0 Ok
+58 ; >0 Non-fatal error(s)
+59 ;
OBX(RORIENS,RORFLDS) ;
+1 NEW BUF,CS,DIWF,DIWL,DIWR,ERRCNT,FLD,I,RORII,PZ,RC,RORMSG,ROROUT,RORRES,RORSEG,SCS,TMP,X
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS,.SCS)
+4 ;--- Check the parameters
+5 if $EXTRACT(RORIENS,$LENGTH(RORIENS))'=","
SET RORIENS=RORIENS_","
+6 ;
+7 ;--- Load the data
+8 DO GETS^DIQ(63.08,RORIENS,RORFLDS,"EI","ROROUT","RORMSG")
+9 IF $GET(DIERR)
Begin DoDot:1
+10 DO DBS^RORERR("RORMSG",-99,,,63.08,RORIENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+11 ;
+12 ;--- Initialize the segment
+13 SET RORSEG(0)="OBX"
+14 ;
+15 ;--- OBX-2
+16 SET RORSEG(2)="FT"
+17 ;
+18 ;--- OBX-11
+19 SET RORSEG(11)="F"
+20 ;
+21 FOR PZ=1:1
SET FLD=$PIECE(RORFLDS,";",PZ)
if FLD=""
QUIT
Begin DoDot:1
+22 SET BUF=47000
SET TMP=$$CPT^ICPTCOD(BUF)
+23 IF TMP<0
Begin DoDot:2
+24 DO ERROR^RORERR(-57,,$PIECE(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
End DoDot:2
SET ERRCNT=ERRCNT+1
SET TMP=""
+25 SET $PIECE(BUF,SCS,2)=$$GET1^DID(63.08,FLD,,"LABEL",,"RORMSG")
+26 SET $PIECE(BUF,CS,2)=$$ESCAPE^RORHL7($PIECE(TMP,U,3))
+27 SET $PIECE(BUF,CS,3)="C4"
+28 SET RORSEG(3)=BUF
+29 ;---
+30 KILL ^UTILITY($JOB,"W")
+31 SET DIWL=1
SET DIWR=72
+32 SET RORII=0
+33 FOR
SET RORII=$ORDER(ROROUT(63.08,RORIENS,FLD,RORII))
if 'RORII
QUIT
Begin DoDot:2
+34 SET X=ROROUT(63.08,RORIENS,FLD,RORII)
DO ^DIWP
End DoDot:2
+35 ;---
+36 SET I=0
+37 FOR
SET I=$ORDER(^UTILITY($JOB,"W",DIWL,I))
if 'I
QUIT
Begin DoDot:2
+38 SET RORSEG(5)=$GET(^UTILITY($JOB,"W",DIWL,I,0))
+39 ;--- Store the segment
+40 DO ADDSEG^RORHL7(.RORSEG)
End DoDot:2
End DoDot:1
if RC<0
QUIT
+41 ;
+42 QUIT $SELECT(RC<0:RC,1:ERRCNT)
