RORHL19 ;BPOIFO/ACS - HL7 SKIN TEST DATA: OBR,OBX ;11/1/09
;;1.5;CLINICAL CASE REGISTRIES;**10**;Feb 17, 2006;Build 32
;
; DBIA #5520 : ^AUPNVSK (private)
; DBIA #2028 : ^AUPNVSIT (controlled)
; DBIA #2056 : $$GET1^DIQ,GETS^DIQ (supported)
Q
;
;***** SEARCH FOR SKIN TEST DATA
;
; DFN DFN 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(DFN,DXDTS) ;
N IDX,RORENDT,RORSTDT,ROR1,ROREVDT
S IDX=0
F S ROR1=0 S IDX=$O(DXDTS(18,IDX)) Q:IDX'>0 D
. S RORSTDT=$P(DXDTS(18,IDX),U),RORENDT=$P(DXDTS(18,IDX),U,2)
. ;--- Find Skin Test data
. F S ROR1=$O(^AUPNVSK("C",DFN,ROR1)) Q:'ROR1 D
.. N RORIDATA,RORIERR,ROREVDT K RORIDATA,RORIERR
.. ;get skin test data for the HL7 message
.. D GETS^DIQ(9000010.12,ROR1_",",".01;.03;.04;.05;.06;1201;1202;81101","IE","RORIDATA","RORIERR")
.. Q:$D(RORIERR("DIERR"))
.. S ROREVDT=$G(RORIDATA(9000010.12,ROR1_",",1201,"I")) ;get event date/time
.. ;Q:$G(ROREVDT)>(RORENDT_.999999) ;event date/time can't be in the future
.. N RORVSIT ;get VISIT IEN from immunization file
.. S RORVSIT=$G(RORIDATA(9000010.12,ROR1_",",".03","I")) ;visit IEN
.. ;get FM internal DATE LAST MODIFIED from visit file
.. N RORIDLM,RORIERR,RORDLM K RORIDLM,RORIERR D GETS^DIQ(9000010,RORVSIT_",",".13","I","RORIDLM","RORIERR")
.. S RORDLM=$G(RORIDLM(9000010,RORVSIT_",",".13","I")) ;date last modified
.. S RORDLM=RORDLM\1 ;exclude 'time'
.. Q:RORDLM<RORSTDT ;quit if date last modified is before extraction start date
.. Q:RORDLM>RORENDT ;quit if date last modified is after extraction end date
.. S RORVSIT=+$G(^AUPNVSIT(RORVSIT,0)) ;get visit date/time in FM format
.. ;--- Process the data
.. D OBR(.RORIDATA,DFN,RORVSIT,ROR1)
.. D OBX(.RORIDATA,DFN,RORVSIT,ROR1)
;
Q 0
;
;***** SKIN TEST OBR SEGMENT BUILDER
;
; Return Values:
; 0 Ok
;
OBR(RORIDATA,DFN,RORVSIT,ROR1) ;
N CS,RORSEG
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Skin Test IEN in the V SKIN TEST file
S RORSEG(3)=$G(ROR1)
;
;--- OBR-4 - Universal Service ID
S RORSEG(4)="86486"_CS_"SKIN TEST"_CS_"C4"
;
;--- OBR-7 - DATE READ
N RORDR S RORDR=$G(RORIDATA(9000010.12,ROR1_",",".06","I"))
I $G(RORDR)>0 S RORSEG(7)=$$FM2HL^RORHL7(RORDR)
;
;--- OBR-13 - 'COMMENTS'
S RORSEG(13)=$G(RORIDATA(9000010.12,ROR1_",",81101,"E"))
;
;--- OBR-16 - 'ORDERING PROVIDER': IEN and PROVIDER CLASS
N ROROPIEN,RORDATA,RORMSG
S ROROPIEN=$G(RORIDATA(9000010.12,ROR1_",",1202,"I"))
I ROROPIEN>0 D
. ;get provider class
. S $P(RORDATA,CS,13)=$$GET1^DIQ(200,+ROROPIEN_",",53.5,"E",,"RORMSG")
. Q:$G(RORMSG(("DIERR")))
. S $P(RORDATA,CS,1)=ROROPIEN ;provider IEN
. S RORSEG(16)=$G(RORDATA)
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="OTH"
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q 0
;
;***** SKIN TEST OBX SEGMENT BUILDER
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORIDATA,DFN,RORVSIT,ROR1) ;
N CS,RORSEG
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBX"
;
;--- OBX-2 - Value Type of OBX-5
S RORSEG(2)="FT"
;
;--- OBX-3 - 'SKIN TEST' name
S RORSEG(3)=CS_$G(RORIDATA(9000010.12,ROR1_",",.01,"E"))
;
;--- OBX-5 - 'RESULTS'_CS_'READING'
N TMP1,TMP2
S TMP1=$G(RORIDATA(9000010.12,ROR1_",",.04,"I"))
S TMP2=$G(RORIDATA(9000010.12,ROR1_",",.05,"I"))
S RORSEG(5)=$G(TMP1)_CS_$G(TMP2)
;
;--- OBX-14 - 'EVENT DATE AND TIME'
N TMP1 S TMP1=$G(RORIDATA(9000010.12,ROR1_",",1201,"I"))
I $G(TMP1)>0 S RORSEG(14)=$$FM2HL^RORHL7(TMP1)
;
;--- OBX-19 - 'VISIT' DATE AND TIME
I $G(RORVSIT)>0 S RORSEG(19)=$$FM2HL^RORHL7(RORVSIT) ;convert to HL7 format
;
D ADDSEG^RORHL7(.RORSEG)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL19 4005 printed Dec 13, 2024@01:42:04 Page 2
RORHL19 ;BPOIFO/ACS - HL7 SKIN TEST DATA: OBR,OBX ;11/1/09
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10**;Feb 17, 2006;Build 32
+2 ;
+3 ; DBIA #5520 : ^AUPNVSK (private)
+4 ; DBIA #2028 : ^AUPNVSIT (controlled)
+5 ; DBIA #2056 : $$GET1^DIQ,GETS^DIQ (supported)
+6 QUIT
+7 ;
+8 ;***** SEARCH FOR SKIN TEST DATA
+9 ;
+10 ; DFN DFN of the patient in the PATIENT file (#2)
+11 ;
+12 ; .DXDTS Reference to a local variable where the
+13 ; data extraction time frames are stored.
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Ok
+18 ; >0 Non-fatal error(s)
+19 ;
EN1(DFN,DXDTS) ;
+1 NEW IDX,RORENDT,RORSTDT,ROR1,ROREVDT
+2 SET IDX=0
+3 FOR
SET ROR1=0
SET IDX=$ORDER(DXDTS(18,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+4 SET RORSTDT=$PIECE(DXDTS(18,IDX),U)
SET RORENDT=$PIECE(DXDTS(18,IDX),U,2)
+5 ;--- Find Skin Test data
+6 FOR
SET ROR1=$ORDER(^AUPNVSK("C",DFN,ROR1))
if 'ROR1
QUIT
Begin DoDot:2
+7 NEW RORIDATA,RORIERR,ROREVDT
KILL RORIDATA,RORIERR
+8 ;get skin test data for the HL7 message
+9 DO GETS^DIQ(9000010.12,ROR1_",",".01;.03;.04;.05;.06;1201;1202;81101","IE","RORIDATA","RORIERR")
+10 if $DATA(RORIERR("DIERR"))
QUIT
+11 ;get event date/time
SET ROREVDT=$GET(RORIDATA(9000010.12,ROR1_",",1201,"I"))
+12 ;Q:$G(ROREVDT)>(RORENDT_.999999) ;event date/time can't be in the future
+13 ;get VISIT IEN from immunization file
NEW RORVSIT
+14 ;visit IEN
SET RORVSIT=$GET(RORIDATA(9000010.12,ROR1_",",".03","I"))
+15 ;get FM internal DATE LAST MODIFIED from visit file
+16 NEW RORIDLM,RORIERR,RORDLM
KILL RORIDLM,RORIERR
DO GETS^DIQ(9000010,RORVSIT_",",".13","I","RORIDLM","RORIERR")
+17 ;date last modified
SET RORDLM=$GET(RORIDLM(9000010,RORVSIT_",",".13","I"))
+18 ;exclude 'time'
SET RORDLM=RORDLM\1
+19 ;quit if date last modified is before extraction start date
if RORDLM<RORSTDT
QUIT
+20 ;quit if date last modified is after extraction end date
if RORDLM>RORENDT
QUIT
+21 ;get visit date/time in FM format
SET RORVSIT=+$GET(^AUPNVSIT(RORVSIT,0))
+22 ;--- Process the data
+23 DO OBR(.RORIDATA,DFN,RORVSIT,ROR1)
+24 DO OBX(.RORIDATA,DFN,RORVSIT,ROR1)
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT 0
+27 ;
+28 ;***** SKIN TEST OBR SEGMENT BUILDER
+29 ;
+30 ; Return Values:
+31 ; 0 Ok
+32 ;
OBR(RORIDATA,DFN,RORVSIT,ROR1) ;
+1 NEW CS,RORSEG
+2 DO ECH^RORHL7(.CS)
+3 ;
+4 ;--- Initialize the segment
+5 SET RORSEG(0)="OBR"
+6 ;
+7 ;--- OBR-3 - Skin Test IEN in the V SKIN TEST file
+8 SET RORSEG(3)=$GET(ROR1)
+9 ;
+10 ;--- OBR-4 - Universal Service ID
+11 SET RORSEG(4)="86486"_CS_"SKIN TEST"_CS_"C4"
+12 ;
+13 ;--- OBR-7 - DATE READ
+14 NEW RORDR
SET RORDR=$GET(RORIDATA(9000010.12,ROR1_",",".06","I"))
+15 IF $GET(RORDR)>0
SET RORSEG(7)=$$FM2HL^RORHL7(RORDR)
+16 ;
+17 ;--- OBR-13 - 'COMMENTS'
+18 SET RORSEG(13)=$GET(RORIDATA(9000010.12,ROR1_",",81101,"E"))
+19 ;
+20 ;--- OBR-16 - 'ORDERING PROVIDER': IEN and PROVIDER CLASS
+21 NEW ROROPIEN,RORDATA,RORMSG
+22 SET ROROPIEN=$GET(RORIDATA(9000010.12,ROR1_",",1202,"I"))
+23 IF ROROPIEN>0
Begin DoDot:1
+24 ;get provider class
+25 SET $PIECE(RORDATA,CS,13)=$$GET1^DIQ(200,+ROROPIEN_",",53.5,"E",,"RORMSG")
+26 if $GET(RORMSG(("DIERR")))
QUIT
+27 ;provider IEN
SET $PIECE(RORDATA,CS,1)=ROROPIEN
+28 SET RORSEG(16)=$GET(RORDATA)
End DoDot:1
+29 ;
+30 ;--- OBR-24 - Diagnostic Service ID
+31 SET RORSEG(24)="OTH"
+32 ;
+33 ;--- Store the segment
+34 DO ADDSEG^RORHL7(.RORSEG)
+35 QUIT 0
+36 ;
+37 ;***** SKIN TEST OBX SEGMENT BUILDER
+38 ;
+39 ; Return Values:
+40 ; <0 Error code
+41 ; 0 Ok
+42 ; >0 Non-fatal error(s)
+43 ;
OBX(RORIDATA,DFN,RORVSIT,ROR1) ;
+1 NEW CS,RORSEG
+2 DO ECH^RORHL7(.CS)
+3 ;
+4 ;--- Initialize the segment
+5 SET RORSEG(0)="OBX"
+6 ;
+7 ;--- OBX-2 - Value Type of OBX-5
+8 SET RORSEG(2)="FT"
+9 ;
+10 ;--- OBX-3 - 'SKIN TEST' name
+11 SET RORSEG(3)=CS_$GET(RORIDATA(9000010.12,ROR1_",",.01,"E"))
+12 ;
+13 ;--- OBX-5 - 'RESULTS'_CS_'READING'
+14 NEW TMP1,TMP2
+15 SET TMP1=$GET(RORIDATA(9000010.12,ROR1_",",.04,"I"))
+16 SET TMP2=$GET(RORIDATA(9000010.12,ROR1_",",.05,"I"))
+17 SET RORSEG(5)=$GET(TMP1)_CS_$GET(TMP2)
+18 ;
+19 ;--- OBX-14 - 'EVENT DATE AND TIME'
+20 NEW TMP1
SET TMP1=$GET(RORIDATA(9000010.12,ROR1_",",1201,"I"))
+21 IF $GET(TMP1)>0
SET RORSEG(14)=$$FM2HL^RORHL7(TMP1)
+22 ;
+23 ;--- OBX-19 - 'VISIT' DATE AND TIME
+24 ;convert to HL7 format
IF $GET(RORVSIT)>0
SET RORSEG(19)=$$FM2HL^RORHL7(RORVSIT)
+25 ;
+26 DO ADDSEG^RORHL7(.RORSEG)
+27 QUIT 0