RORHL081 ;HOIFO/BH - HL7 INPATIENT DATA: OBX ;10/27/05 12:32pm
;;1.5;CLINICAL CASE REGISTRIES;**19,25**;Feb 17, 2006;Build 19
;
; This routine uses the following IAs:
;
; #92 Read access to the PTF file (Controlled)
; #6130 PTFICD^DGPTFUT
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
;ROR*1.5*25 OCT 2014 T KOPP Support for expanded # of PTF diagnoses
; and procedures for ICD-10
;
;******************************************************************************
;******************************************************************************
Q
;
;***** BED SECTION (501 segment)
BEDSEC(RORIEN) ;
N DATE,ERRCNT,FLD,IEN4502,IENS,NODE,OID,RORBS,RORBSED,RORBSSD,RORBUF,RORIBUF,RORCODE,RORMSG,TMP,RORICDSNAM,DIERR
S ERRCNT=0
S OID="INBED"_RORCS_"Bedsection Diagnosis"_RORCS_"VA080"
S NODE=$$ROOT^DILFD(45.02,","_RORIEN_",",1)
;---
S DATE=$$GET1^DIQ(45,RORIEN_",",2,"I",,"RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-99,,RORDFN,45,RORIEN_",")
S (RORBSSD,RORBSED)=$$FM2HL^RORHL7(DATE)
;
S DATE=""
F S DATE=$O(@NODE@("AM",DATE)) Q:DATE="" D
. S IEN4502=0
. F S IEN4502=$O(@NODE@("AM",DATE,IEN4502)) Q:IEN4502'>0 D
. . S RORBSSD=RORBSED K RORBUF
. . S IENS=IEN4502_","_RORIEN_","
. . ;--- Load the data
. . D GETS^DIQ(45.02,IENS,"2;10","EI","RORBUF","RORMSG")
. . I $G(DIERR) D S ERRCNT=ERRCNT+1
. . . D DBS^RORERR("RORMSG",-99,,RORDFN,45.02,IENS)
. . ;--- Name of the bed section
. . S RORBS=$$ESCAPE^RORHL7($G(RORBUF(45.02,IENS,2,"E")))
. . ;--- End date
. . S RORBSED=$$FM2HL^RORHL7($G(RORBUF(45.02,IENS,10,"I")))
. . ;--- ICD codes
. . S (RORCODE,RORICDSNAM)=""
. . D GETICD(501,RORIEN,IEN4502,"",.RORCODE,.RORICDSNAM)
. . ;--- Store the segment (if there is at least one ICD code)
. . D:RORCODE'="" SETOBX(OID,RORICDSNAM_":"_RORCODE,RORBS,RORBSED,RORBSSD)
;
Q ERRCNT
;
;***** DISCHARGE DIAGNOSIS CODES (701 segment)
DDIAG(RORIEN) ;
N ERRCNT,FLD,IFL,OID,RORIBUF,RORDDIAG,TMP,RORICDSNAM
S ERRCNT=0,OID="INDIS"_RORCS_"Discharge Diagnosis"_RORCS_"VA080"
;--- ICD codes
S (RORDDIAG,RORICDSNAM)=""
D GETICD(701,RORIEN,"",0,.RORDDIAG,.RORICDSNAM)
;--- Store the segment (if there is at least one ICD code)
D:RORDDIAG'="" SETOBX(OID,RORICDSNAM_":"_RORDDIAG)
Q ERRCNT
;
;***** OBX SEGMENT(S) BUILDER (INPATIENT)
;
; RORIEN IEN of file #45
; RORDFN DFN of Patient Record in File #2
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORIEN,RORDFN) ;
N ERRCNT,RC,RORCS,RORLST,RORMSG,RORRS,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.RORCS,,.RORRS)
;
;--- Principal diagnosis
S RC=$$PRIN(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;--- Primary discharge diagnosis
S RC=$$PDISCH(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;--- Discharge diagnosis codes
S RC=$$DDIAG(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;--- Bed section
S RC=$$BEDSEC(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;--- Surgical procedures
S RC=$$SURGPRO(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;--- Other diagnoses
S RC=$$OTRPROC(RORIEN)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;
Q ERRCNT
;
;***** OTHER DIAGNOSES
OTRPROC(RORIEN) ;
N ERRCNT,FLD,IEN4505,IENS,IFL,NODE,OID,RORBUF,RORMSG,ROROPBS,ROROPCD,ROROPDTE,TMP,RORICDSNAM
S ERRCNT=0
S OID="INOTR"_RORCS_"Other Diagnosis"_RORCS_"VA080"
S NODE=$$ROOT^DILFD(45.05,","_RORIEN_",",1)
;
S IEN4505=0
F S IEN4505=$O(@NODE@(IEN4505)) Q:IEN4505'>0 D
. S IENS=IEN4505_","_RORIEN_"," K RORBUF
. ;--- Load the data
. D GETS^DIQ(45.05,IENS,".01;1;","EI","RORBUF","RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
. . D DBS^RORERR("RORMSG",-99,,RORDFN,45.05,IENS)
. ;--- Name of the facility
. S ROROPBS=$$ESCAPE^RORHL7($G(RORBUF(45.05,IENS,1,"E")))
. ;--- Date of the procedure
. S ROROPDTE=$$FM2HL^RORHL7($G(RORBUF(45.05,IENS,.01,"I")))
. ;--- ICD codes
. S (ROROPCD,RORICDSNAM)=""
. D GETICD(601,RORIEN,IEN4505,"",.ROROPCD,.RORICDSNAM)
. ;--- Store the segment (if there is at least one ICD code)
. D:ROROPCD'="" SETOBX(OID,RORICDSNAM_":"_ROROPCD,ROROPBS,,ROROPDTE)
;
Q ERRCNT
;
;***** PRIMARY DISCHARGE DIAGNOSIS
PDISCH(IEN) ;
N ERRCNT,OID,RORDD,RORMSG,TMP,RORICDSNAM,RORBUF
S ERRCNT=0,OID="INPRI"_RORCS_"Primary Dis. Diagnosis"_RORCS_"VA080"
;--- Load the data
S IEN=IEN_","
D GETS^DIQ(45,IEN,79,"EI","RORBUF","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
S RORDD=$G(RORBUF(45,IEN,79,"E"))
;--- Store the segment
I RORDD'="" D
. S RORICDSNAM=$$CSNAME^RORHLUT1(80,$G(RORBUF(45,IEN,79,"I")))
. D SETOBX(OID,RORICDSNAM_":"_RORDD)
Q ERRCNT
;
;***** PRINCIPAL DIAGNOSIS
PRIN(IEN) ;
N ERRCNT,OID,RORMSG,RORPDIAG,TMP,RORICDSNAM,RORBUF,RORFLD
S ERRCNT=0,OID="INAD"_RORCS_"Admitting Diagnosis"_RORCS_"VA080"
;--- Load the data
S IEN=IEN_","
D GETS^DIQ(45,IEN,79,"EI","RORBUF","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
S RORPDIAG=$G(RORBUF(45,IEN,79,"E")),RORFLD=79
; Look at pre-1986 Dx only if PRIMARY DIAGNOSIS is missing
I RORPDIAG="" D
. K RORBUF,RORMSG
. D GETS^DIQ(45,IEN,80,"EI","RORBUF","RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
.. D DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
. S RORPDIAG=$G(RORBUF(45,IEN,80,"E")),RORFLD=80
;--- Store the segment
I RORPDIAG'="" D
. S RORICDSNAM=$$CSNAME^RORHLUT1(80,$G(RORBUF(45,IEN,RORFLD,"I")))
. D SETOBX(OID,RORICDSNAM_":"_RORPDIAG)
Q ERRCNT
;
;***** LOW-LEVEL SEGMENT BUILDER
;
; OBX3 Observation Identifier
;
; OBX5 Observation Value
;
; [OBX6] Bed Section
;
; [OBX12] Bed Section End Date/Time
;
; [OBX14] Bed Section Start Date, if OBX3 contains
; "INBED^Bedsection Diagnosis";
; Surgical Procedure Date, if OBX3 contains
; "INSURG^Surgical Procedures";
; Other Procedure Date, if OBX3 contains
; "INOTR^Other Diagnosis".
;
SETOBX(OBX3,OBX5,OBX6,OBX12,OBX14) ;
N RORSEG
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-6 Bed Section
S:$G(OBX6)'="" RORSEG(6)=OBX6
;--- OBX-11 Observation Result Status
S RORSEG(11)="F"
;--- OBX-12 Bed Section End Date/Time
S:$G(OBX12)'="" RORSEG(12)=OBX12
;--- OBX-14 Bed Section Start Date/Time or Procedure Date
S:$G(OBX14)'="" RORSEG(14)=OBX14
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
;
;***** SURGICAL PROCEDURES (401 segment)
SURGPRO(RORIEN) ;
N ERRCNT,FLD,IEN4501,IENS,IFL,NODE,OID,RORBUF,RORIBUF,RORMSG,SDTE,SPCD,TMP,RORICDSNAM
S ERRCNT=0
;S SPFLST="8;9;10;11;12"
S OID="INSURG"_RORCS_"Surgical Procedures"_RORCS_"VA080"
S NODE=$$ROOT^DILFD(45.01,","_RORIEN_",",1)
;
S IEN4501=0
F S IEN4501=$O(@NODE@(IEN4501)) Q:IEN4501'>0 D
. S IENS=IEN4501_","_RORIEN_"," K RORBUF
. ;--- Load the data
. D GETS^DIQ(45.01,IENS,".01;","EI","RORBUF","RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1
. . D DBS^RORERR("RORMSG",-99,,RORDFN,45.01,IENS)
. ;--- Date of the procedure
. S SDTE=$$FM2HL^RORHL7($G(RORBUF(45.01,IENS,.01,"I")))
. ;--- Procedure codes
. S (SPCD,RORICDSNAM)="",IFL=0
. D GETICD(401,RORIEN,IEN4501,"",.SPCD,.RORICDSNAM)
. ;--- Store the segment (if there is at least one code)
. D:SPCD'="" SETOBX(OID,RORICDSNAM_":"_SPCD,,,SDTE)
;
Q ERRCNT
;
GETICD(RORSEG,RORIEN,RORIEN1,RORSTART,RORCODE,RORICDSNAM) ; Extract Dx or proc
N RORIBUF,IFL,FLD,TMP
;--- Get ICD codes
D PTFICD^DGPTFUT(RORSEG,RORIEN,RORIEN1,.RORIBUF)
S (RORCODE,RORICDSNAM)="",IFL=0
S FLD=$G(RORSTART) F S FLD=$O(RORIBUF(FLD)) Q:FLD="" I $G(RORIBUF(FLD))'="" D
. S TMP=$P(RORIBUF(FLD),U,3) Q:TMP=""
. S IFL=IFL+1,$P(RORCODE,RORRS,IFL)=TMP
. S:RORICDSNAM="" RORICDSNAM=$$CSNAME^RORHLUT1(80,$P(RORIBUF(FLD),U))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL081 8450 printed Sep 23, 2025@19:17:52 Page 2
RORHL081 ;HOIFO/BH - HL7 INPATIENT DATA: OBX ;10/27/05 12:32pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**19,25**;Feb 17, 2006;Build 19
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #92 Read access to the PTF file (Controlled)
+6 ; #6130 PTFICD^DGPTFUT
+7 ;
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
+15 ;ROR*1.5*25 OCT 2014 T KOPP Support for expanded # of PTF diagnoses
+16 ; and procedures for ICD-10
+17 ;
+18 ;******************************************************************************
+19 ;******************************************************************************
+20 QUIT
+21 ;
+22 ;***** BED SECTION (501 segment)
BEDSEC(RORIEN) ;
+1 NEW DATE,ERRCNT,FLD,IEN4502,IENS,NODE,OID,RORBS,RORBSED,RORBSSD,RORBUF,RORIBUF,RORCODE,RORMSG,TMP,RORICDSNAM,DIERR
+2 SET ERRCNT=0
+3 SET OID="INBED"_RORCS_"Bedsection Diagnosis"_RORCS_"VA080"
+4 SET NODE=$$ROOT^DILFD(45.02,","_RORIEN_",",1)
+5 ;---
+6 SET DATE=$$GET1^DIQ(45,RORIEN_",",2,"I",,"RORMSG")
+7 IF $GET(DIERR)
Begin DoDot:1
+8 DO DBS^RORERR("RORMSG",-99,,RORDFN,45,RORIEN_",")
End DoDot:1
SET ERRCNT=ERRCNT+1
+9 SET (RORBSSD,RORBSED)=$$FM2HL^RORHL7(DATE)
+10 ;
+11 SET DATE=""
+12 FOR
SET DATE=$ORDER(@NODE@("AM",DATE))
if DATE=""
QUIT
Begin DoDot:1
+13 SET IEN4502=0
+14 FOR
SET IEN4502=$ORDER(@NODE@("AM",DATE,IEN4502))
if IEN4502'>0
QUIT
Begin DoDot:2
+15 SET RORBSSD=RORBSED
KILL RORBUF
+16 SET IENS=IEN4502_","_RORIEN_","
+17 ;--- Load the data
+18 DO GETS^DIQ(45.02,IENS,"2;10","EI","RORBUF","RORMSG")
+19 IF $GET(DIERR)
Begin DoDot:3
+20 DO DBS^RORERR("RORMSG",-99,,RORDFN,45.02,IENS)
End DoDot:3
SET ERRCNT=ERRCNT+1
+21 ;--- Name of the bed section
+22 SET RORBS=$$ESCAPE^RORHL7($GET(RORBUF(45.02,IENS,2,"E")))
+23 ;--- End date
+24 SET RORBSED=$$FM2HL^RORHL7($GET(RORBUF(45.02,IENS,10,"I")))
+25 ;--- ICD codes
+26 SET (RORCODE,RORICDSNAM)=""
+27 DO GETICD(501,RORIEN,IEN4502,"",.RORCODE,.RORICDSNAM)
+28 ;--- Store the segment (if there is at least one ICD code)
+29 if RORCODE'=""
DO SETOBX(OID,RORICDSNAM_":"_RORCODE,RORBS,RORBSED,RORBSSD)
End DoDot:2
End DoDot:1
+30 ;
+31 QUIT ERRCNT
+32 ;
+33 ;***** DISCHARGE DIAGNOSIS CODES (701 segment)
DDIAG(RORIEN) ;
+1 NEW ERRCNT,FLD,IFL,OID,RORIBUF,RORDDIAG,TMP,RORICDSNAM
+2 SET ERRCNT=0
SET OID="INDIS"_RORCS_"Discharge Diagnosis"_RORCS_"VA080"
+3 ;--- ICD codes
+4 SET (RORDDIAG,RORICDSNAM)=""
+5 DO GETICD(701,RORIEN,"",0,.RORDDIAG,.RORICDSNAM)
+6 ;--- Store the segment (if there is at least one ICD code)
+7 if RORDDIAG'=""
DO SETOBX(OID,RORICDSNAM_":"_RORDDIAG)
+8 QUIT ERRCNT
+9 ;
+10 ;***** OBX SEGMENT(S) BUILDER (INPATIENT)
+11 ;
+12 ; RORIEN IEN of file #45
+13 ; RORDFN DFN of Patient Record in File #2
+14 ;
+15 ; Return Values:
+16 ; <0 Error Code
+17 ; 0 Ok
+18 ; >0 Non-fatal error(s)
+19 ;
OBX(RORIEN,RORDFN) ;
+1 NEW ERRCNT,RC,RORCS,RORLST,RORMSG,RORRS,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.RORCS,,.RORRS)
+4 ;
+5 ;--- Principal diagnosis
+6 SET RC=$$PRIN(RORIEN)
+7 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+8 ;--- Primary discharge diagnosis
+9 SET RC=$$PDISCH(RORIEN)
+10 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+11 ;--- Discharge diagnosis codes
+12 SET RC=$$DDIAG(RORIEN)
+13 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+14 ;--- Bed section
+15 SET RC=$$BEDSEC(RORIEN)
+16 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+17 ;--- Surgical procedures
+18 SET RC=$$SURGPRO(RORIEN)
+19 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+20 ;--- Other diagnoses
+21 SET RC=$$OTRPROC(RORIEN)
+22 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+23 ;
+24 QUIT ERRCNT
+25 ;
+26 ;***** OTHER DIAGNOSES
OTRPROC(RORIEN) ;
+1 NEW ERRCNT,FLD,IEN4505,IENS,IFL,NODE,OID,RORBUF,RORMSG,ROROPBS,ROROPCD,ROROPDTE,TMP,RORICDSNAM
+2 SET ERRCNT=0
+3 SET OID="INOTR"_RORCS_"Other Diagnosis"_RORCS_"VA080"
+4 SET NODE=$$ROOT^DILFD(45.05,","_RORIEN_",",1)
+5 ;
+6 SET IEN4505=0
+7 FOR
SET IEN4505=$ORDER(@NODE@(IEN4505))
if IEN4505'>0
QUIT
Begin DoDot:1
+8 SET IENS=IEN4505_","_RORIEN_","
KILL RORBUF
+9 ;--- Load the data
+10 DO GETS^DIQ(45.05,IENS,".01;1;","EI","RORBUF","RORMSG")
+11 IF $GET(DIERR)
Begin DoDot:2
+12 DO DBS^RORERR("RORMSG",-99,,RORDFN,45.05,IENS)
End DoDot:2
SET ERRCNT=ERRCNT+1
+13 ;--- Name of the facility
+14 SET ROROPBS=$$ESCAPE^RORHL7($GET(RORBUF(45.05,IENS,1,"E")))
+15 ;--- Date of the procedure
+16 SET ROROPDTE=$$FM2HL^RORHL7($GET(RORBUF(45.05,IENS,.01,"I")))
+17 ;--- ICD codes
+18 SET (ROROPCD,RORICDSNAM)=""
+19 DO GETICD(601,RORIEN,IEN4505,"",.ROROPCD,.RORICDSNAM)
+20 ;--- Store the segment (if there is at least one ICD code)
+21 if ROROPCD'=""
DO SETOBX(OID,RORICDSNAM_":"_ROROPCD,ROROPBS,,ROROPDTE)
End DoDot:1
+22 ;
+23 QUIT ERRCNT
+24 ;
+25 ;***** PRIMARY DISCHARGE DIAGNOSIS
PDISCH(IEN) ;
+1 NEW ERRCNT,OID,RORDD,RORMSG,TMP,RORICDSNAM,RORBUF
+2 SET ERRCNT=0
SET OID="INPRI"_RORCS_"Primary Dis. Diagnosis"_RORCS_"VA080"
+3 ;--- Load the data
+4 SET IEN=IEN_","
+5 DO GETS^DIQ(45,IEN,79,"EI","RORBUF","RORMSG")
+6 IF $GET(DIERR)
Begin DoDot:1
+7 DO DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
End DoDot:1
SET ERRCNT=ERRCNT+1
+8 SET RORDD=$GET(RORBUF(45,IEN,79,"E"))
+9 ;--- Store the segment
+10 IF RORDD'=""
Begin DoDot:1
+11 SET RORICDSNAM=$$CSNAME^RORHLUT1(80,$GET(RORBUF(45,IEN,79,"I")))
+12 DO SETOBX(OID,RORICDSNAM_":"_RORDD)
End DoDot:1
+13 QUIT ERRCNT
+14 ;
+15 ;***** PRINCIPAL DIAGNOSIS
PRIN(IEN) ;
+1 NEW ERRCNT,OID,RORMSG,RORPDIAG,TMP,RORICDSNAM,RORBUF,RORFLD
+2 SET ERRCNT=0
SET OID="INAD"_RORCS_"Admitting Diagnosis"_RORCS_"VA080"
+3 ;--- Load the data
+4 SET IEN=IEN_","
+5 DO GETS^DIQ(45,IEN,79,"EI","RORBUF","RORMSG")
+6 IF $GET(DIERR)
Begin DoDot:1
+7 DO DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
End DoDot:1
SET ERRCNT=ERRCNT+1
+8 SET RORPDIAG=$GET(RORBUF(45,IEN,79,"E"))
SET RORFLD=79
+9 ; Look at pre-1986 Dx only if PRIMARY DIAGNOSIS is missing
+10 IF RORPDIAG=""
Begin DoDot:1
+11 KILL RORBUF,RORMSG
+12 DO GETS^DIQ(45,IEN,80,"EI","RORBUF","RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:2
+14 DO DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN)
End DoDot:2
SET ERRCNT=ERRCNT+1
+15 SET RORPDIAG=$GET(RORBUF(45,IEN,80,"E"))
SET RORFLD=80
End DoDot:1
+16 ;--- Store the segment
+17 IF RORPDIAG'=""
Begin DoDot:1
+18 SET RORICDSNAM=$$CSNAME^RORHLUT1(80,$GET(RORBUF(45,IEN,RORFLD,"I")))
+19 DO SETOBX(OID,RORICDSNAM_":"_RORPDIAG)
End DoDot:1
+20 QUIT ERRCNT
+21 ;
+22 ;***** LOW-LEVEL SEGMENT BUILDER
+23 ;
+24 ; OBX3 Observation Identifier
+25 ;
+26 ; OBX5 Observation Value
+27 ;
+28 ; [OBX6] Bed Section
+29 ;
+30 ; [OBX12] Bed Section End Date/Time
+31 ;
+32 ; [OBX14] Bed Section Start Date, if OBX3 contains
+33 ; "INBED^Bedsection Diagnosis";
+34 ; Surgical Procedure Date, if OBX3 contains
+35 ; "INSURG^Surgical Procedures";
+36 ; Other Procedure Date, if OBX3 contains
+37 ; "INOTR^Other Diagnosis".
+38 ;
SETOBX(OBX3,OBX5,OBX6,OBX12,OBX14) ;
+1 NEW RORSEG
+2 SET RORSEG(0)="OBX"
+3 ;--- OBX-2 Value Type
+4 SET RORSEG(2)="FT"
+5 ;--- OBX-3 Observation Identifier
+6 SET RORSEG(3)=OBX3
+7 ;--- OBX-5 Observation Value
+8 SET RORSEG(5)=OBX5
+9 ;--- OBX-6 Bed Section
+10 if $GET(OBX6)'=""
SET RORSEG(6)=OBX6
+11 ;--- OBX-11 Observation Result Status
+12 SET RORSEG(11)="F"
+13 ;--- OBX-12 Bed Section End Date/Time
+14 if $GET(OBX12)'=""
SET RORSEG(12)=OBX12
+15 ;--- OBX-14 Bed Section Start Date/Time or Procedure Date
+16 if $GET(OBX14)'=""
SET RORSEG(14)=OBX14
+17 ;--- Store the segment
+18 DO ADDSEG^RORHL7(.RORSEG)
+19 QUIT
+20 ;
+21 ;***** SURGICAL PROCEDURES (401 segment)
SURGPRO(RORIEN) ;
+1 NEW ERRCNT,FLD,IEN4501,IENS,IFL,NODE,OID,RORBUF,RORIBUF,RORMSG,SDTE,SPCD,TMP,RORICDSNAM
+2 SET ERRCNT=0
+3 ;S SPFLST="8;9;10;11;12"
+4 SET OID="INSURG"_RORCS_"Surgical Procedures"_RORCS_"VA080"
+5 SET NODE=$$ROOT^DILFD(45.01,","_RORIEN_",",1)
+6 ;
+7 SET IEN4501=0
+8 FOR
SET IEN4501=$ORDER(@NODE@(IEN4501))
if IEN4501'>0
QUIT
Begin DoDot:1
+9 SET IENS=IEN4501_","_RORIEN_","
KILL RORBUF
+10 ;--- Load the data
+11 DO GETS^DIQ(45.01,IENS,".01;","EI","RORBUF","RORMSG")
+12 IF $GET(DIERR)
Begin DoDot:2
+13 DO DBS^RORERR("RORMSG",-99,,RORDFN,45.01,IENS)
End DoDot:2
SET ERRCNT=ERRCNT+1
+14 ;--- Date of the procedure
+15 SET SDTE=$$FM2HL^RORHL7($GET(RORBUF(45.01,IENS,.01,"I")))
+16 ;--- Procedure codes
+17 SET (SPCD,RORICDSNAM)=""
SET IFL=0
+18 DO GETICD(401,RORIEN,IEN4501,"",.SPCD,.RORICDSNAM)
+19 ;--- Store the segment (if there is at least one code)
+20 if SPCD'=""
DO SETOBX(OID,RORICDSNAM_":"_SPCD,,,SDTE)
End DoDot:1
+21 ;
+22 QUIT ERRCNT
+23 ;
GETICD(RORSEG,RORIEN,RORIEN1,RORSTART,RORCODE,RORICDSNAM) ; Extract Dx or proc
+1 NEW RORIBUF,IFL,FLD,TMP
+2 ;--- Get ICD codes
+3 DO PTFICD^DGPTFUT(RORSEG,RORIEN,RORIEN1,.RORIBUF)
+4 SET (RORCODE,RORICDSNAM)=""
SET IFL=0
+5 SET FLD=$GET(RORSTART)
FOR
SET FLD=$ORDER(RORIBUF(FLD))
if FLD=""
QUIT
IF $GET(RORIBUF(FLD))'=""
Begin DoDot:1
+6 SET TMP=$PIECE(RORIBUF(FLD),U,3)
if TMP=""
QUIT
+7 SET IFL=IFL+1
SET $PIECE(RORCODE,RORRS,IFL)=TMP
+8 if RORICDSNAM=""
SET RORICDSNAM=$$CSNAME^RORHLUT1(80,$PIECE(RORIBUF(FLD),U))
End DoDot:1
+9 QUIT
+10 ;
