194 lines
5.5 KiB
Mathematica
194 lines
5.5 KiB
Mathematica
RORHL14 ;HOIFO/BH,SG - HL7 ALLERGY DATA: OBR,OBX ; 8/26/05 2:43pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #2167 Read access to the file #120.83 (controlled)
|
|
; #4531 ZERO^PSN50P41
|
|
; #4543 IEN^PSN50P65
|
|
; #10060 Read access to the file #200 (supported)
|
|
;
|
|
;
|
|
Q
|
|
;
|
|
;***** SEARCHES FOR ALLERGY 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.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Non-fatal error(s)
|
|
;
|
|
EN1(RORDFN,DXDTS) ;
|
|
N ERRCNT,IDX,RC,RORARR,RORDTE,RORENDT,RORIEN,RORSTDT,TMP
|
|
S (ERRCNT,RC)=0
|
|
;
|
|
S IDX=0
|
|
F S IDX=$O(DXDTS(13,IDX)) Q:IDX'>0 D Q:RC<0
|
|
. S RORSTDT=$P(DXDTS(13,IDX),U),RORENDT=$P(DXDTS(13,IDX),U,2)
|
|
. ;---
|
|
. S RORDTE=$O(^GMR(120.8,"AODT",RORSTDT),-1)
|
|
. F S RORDTE=$O(^GMR(120.8,"AODT",RORDTE)) Q:'RORDTE!(RORDTE'<RORENDT) D
|
|
. . S RORIEN=0
|
|
. . F S RORIEN=$O(^GMR(120.8,"AODT",RORDTE,RORIEN)) Q:'RORIEN D
|
|
. . . S:$D(^GMR(120.8,"B",RORDFN,RORIEN)) RORARR(RORIEN)=""
|
|
. I $D(RORARR)<10 S ERRCNT=ERRCNT+1 Q
|
|
. ;
|
|
. S RORIEN=0
|
|
. F S RORIEN=$O(RORARR(RORIEN)) Q:'RORIEN D
|
|
. . S TMP=$$OBR(RORIEN,RORDFN)
|
|
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
|
|
. . S TMP=$$OBX(RORIEN,RORDFN)
|
|
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
|
|
;
|
|
Q $S(RC<0:RC,1:ERRCNT)
|
|
;
|
|
;***** ALLERGY OBR SEGMENT BUILDER
|
|
;
|
|
; RORAIEN IEN of Allergy entry
|
|
; RORDFN IEN of the patient in the PATIENT file (#2)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Non-fatal error(s)
|
|
;
|
|
OBR(RORAIEN,RORDFN) ;
|
|
N BUF,CS,ERRCNT,RC,RORLST,RORMSG,RORSEG,TMP
|
|
S (ERRCNT,RC)=0
|
|
D ECH^RORHL7(.CS)
|
|
;
|
|
S RORAIEN=RORAIEN_","
|
|
D GETS^DIQ(120.8,RORAIEN,".02;3.1;4;5;6","EI","RORLST","RORMSG")
|
|
I $G(DIERR) D S ERRCNT=ERRCNT+1
|
|
. D DBS^RORERR("RORMSG",-9,,RORDFN,120.8,RORAIEN)
|
|
;
|
|
;--- Initialize the segment
|
|
S RORSEG(0)="OBR"
|
|
;
|
|
;--- OBR-3 - IEN of the record
|
|
S RORSEG(3)=$P(RORAIEN,",")
|
|
;
|
|
;--- OBR-4 - Sevice ID
|
|
S RORSEG(4)="95000"_CS_"ALLERGY"_CS_"C4"
|
|
;
|
|
;--- OBR-7 - Observation Date/Time (Origination Date)
|
|
S TMP=$$FMTHL7^XLFDT($G(RORLST(120.8,RORAIEN,4,"I")))
|
|
Q:TMP'>0 $$ERROR^RORERR(-95,,,RORDFN,120.8,RORAIEN,4)
|
|
S RORSEG(7)=TMP
|
|
;
|
|
;--- OBR-13 - Relevant Clinical Info. (Reactant)
|
|
S RORSEG(13)=$G(RORLST(120.8,RORAIEN,.02,"E"))
|
|
;
|
|
;--- OBR-16 - Ordering Provider
|
|
S BUF=$G(RORLST(120.8,RORAIEN,5,"I"))
|
|
I BUF>0 D
|
|
. S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
|
|
. I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
|
|
. . D DBS^RORERR("RORMSG",-99,,RORDFN,200,+BUF_",")
|
|
. S RORSEG(16)=BUF
|
|
;
|
|
;--- OBR-20 - Filler Field 1 (Allergy Type)
|
|
S RORSEG(20)=$G(RORLST(120.8,RORAIEN,3.1,"E"))
|
|
;
|
|
;--- OBR-24 - Diagnostic Service ID
|
|
S RORSEG(24)="TX"
|
|
;
|
|
;--- OBR-25 - Result Status (Observed/Historical)
|
|
S TMP=$G(RORLST(120.8,RORAIEN,6,"E"))
|
|
I TMP'="" D S RORSEG(25)=TMP
|
|
. S TMP=$S(TMP="HISTORICAL":"R",TMP="OBSERVED":"F",1:"")
|
|
;
|
|
;--- Store the segment
|
|
D ADDSEG^RORHL7(.RORSEG)
|
|
Q ERRCNT
|
|
;
|
|
;***** ALLERGY OBX SEGMENT(S) BUILDER
|
|
;
|
|
; RORAIEN IEN of Allergy entry
|
|
; RORDFN IEN of the patient in the PATIENT file (#2)
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; >0 Non-fatal error(s)
|
|
;
|
|
OBX(RORAIEN,RORDFN) ;
|
|
N BUF,CS,DTE,ERRCNT,IEN,RC,REAC,RORID,RORIENS,RORKEY,RORLST,RORMSG,RORSEG,RORTMP,RORTS,RPS,TMP
|
|
S (ERRCNT,RC)=0,RORIENS=","_RORAIEN_","
|
|
D ECH^RORHL7(.CS,,.RPS)
|
|
;
|
|
;=== Ingredients
|
|
K RORLST,RORMSG
|
|
D LIST^DIC(120.802,RORIENS,"@;.01","I",,,,,,,"RORLST","RORMSG")
|
|
I $G(DIERR) D Q RC
|
|
. S RC=$$DBS^RORERR("RORMSG",-9,,RORDFN,120.802,RORIENS)
|
|
S RORID="INGR"_CS_"Ingredients"_CS_"VA080"
|
|
;---
|
|
S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
|
S RORKEY=0
|
|
F S RORKEY=$O(RORLST("DILIST","ID",RORKEY)) Q:'RORKEY D
|
|
. S IEN=+$G(RORLST("DILIST","ID",RORKEY,.01)) Q:IEN'>0
|
|
. D ZERO^PSN50P41(IEN,,,RORTS)
|
|
. S TMP=$G(@RORTMP@(IEN,.01))
|
|
. D:TMP'="" SETOBX(TMP,RORID)
|
|
D FREE^RORTMP(RORTMP)
|
|
;
|
|
;=== Classes
|
|
K RORLST,RORMSG
|
|
D LIST^DIC(120.803,RORIENS,"@;.01","I",,,,,,,"RORLST","RORMSG")
|
|
I $G(DIERR) D Q RC
|
|
. S RC=$$DBS^RORERR("RORMSG",-9,,RORDFN,120.803,RORIENS)
|
|
;---
|
|
S RORTMP=$$ALLOC^RORTMP(.RORTS)
|
|
S (CNT,RORKEY)=0,BUF=""
|
|
F S RORKEY=$O(RORLST("DILIST","ID",RORKEY)) Q:'RORKEY D
|
|
. S IEN=+$G(RORLST("DILIST","ID",RORKEY,.01)) Q:IEN'>0
|
|
. D IEN^PSN50P65(IEN,,RORTS)
|
|
. S TMP=$G(@RORTMP@(IEN,.01))
|
|
. S:TMP'="" BUF=BUF_$S(BUF'="":RPS_TMP,1:TMP)
|
|
D:BUF'="" SETOBX(BUF,"CLAS"_CS_"Drug Class"_CS_"VA080")
|
|
D FREE^RORTMP(RORTMP)
|
|
;
|
|
;=== Reactions
|
|
K RORLST,RORMSG
|
|
D LIST^DIC(120.81,RORIENS,"@;.01;3","I",,,,,,,"RORLST","RORMSG")
|
|
I $G(DIERR) D Q RC
|
|
. S RC=$$DBS^RORERR("RORMSG",-9,,RORDFN,120.81,RORIENS)
|
|
S RORID="RCTS"_CS_"Reactions"_CS_"VA080"
|
|
;---
|
|
S RORKEY=0
|
|
F S RORKEY=$O(RORLST("DILIST","ID",RORKEY)) Q:'RORKEY D
|
|
. S IEN=RORLST("DILIST","ID",RORKEY,.01) Q:IEN'>0
|
|
. S REAC=$$GET1^DIQ(120.83,IEN_",",.01,"E",,"RORMSG")
|
|
. I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
|
|
. . D DBS^RORERR("RORMSG",-99,,RORDFN,120.83,IEN_",")
|
|
. Q:REAC=""
|
|
. S DTE=$$FM2HL^RORHL7($G(RORLST("DILIST","ID",RORKEY,3)))
|
|
. D SETOBX(REAC,RORID,DTE)
|
|
;
|
|
Q $S(RC<0:RC,1:ERRCNT)
|
|
;
|
|
;***** CREATES AND STORES THE OBX SEGMENT
|
|
SETOBX(OBX5,OBX3,OBX12) ;
|
|
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)=OBX5
|
|
;--- OBX-11 - Observation Result Status
|
|
S RORSEG(11)="F"
|
|
;--- OBX-12 - Reactions Date/Time Entered
|
|
S:$G(OBX12)'="" RORSEG(12)=OBX12
|
|
;--- Store the segment
|
|
D ADDSEG^RORHL7(.RORSEG)
|
|
Q
|