RORHL121 ;HOIFO/BH - HL7 MICROBIOLOGY DATA: OBX ; 8/31/05 1:16pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
FUNGUS ;***** Process Fungus/Yeast
N FYIEN,RORFYIEN,RORFYID,RORFYCM
;
S RORFYID=$$SEGID("FUNG","Fungus-Yeast",CS)
S RORFYCM=$$SEGID("FUNGC","F-Y Comment",CS)
S RORFYIEN=""
F S RORFYIEN=$O(@RORREF@(9,RORFYIEN)) Q:'RORFYIEN D
. S TMP=$G(@RORREF@(9,RORFYIEN,0,.01,"E"))
. Q:TMP=""
. D SETOBX(RORFYID,,TMP,$G(@RORREF@(9,RORFYIEN,0,1,"I")))
. ;---
. S FYIEN=""
. F S FYIEN=$O(@RORREF@(9,RORFYIEN,1,FYIEN)) Q:FYIEN="" D
. . S TMP=$G(@RORREF@(9,RORFYIEN,1,FYIEN,0,.01,"E"))
. . D:TMP'="" SETOBX(RORFYCM,,TMP)
Q
;
BACSP ;***** Bacteriology Smear/Prep
;
N RORBSPID,RORBSP
S RORBSPID=$$SEGID("BACT-SP","Bact Smear/Prep",CS)
;
S RORBSP=""
F S RORBSP=$O(@RORREF@(25,RORBSP)) Q:'RORBSP D
. S TMP=$G(@RORREF@(25,RORBSP,0,.01,"E"))
. D:TMP'="" SETOBX(RORBSPID,,TMP)
Q
;
MYCO ;***** Mycobacterium
N RORMYD,RORMYD1,RORDF,RORDO,RORMYIEN,RORMYID,RORMYCM,MYIEN,RORMYF,RORMYO,TMP,TMP1
S RORMYID=$$SEGID("MYCO","Mycobacterium",CS)
S RORMYCM=$$SEGID("MYCOC","Myco Comment",CS)
S RORMYF=$$SEGID("MYCOAF","Myco Anti-F",CS)
S RORMYO=$$SEGID("MYCOAO","Myco Anti-O",CS)
;
S RORMYIEN=""
F S RORMYIEN=$O(@RORREF@(12,RORMYIEN)) Q:'RORMYIEN D
. S TMP=$G(@RORREF@(12,RORMYIEN,0,.01,"E"))
. Q:TMP=""
. D SETOBX(RORMYID,,TMP,$G(@RORREF@(12,RORMYIEN,0,1,"I")))
. ;---
. S MYIEN=""
. F S MYIEN=$O(@RORREF@(12,RORMYIEN,1,MYIEN)) Q:MYIEN="" D
. . S TMP=$G(@RORREF@(12,RORMYIEN,1,MYIEN,0,.01,"E"))
. . D:TMP'="" SETOBX(RORMYCM,,TMP)
. ;
. S RORMYD=2
. F S RORMYD=$O(@RORREF@(12,RORMYIEN,0,RORMYD)) Q:'RORMYD!(RORMYD'<3) D
. . S TMP=$G(@RORREF@(12,RORMYIEN,0,RORMYD,"I")) Q:TMP?."^"
. . D SETOBX(RORMYF,$P(TMP,U),$P(TMP,U,2))
. ;
. S RORMYD1=4
. F S RORMYD1=$O(@RORREF@(12,RORMYIEN,0,RORMYD1)) Q:'RORMYD1!(RORMYD1'<56) D
. . S TMP=$G(@RORREF@(12,RORMYIEN,0,RORMYD1,"I")) Q:TMP?."^"
. . D SETOBX(RORMYO,$P(TMP,U),$P(TMP,U,2))
Q
;
MYCOSP ;***** Mycology Smear Prep
;
N RORMSPID,RORMSPIN
S RORMSPID=$$SEGID("MYCO-SP","Mycology Smear/Prep",CS)
;
S RORMSPIN=""
F S RORMSPIN=$O(@RORREF@(15,RORMSPIN)) Q:'RORMSPIN D
. S TMP=$G(@RORREF@(15,RORMSPIN,0,.01,"E"))
. D:TMP'="" SETOBX(RORMSPID,,TMP)
Q
;
;***** MICROBIOLOGY OBX SEGMENT(S) BUILDER
;
; RORREF Global reference for MI entry
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORREF) ;
N CS,ERRCNT,RORTBST,IEN,RC,RORID,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Process TB data if Final report
S RORTBST=$G(@RORREF@(0,23,"I"))
I RORTBST="F" D
. N RORTBDTE,RORTBAFS,RORTBQTY
. S RORID=$$SEGID("AFB-SP","TB Report",CS)
. S RORTBDTE=$$FM2HL^RORHL7($G(@RORREF@(0,22,"I")))
. S RORTBAFS=$G(@RORREF@(0,24,"I"))
. S RORTBQTY=$G(@RORREF@(0,25,"I"))
. D SETOBX(RORID,,RORTBST,RORTBQTY,RORTBAFS,,RORTBDTE)
;
;--- Get Bact RPT Remark Data
S RORID=$$SEGID("BACT","Bact",CS)
S IEN=""
F S IEN=$O(@RORREF@(4,IEN)) Q:'IEN D
. S TMP=$G(@RORREF@(4,IEN,0,.01,"E"))
. D:TMP'="" SETOBX(RORID,,TMP)
;
;--- Get Gram Stain Data
S RORID=$$SEGID("GRAM","Gram Stain",CS)
S IEN=""
F S IEN=$O(@RORREF@(2,IEN)) Q:'IEN D
. S TMP=$G(@RORREF@(2,IEN,0,.01,"E"))
. D:TMP'="" SETOBX(RORID,,TMP)
;
D ORGDATA ; Organism Data
D PARDATA ; Parasite Data
D FUNGUS ; Fungus/Yeast Data
D MYCO ; Mycobacterium Data
D VIRUS ; Virus Data
D PARASP ; Parasitology Smear/Prep
D BACSP ; Bacteriology Smear/Prep
D MYCOSP ; Mycology Smear Prep
D VIRORPT ; Virology RPT Remark
;
;--- Parasite Remark
S RORID=$$SEGID("PARP","Parasite Remark",CS)
S IEN=""
F S IEN=$O(@RORREF@(7,IEN)) Q:IEN="" D
. S TMP=$G(@RORREF@(7,IEN,0,.01,"E"))
. D:TMP'="" SETOBX(RORID,,TMP)
;
;--- Specimen Comments
S TMP=$G(@RORREF@(0,.99,"E"))
I TMP'="" D D SETOBX(RORID,,TMP)
. S RORID=$$SEGID("COMP","Specimen Comment",CS)
;
Q $S(RC<0:RC,1:ERRCNT)
;
;***** PROCESSES ORGANISM DATA
ORGDATA ;
N IEN,RORANTID,RORCMID,RORID,RORMBC,RORMIC,RORORIEN,RORAINX,RORAINX1,RORANTIF,RORANTIO,TMP,TMP1
S RORID=$$SEGID("ORG","Organism",CS)
S RORCMID=$$SEGID("ORGC","Org Comment",CS)
S RORANTID=$$SEGID("ORGA","Org Antibiotic",CS)
S RORANTIF=$$SEGID("ORGAF","Org Antibiotic-F",CS)
S RORANTIO=$$SEGID("ORGAO","Org Antibiotic-O",CS)
;---
S RORORIEN=""
F S RORORIEN=$O(@RORREF@(3,RORORIEN)) Q:'RORORIEN D
. S TMP=$G(@RORREF@(3,RORORIEN,0,.01,"E"))
. Q:TMP=""
. D SETOBX(RORID,,TMP,$G(@RORREF@(3,RORORIEN,0,1,"I")))
. ;---
. S RORAINX=2
. F S RORAINX=$O(@RORREF@(3,RORORIEN,0,RORAINX)) Q:'RORAINX!(RORAINX'<3) D
. . S TMP=$G(@RORREF@(3,RORORIEN,0,RORAINX,"I")) Q:TMP?."^"
. . D SETOBX(RORANTIF,$P(TMP,U),$P(TMP,U,2))
. ;---
. S RORAINX1=10
. F S RORAINX1=$O(@RORREF@(3,RORORIEN,0,RORAINX1)) Q:'RORAINX1!(RORAINX1'<160) D
. . S TMP=$G(@RORREF@(3,RORORIEN,0,RORAINX1,"I")) Q:TMP?."^"
. . D SETOBX(RORANTIO,$P(TMP,U),$P(TMP,U,2))
. ;---
. S IEN=""
. F S IEN=$O(@RORREF@(3,RORORIEN,1,IEN)) Q:IEN="" D
. . S TMP=$G(@RORREF@(3,RORORIEN,1,IEN,0,.01,"E"))
. . D:TMP'="" SETOBX(RORCMID,,TMP)
. ;---
. S IEN=""
. F S IEN=$O(@RORREF@(3,RORORIEN,3,IEN)) Q:IEN="" D
. . S TMP=$G(@RORREF@(3,RORORIEN,3,IEN,0,.01,"E"))
. . Q:TMP=""
. . S RORMIC=$G(@RORREF@(3,RORORIEN,3,IEN,0,1,"E"))
. . S RORMBC=$G(@RORREF@(3,RORORIEN,3,IEN,0,2,"E"))
. . D SETOBX(RORANTID,,TMP,,RORMIC,RORMBC)
Q
;
PARASP ;***** Parasitology Smear/Prep
;
N RORPSPID,RORPSP
S RORPSPID=$$SEGID("PARA-SP","Para Smear/Prep",CS)
;
S RORPSP=""
F S RORPSP=$O(@RORREF@(24,RORPSP)) Q:'RORPSP D
. S TMP=$G(@RORREF@(24,RORPSP,0,.01,"E"))
. D:TMP'="" SETOBX(RORPSPID,,TMP)
Q
;
;***** PROCESSES PARASITE DATA
PARDATA ;
N IEN,RORPCMID,RORPSID,RORPSIEN,RORSTID,RORSTIEN,RORSTQAN,TMP
S RORPSID=$$SEGID("PAR","Parasite",CS)
S RORSTID=$$SEGID("PARQ","Stage",CS)
S RORPCMID=$$SEGID("PARC","Comment",CS)
;---
S RORPSIEN=""
F S RORPSIEN=$O(@RORREF@(6,RORPSIEN)) Q:RORPSIEN="" D
. S TMP=$G(@RORREF@(6,RORPSIEN,"0",".01","E"))
. Q:TMP=""
. D SETOBX(RORPSID,,TMP)
. ;---
. S RORSTIEN=""
. F S RORSTIEN=$O(@RORREF@(6,RORPSIEN,1,RORSTIEN)) Q:RORSTIEN="" D
. . S TMP=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,.01,"I"))
. . Q:TMP=""
. . S RORSTQAN=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,"1","E"))
. . D SETOBX(RORSTID,,TMP,RORSTQAN)
. . ;---
. . S IEN=""
. . F S IEN=$O(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN)) Q:IEN="" D
. . . S TMP=$G(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN,0,.01,"E"))
. . . D:TMP'="" SETOBX(RORPCMID,,TMP)
Q
;
;***** CREATES SEGMENT IDENTIFIER
SEGID(PONE,PTWO,CS) ;
Q PONE_CS_PTWO_CS_"VA080"
;
;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5,OBX6,OBX7,OBX13,OBX14) ;
N RORSEG
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2
S RORSEG(2)="FT"
;--- OBX-3
S RORSEG(3)=OBX3
;--- OBX-4, OBX-5, OBX-6, and OBX-7
S:$G(OBX4)'="" RORSEG(4)=$$ESCAPE^RORHL7(OBX4)
S:$G(OBX5)'="" RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
S:$G(OBX6)'="" RORSEG(6)=$$ESCAPE^RORHL7(OBX6)
S:$G(OBX7)'="" RORSEG(7)=$$ESCAPE^RORHL7(OBX7)
;--- OBX-11
S RORSEG(11)="F"
;--- OBX-13 and OBX-14
S:$G(OBX13)'="" RORSEG(13)=$$ESCAPE^RORHL7(OBX13)
S:$G(OBX14)'="" RORSEG(14)=OBX14
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
;
VIRORPT ;***** Virology RPT Remark
N RORVRID,RORVRIEN
S RORVRID=$$SEGID("VIRUSR","Virology RPT",CS)
;
S RORVRIEN=""
F S RORVRIEN=$O(@RORREF@(18,RORVRIEN)) Q:'RORVRIEN D
. S TMP=$G(@RORREF@(18,RORVRIEN,0,.01,"E"))
. D:TMP'="" SETOBX(RORVRID,,TMP)
Q
;
VIRUS ;***** Virus
;
N RORVIRID,RORVIIEN
S RORVIRID=$$SEGID("VIRUS","Virus",CS)
;
S RORVIIEN=""
F S RORVIIEN=$O(@RORREF@(17,RORVIIEN)) Q:'RORVIIEN D
. S TMP=$G(@RORREF@(17,RORVIIEN,0,.01,"E"))
. D:TMP'="" SETOBX(RORVIRID,,TMP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL121 7982 printed Apr 09, 2024@20:47:39 Page 2
RORHL121 ;HOIFO/BH - HL7 MICROBIOLOGY DATA: OBX ; 8/31/05 1:16pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
FUNGUS ;***** Process Fungus/Yeast
+1 NEW FYIEN,RORFYIEN,RORFYID,RORFYCM
+2 ;
+3 SET RORFYID=$$SEGID("FUNG","Fungus-Yeast",CS)
+4 SET RORFYCM=$$SEGID("FUNGC","F-Y Comment",CS)
+5 SET RORFYIEN=""
+6 FOR
SET RORFYIEN=$ORDER(@RORREF@(9,RORFYIEN))
if 'RORFYIEN
QUIT
Begin DoDot:1
+7 SET TMP=$GET(@RORREF@(9,RORFYIEN,0,.01,"E"))
+8 if TMP=""
QUIT
+9 DO SETOBX(RORFYID,,TMP,$GET(@RORREF@(9,RORFYIEN,0,1,"I")))
+10 ;---
+11 SET FYIEN=""
+12 FOR
SET FYIEN=$ORDER(@RORREF@(9,RORFYIEN,1,FYIEN))
if FYIEN=""
QUIT
Begin DoDot:2
+13 SET TMP=$GET(@RORREF@(9,RORFYIEN,1,FYIEN,0,.01,"E"))
+14 if TMP'=""
DO SETOBX(RORFYCM,,TMP)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
BACSP ;***** Bacteriology Smear/Prep
+1 ;
+2 NEW RORBSPID,RORBSP
+3 SET RORBSPID=$$SEGID("BACT-SP","Bact Smear/Prep",CS)
+4 ;
+5 SET RORBSP=""
+6 FOR
SET RORBSP=$ORDER(@RORREF@(25,RORBSP))
if 'RORBSP
QUIT
Begin DoDot:1
+7 SET TMP=$GET(@RORREF@(25,RORBSP,0,.01,"E"))
+8 if TMP'=""
DO SETOBX(RORBSPID,,TMP)
End DoDot:1
+9 QUIT
+10 ;
MYCO ;***** Mycobacterium
+1 NEW RORMYD,RORMYD1,RORDF,RORDO,RORMYIEN,RORMYID,RORMYCM,MYIEN,RORMYF,RORMYO,TMP,TMP1
+2 SET RORMYID=$$SEGID("MYCO","Mycobacterium",CS)
+3 SET RORMYCM=$$SEGID("MYCOC","Myco Comment",CS)
+4 SET RORMYF=$$SEGID("MYCOAF","Myco Anti-F",CS)
+5 SET RORMYO=$$SEGID("MYCOAO","Myco Anti-O",CS)
+6 ;
+7 SET RORMYIEN=""
+8 FOR
SET RORMYIEN=$ORDER(@RORREF@(12,RORMYIEN))
if 'RORMYIEN
QUIT
Begin DoDot:1
+9 SET TMP=$GET(@RORREF@(12,RORMYIEN,0,.01,"E"))
+10 if TMP=""
QUIT
+11 DO SETOBX(RORMYID,,TMP,$GET(@RORREF@(12,RORMYIEN,0,1,"I")))
+12 ;---
+13 SET MYIEN=""
+14 FOR
SET MYIEN=$ORDER(@RORREF@(12,RORMYIEN,1,MYIEN))
if MYIEN=""
QUIT
Begin DoDot:2
+15 SET TMP=$GET(@RORREF@(12,RORMYIEN,1,MYIEN,0,.01,"E"))
+16 if TMP'=""
DO SETOBX(RORMYCM,,TMP)
End DoDot:2
+17 ;
+18 SET RORMYD=2
+19 FOR
SET RORMYD=$ORDER(@RORREF@(12,RORMYIEN,0,RORMYD))
if 'RORMYD!(RORMYD'<3)
QUIT
Begin DoDot:2
+20 SET TMP=$GET(@RORREF@(12,RORMYIEN,0,RORMYD,"I"))
if TMP?."^"
QUIT
+21 DO SETOBX(RORMYF,$PIECE(TMP,U),$PIECE(TMP,U,2))
End DoDot:2
+22 ;
+23 SET RORMYD1=4
+24 FOR
SET RORMYD1=$ORDER(@RORREF@(12,RORMYIEN,0,RORMYD1))
if 'RORMYD1!(RORMYD1'<56)
QUIT
Begin DoDot:2
+25 SET TMP=$GET(@RORREF@(12,RORMYIEN,0,RORMYD1,"I"))
if TMP?."^"
QUIT
+26 DO SETOBX(RORMYO,$PIECE(TMP,U),$PIECE(TMP,U,2))
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
MYCOSP ;***** Mycology Smear Prep
+1 ;
+2 NEW RORMSPID,RORMSPIN
+3 SET RORMSPID=$$SEGID("MYCO-SP","Mycology Smear/Prep",CS)
+4 ;
+5 SET RORMSPIN=""
+6 FOR
SET RORMSPIN=$ORDER(@RORREF@(15,RORMSPIN))
if 'RORMSPIN
QUIT
Begin DoDot:1
+7 SET TMP=$GET(@RORREF@(15,RORMSPIN,0,.01,"E"))
+8 if TMP'=""
DO SETOBX(RORMSPID,,TMP)
End DoDot:1
+9 QUIT
+10 ;
+11 ;***** MICROBIOLOGY OBX SEGMENT(S) BUILDER
+12 ;
+13 ; RORREF Global reference for MI entry
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Ok
+18 ; >0 Non-fatal error(s)
+19 ;
OBX(RORREF) ;
+1 NEW CS,ERRCNT,RORTBST,IEN,RC,RORID,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Process TB data if Final report
+6 SET RORTBST=$GET(@RORREF@(0,23,"I"))
+7 IF RORTBST="F"
Begin DoDot:1
+8 NEW RORTBDTE,RORTBAFS,RORTBQTY
+9 SET RORID=$$SEGID("AFB-SP","TB Report",CS)
+10 SET RORTBDTE=$$FM2HL^RORHL7($GET(@RORREF@(0,22,"I")))
+11 SET RORTBAFS=$GET(@RORREF@(0,24,"I"))
+12 SET RORTBQTY=$GET(@RORREF@(0,25,"I"))
+13 DO SETOBX(RORID,,RORTBST,RORTBQTY,RORTBAFS,,RORTBDTE)
End DoDot:1
+14 ;
+15 ;--- Get Bact RPT Remark Data
+16 SET RORID=$$SEGID("BACT","Bact",CS)
+17 SET IEN=""
+18 FOR
SET IEN=$ORDER(@RORREF@(4,IEN))
if 'IEN
QUIT
Begin DoDot:1
+19 SET TMP=$GET(@RORREF@(4,IEN,0,.01,"E"))
+20 if TMP'=""
DO SETOBX(RORID,,TMP)
End DoDot:1
+21 ;
+22 ;--- Get Gram Stain Data
+23 SET RORID=$$SEGID("GRAM","Gram Stain",CS)
+24 SET IEN=""
+25 FOR
SET IEN=$ORDER(@RORREF@(2,IEN))
if 'IEN
QUIT
Begin DoDot:1
+26 SET TMP=$GET(@RORREF@(2,IEN,0,.01,"E"))
+27 if TMP'=""
DO SETOBX(RORID,,TMP)
End DoDot:1
+28 ;
+29 ; Organism Data
DO ORGDATA
+30 ; Parasite Data
DO PARDATA
+31 ; Fungus/Yeast Data
DO FUNGUS
+32 ; Mycobacterium Data
DO MYCO
+33 ; Virus Data
DO VIRUS
+34 ; Parasitology Smear/Prep
DO PARASP
+35 ; Bacteriology Smear/Prep
DO BACSP
+36 ; Mycology Smear Prep
DO MYCOSP
+37 ; Virology RPT Remark
DO VIRORPT
+38 ;
+39 ;--- Parasite Remark
+40 SET RORID=$$SEGID("PARP","Parasite Remark",CS)
+41 SET IEN=""
+42 FOR
SET IEN=$ORDER(@RORREF@(7,IEN))
if IEN=""
QUIT
Begin DoDot:1
+43 SET TMP=$GET(@RORREF@(7,IEN,0,.01,"E"))
+44 if TMP'=""
DO SETOBX(RORID,,TMP)
End DoDot:1
+45 ;
+46 ;--- Specimen Comments
+47 SET TMP=$GET(@RORREF@(0,.99,"E"))
+48 IF TMP'=""
Begin DoDot:1
+49 SET RORID=$$SEGID("COMP","Specimen Comment",CS)
End DoDot:1
DO SETOBX(RORID,,TMP)
+50 ;
+51 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+52 ;
+53 ;***** PROCESSES ORGANISM DATA
ORGDATA ;
+1 NEW IEN,RORANTID,RORCMID,RORID,RORMBC,RORMIC,RORORIEN,RORAINX,RORAINX1,RORANTIF,RORANTIO,TMP,TMP1
+2 SET RORID=$$SEGID("ORG","Organism",CS)
+3 SET RORCMID=$$SEGID("ORGC","Org Comment",CS)
+4 SET RORANTID=$$SEGID("ORGA","Org Antibiotic",CS)
+5 SET RORANTIF=$$SEGID("ORGAF","Org Antibiotic-F",CS)
+6 SET RORANTIO=$$SEGID("ORGAO","Org Antibiotic-O",CS)
+7 ;---
+8 SET RORORIEN=""
+9 FOR
SET RORORIEN=$ORDER(@RORREF@(3,RORORIEN))
if 'RORORIEN
QUIT
Begin DoDot:1
+10 SET TMP=$GET(@RORREF@(3,RORORIEN,0,.01,"E"))
+11 if TMP=""
QUIT
+12 DO SETOBX(RORID,,TMP,$GET(@RORREF@(3,RORORIEN,0,1,"I")))
+13 ;---
+14 SET RORAINX=2
+15 FOR
SET RORAINX=$ORDER(@RORREF@(3,RORORIEN,0,RORAINX))
if 'RORAINX!(RORAINX'<3)
QUIT
Begin DoDot:2
+16 SET TMP=$GET(@RORREF@(3,RORORIEN,0,RORAINX,"I"))
if TMP?."^"
QUIT
+17 DO SETOBX(RORANTIF,$PIECE(TMP,U),$PIECE(TMP,U,2))
End DoDot:2
+18 ;---
+19 SET RORAINX1=10
+20 FOR
SET RORAINX1=$ORDER(@RORREF@(3,RORORIEN,0,RORAINX1))
if 'RORAINX1!(RORAINX1'<160)
QUIT
Begin DoDot:2
+21 SET TMP=$GET(@RORREF@(3,RORORIEN,0,RORAINX1,"I"))
if TMP?."^"
QUIT
+22 DO SETOBX(RORANTIO,$PIECE(TMP,U),$PIECE(TMP,U,2))
End DoDot:2
+23 ;---
+24 SET IEN=""
+25 FOR
SET IEN=$ORDER(@RORREF@(3,RORORIEN,1,IEN))
if IEN=""
QUIT
Begin DoDot:2
+26 SET TMP=$GET(@RORREF@(3,RORORIEN,1,IEN,0,.01,"E"))
+27 if TMP'=""
DO SETOBX(RORCMID,,TMP)
End DoDot:2
+28 ;---
+29 SET IEN=""
+30 FOR
SET IEN=$ORDER(@RORREF@(3,RORORIEN,3,IEN))
if IEN=""
QUIT
Begin DoDot:2
+31 SET TMP=$GET(@RORREF@(3,RORORIEN,3,IEN,0,.01,"E"))
+32 if TMP=""
QUIT
+33 SET RORMIC=$GET(@RORREF@(3,RORORIEN,3,IEN,0,1,"E"))
+34 SET RORMBC=$GET(@RORREF@(3,RORORIEN,3,IEN,0,2,"E"))
+35 DO SETOBX(RORANTID,,TMP,,RORMIC,RORMBC)
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
PARASP ;***** Parasitology Smear/Prep
+1 ;
+2 NEW RORPSPID,RORPSP
+3 SET RORPSPID=$$SEGID("PARA-SP","Para Smear/Prep",CS)
+4 ;
+5 SET RORPSP=""
+6 FOR
SET RORPSP=$ORDER(@RORREF@(24,RORPSP))
if 'RORPSP
QUIT
Begin DoDot:1
+7 SET TMP=$GET(@RORREF@(24,RORPSP,0,.01,"E"))
+8 if TMP'=""
DO SETOBX(RORPSPID,,TMP)
End DoDot:1
+9 QUIT
+10 ;
+11 ;***** PROCESSES PARASITE DATA
PARDATA ;
+1 NEW IEN,RORPCMID,RORPSID,RORPSIEN,RORSTID,RORSTIEN,RORSTQAN,TMP
+2 SET RORPSID=$$SEGID("PAR","Parasite",CS)
+3 SET RORSTID=$$SEGID("PARQ","Stage",CS)
+4 SET RORPCMID=$$SEGID("PARC","Comment",CS)
+5 ;---
+6 SET RORPSIEN=""
+7 FOR
SET RORPSIEN=$ORDER(@RORREF@(6,RORPSIEN))
if RORPSIEN=""
QUIT
Begin DoDot:1
+8 SET TMP=$GET(@RORREF@(6,RORPSIEN,"0",".01","E"))
+9 if TMP=""
QUIT
+10 DO SETOBX(RORPSID,,TMP)
+11 ;---
+12 SET RORSTIEN=""
+13 FOR
SET RORSTIEN=$ORDER(@RORREF@(6,RORPSIEN,1,RORSTIEN))
if RORSTIEN=""
QUIT
Begin DoDot:2
+14 SET TMP=$GET(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,.01,"I"))
+15 if TMP=""
QUIT
+16 SET RORSTQAN=$GET(@RORREF@(6,RORPSIEN,1,RORSTIEN,0,"1","E"))
+17 DO SETOBX(RORSTID,,TMP,RORSTQAN)
+18 ;---
+19 SET IEN=""
+20 FOR
SET IEN=$ORDER(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN))
if IEN=""
QUIT
Begin DoDot:3
+21 SET TMP=$GET(@RORREF@(6,RORPSIEN,1,RORSTIEN,1,IEN,0,.01,"E"))
+22 if TMP'=""
DO SETOBX(RORPCMID,,TMP)
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ;***** CREATES SEGMENT IDENTIFIER
SEGID(PONE,PTWO,CS) ;
+1 QUIT PONE_CS_PTWO_CS_"VA080"
+2 ;
+3 ;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5,OBX6,OBX7,OBX13,OBX14) ;
+1 NEW RORSEG
+2 ;--- Initialize the segment
+3 SET RORSEG(0)="OBX"
+4 ;--- OBX-2
+5 SET RORSEG(2)="FT"
+6 ;--- OBX-3
+7 SET RORSEG(3)=OBX3
+8 ;--- OBX-4, OBX-5, OBX-6, and OBX-7
+9 if $GET(OBX4)'=""
SET RORSEG(4)=$$ESCAPE^RORHL7(OBX4)
+10 if $GET(OBX5)'=""
SET RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
+11 if $GET(OBX6)'=""
SET RORSEG(6)=$$ESCAPE^RORHL7(OBX6)
+12 if $GET(OBX7)'=""
SET RORSEG(7)=$$ESCAPE^RORHL7(OBX7)
+13 ;--- OBX-11
+14 SET RORSEG(11)="F"
+15 ;--- OBX-13 and OBX-14
+16 if $GET(OBX13)'=""
SET RORSEG(13)=$$ESCAPE^RORHL7(OBX13)
+17 if $GET(OBX14)'=""
SET RORSEG(14)=OBX14
+18 ;--- Store the segment
+19 DO ADDSEG^RORHL7(.RORSEG)
+20 QUIT
+21 ;
VIRORPT ;***** Virology RPT Remark
+1 NEW RORVRID,RORVRIEN
+2 SET RORVRID=$$SEGID("VIRUSR","Virology RPT",CS)
+3 ;
+4 SET RORVRIEN=""
+5 FOR
SET RORVRIEN=$ORDER(@RORREF@(18,RORVRIEN))
if 'RORVRIEN
QUIT
Begin DoDot:1
+6 SET TMP=$GET(@RORREF@(18,RORVRIEN,0,.01,"E"))
+7 if TMP'=""
DO SETOBX(RORVRID,,TMP)
End DoDot:1
+8 QUIT
+9 ;
VIRUS ;***** Virus
+1 ;
+2 NEW RORVIRID,RORVIIEN
+3 SET RORVIRID=$$SEGID("VIRUS","Virus",CS)
+4 ;
+5 SET RORVIIEN=""
+6 FOR
SET RORVIIEN=$ORDER(@RORREF@(17,RORVIIEN))
if 'RORVIIEN
QUIT
Begin DoDot:1
+7 SET TMP=$GET(@RORREF@(17,RORVIIEN,0,.01,"E"))
+8 if TMP'=""
DO SETOBX(RORVIRID,,TMP)
End DoDot:1
+9 QUIT
