Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHL06

RORHL06.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #1995         $$CPT^ICPTCOD (supported)
  1.  ; #10035        Read access to the PATIENT file (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** SEARCHES FOR LIVER BIOPSY DATA
  1.  ;
  1.  ; RORDFN        IEN of the patient in the PATIENT file (#2)
  1.  ;
  1.  ; RORSTDT       Start Date (FileMan)
  1.  ; RORENDT       End Date   (FileMan)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1.  ; The function uses the ^UTILITY($J,"W") global node.
  1.  ;
  1. EN1(RORDFN,RORSTDT,RORENDT) ;
  1.  N ERRCNT,FLDS,IDT,IENS,K5,LRDFN,QUIT,RC,SPECIMEN
  1.  S (ERRCNT,RC)=0
  1.  ;
  1.  ;--- Check if the patient exists
  1.  S RORDFN=+$G(RORDFN)
  1.  I '$D(^DPT(RORDFN))  D  Q RC
  1.  . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
  1.  ;
  1.  S LRDFN=+$$LABREF^RORUTL18(RORDFN)  Q:LRDFN'>0 0
  1.  ;
  1.  S FLDS="1.1;1.4"
  1.  S RORENDT=$$INVDATE^RORUTL01(RORENDT)
  1.  S RORSTDT=$$INVDATE^RORUTL01(RORSTDT)
  1.  ;
  1.  S IDT=$O(^LR(LRDFN,"SP",RORSTDT))
  1.  F  S IDT=$O(^LR(LRDFN,"SP",IDT),-1)  Q:'IDT!(IDT'>RORENDT)  D  Q:RC<0
  1.  . S K5=0,QUIT=0
  1.  . F  S K5=$O(^LR(LRDFN,"SP",IDT,.1,K5))  Q:'K5  D  Q:QUIT!(RC<0)
  1.  . . S IENS=K5_","_IDT_","_LRDFN_","
  1.  . . S SPECIMEN=$$GET1^DIQ(63.812,IENS,.01,"E",,"RORMSG")
  1.  . . I $G(DIERR)  D  S ERRCNT=ERRCNT+1  Q
  1.  . . . D DBS^RORERR("RORMSG",-9,,,63.812,IENS)
  1.  . . I $$UP^XLFSTR(SPECIMEN)["LIVER"  D
  1.  . . . S IENS=IDT_","_LRDFN_","
  1.  . . . S TMP=$$OBR(IENS)
  1.  . . . I TMP  S ERRCNT=ERRCNT+1  Q:TMP<0
  1.  . . . S TMP=$$OBX(IENS,FLDS)
  1.  . . . I TMP  S ERRCNT=ERRCNT+1  Q:TMP<0
  1.  . . . S QUIT=1
  1.  ;
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** LIVER BIOPSY OBR SEGMENT BUILDER
  1.  ;
  1.  ; RORIENS       IENS of Liver Biopsy Record in File #63.08
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBR(RORIENS) ;
  1.  N BUF,CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS)
  1.  ;--- Check the parameters
  1.  S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1.  ;
  1.  ;--- Load the data (with a temporary fix for invalid
  1.  ;--- output transform of the .01 field - ROR*1*8)
  1.  D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
  1.  D GETS^DIQ(63.08,RORIENS,".06;.07;.08","IE","ROROUT","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
  1.  ;
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBR"
  1.  ;
  1.  ;--- OBR-3 - Surgical Path Acc #
  1.  S RORSEG(3)=$G(ROROUT(63.08,RORIENS,.06,"E"))
  1.  ;
  1.  ;--- OBR-4 - Liver Biopsy CPT Code
  1.  S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
  1.  I TMP<0  D  S ERRCNT=ERRCNT+1,TMP=""
  1.  . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
  1.  S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
  1.  S $P(BUF,CS,3)="C4"
  1.  S RORSEG(4)=BUF
  1.  ;
  1.  ;--- OBR-7 - Date/Time Specimen Taken
  1.  S TMP=$G(ROROUT(63.08,RORIENS,.01,"I"))
  1.  Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
  1.  S RORSEG(7)=$$FMTHL7^XLFDT(TMP)
  1.  ;
  1.  ;--- OBR-16 - Surgeon/Physician
  1.  S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
  1.  ;
  1.  ;--- OBR-24 - Service Section ID
  1.  S RORSEG(24)="SP"
  1.  ;
  1.  ;--- OBR-44 - Division
  1.  S TMP=$G(ROROUT(63.08,RORIENS,.08,"E"))
  1.  S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
  1.  S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** LIVER BIOPSY OBX SEGMENT(S) BUILDER
  1.  ;
  1.  ; RORIENS       IENS of Liver Biopsy Record in File #63.08
  1.  ; RORFLDS       List of WP fields to return as OBX'es
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBX(RORIENS,RORFLDS) ;
  1.  N BUF,CS,DIWF,DIWL,DIWR,ERRCNT,FLD,I,RORII,PZ,RC,RORMSG,ROROUT,RORRES,RORSEG,SCS,TMP,X
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS,.SCS)
  1.  ;--- Check the parameters
  1.  S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1.  ;
  1.  ;--- Load the data
  1.  D GETS^DIQ(63.08,RORIENS,RORFLDS,"EI","ROROUT","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-99,,,63.08,RORIENS)
  1.  ;
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBX"
  1.  ;
  1.  ;--- OBX-2
  1.  S RORSEG(2)="FT"
  1.  ;
  1.  ;--- OBX-11
  1.  S RORSEG(11)="F"
  1.  ;
  1.  F PZ=1:1  S FLD=$P(RORFLDS,";",PZ)  Q:FLD=""  D  Q:RC<0
  1.  . S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
  1.  . I TMP<0  D  S ERRCNT=ERRCNT+1,TMP=""
  1.  . . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
  1.  . S $P(BUF,SCS,2)=$$GET1^DID(63.08,FLD,,"LABEL",,"RORMSG")
  1.  . S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
  1.  . S $P(BUF,CS,3)="C4"
  1.  . S RORSEG(3)=BUF
  1.  . ;---
  1.  . K ^UTILITY($J,"W")
  1.  . S DIWL=1,DIWR=72
  1.  . S RORII=0
  1.  . F  S RORII=$O(ROROUT(63.08,RORIENS,FLD,RORII))  Q:'RORII  D
  1.  . . S X=ROROUT(63.08,RORIENS,FLD,RORII)  D ^DIWP
  1.  . ;---
  1.  . S I=0
  1.  . F  S I=$O(^UTILITY($J,"W",DIWL,I))  Q:'I  D
  1.  . . S RORSEG(5)=$G(^UTILITY($J,"W",DIWL,I,0))
  1.  . . ;--- Store the segment
  1.  . . D ADDSEG^RORHL7(.RORSEG)
  1.  ;
  1.  Q $S(RC<0:RC,1:ERRCNT)