- 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 Jan 18, 2025@02:43:11 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