- RORHLUT1 ;HCIOFO/SG - HL7 UTILITIES (HIGH LEVEL) ;8/24/05 1:55pm
- ;;1.5;CLINICAL CASE REGISTRIES;**19**;Feb 17, 2006;Build 43
- ;
- ; This routine uses the following IAs:
- ; #5747 $$CSI^ICDEX (controlled)
- ; #5747 $$SNAM^ICDEX (controlled)
- ;
- ;******************************************************************************
- ;******************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- ----------------------------------------
- ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
- ;
- ;******************************************************************************
- ;******************************************************************************
- ;
- Q
- ;
- ;***** RETURNS A REASON WHY THE PATIENT HAS BEEN ADDED
- ;
- ; RORIENS IENS of Patient Record in Registry File
- ;
- ; CS HL7 component separator
- ;
- ADREASON(RORIENS,CS) ;
- N CODE,ICD,LAB,NAME,NODE,IEN,RORMSG,TMP,RORCODSYS,RORRULEIEN
- S (CODE,ICD,LAB)=0
- S NODE=$$ROOT^DILFD(798.01,","_RORIENS,1)
- Q:NODE="" ""
- ;--- Check the names of selection rules
- S IEN=0
- F S IEN=$O(@NODE@("B",IEN)) Q:IEN'>0 D
- . S NAME=$$GET1^DIQ(798.2,IEN_",",.01,,,"RORMSG")
- . I $G(DIERR) D Q
- . . D DBS^RORERR("RORMSG",-9,,,798.2,IEN_",")
- . Q:$E(NAME,1,2)'="VA"
- . I NAME?1.E1" LAB" S LAB=1 Q
- . I NAME?1.E1" PROBLEM".1" (ICD10)" S ICD=1,RORRULEIEN=IEN Q
- . I NAME?1.E1" PTF".1" HIST".1" (ICD10)" S ICD=1,RORRULEIEN=IEN Q
- . I NAME?1.E1" VISIT".1" HIST" S ICD=1,RORRULEIEN=IEN Q
- . I NAME?1.E1" VPOV".1" (ICD10)" S ICD=1,RORRULEIEN=IEN Q
- ;--- Check if the patient has been added automatically
- S NAME="Automatically Added - "
- I ICD D
- . S RORCODSYS=+$$GET1^DIQ(798.2,RORRULEIEN_",",7,"I")
- . S CODE=$S(RORCODSYS=30:10,1:7)
- . S NAME=NAME_$S(RORCODSYS=30:"ICD10",1:"ICD9")
- I LAB D
- . S CODE=8
- . I ICD D
- . . S CODE=$S(RORCODSYS=30:11,1:9)
- . . S NAME=NAME_" and "
- . S NAME=NAME_"Lab"
- ;---
- Q $S(CODE:CODE_CS_$$ESCAPE^RORHL7(NAME)_CS_"99VA799_1",1:"")
- ;
- ;***** RETURNS THE HL7 VALUE FOR THE DIVISION FIELD
- ;
- ; IEN44 IEN in the HOSPITAL LOCATION file (#44)
- ;
- ; [CS] Component separator ("^", by default))
- ;
- ; Return Values:
- ; "" Error
- ; '="" Value of the HL7 field
- ;
- DIV44(IEN44,CS) ;
- N DIV,IENS4,NAME,RORBUF,RORMSG,STN,TMP
- S:$G(CS)="" CS="^"
- S DIV=$$SITE^RORUTL03(CS)
- Q:IEN44'>0 DIV
- ;--- Get the pointer to the INSTITUTION file
- S IENS4=+$$GET1^DIQ(44,IEN44_",",3,"I",,"RORMSG")_","
- I $G(DIERR) D Q DIV
- . D DBS^RORERR("RORMSG",-9,,,44,IEN44_",")
- Q:IENS4'>0 DIV
- ;--- Load the station name and number
- D GETS^DIQ(4,IENS4,".01;99",,"RORBUF","RORMSG")
- I $G(DIERR) D Q DIV
- . D DBS^RORERR("RORMSG",-9,,,4,IENS4)
- S STN=$E($G(ROROUT(4,IENS4,99)),1,3)
- Q:STN="" DIV
- ;--- Construct the HL7 value
- S NAME=$$ESCAPE^RORHL7($G(RORBUF(4,IENS4,.01)))
- Q STN_CS_NAME_CS_"99VA4"
- ;
- ;***** STORES THE MULTILINE TEXT IN THE OBX SEGMENT
- ;
- ; NODE Closed root of the text
- ; OBX3 Segment identifier
- ;
- SETOBXWP(NODE,OBX3) ;
- N BR,CNT,I,I1,RORSEG,TMP
- S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
- Q:$D(@NODE)<10
- ;--- 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 I=$O(@NODE@(0)),CNT=0
- F Q:I'>0 S I1=$O(@NODE@(I)) D S I=I1
- . S TMP=$$ESCAPE^RORHL7(@NODE@(I))
- . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1>0:TMP_BR,1:TMP)
- ;--- OBX-11 - Observation Result Status
- S RORSEG(11)="F"
- ;--- Store the segment
- D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
- Q
- ;
- ;***** RETURNS THE CODING SYSTEM NAME FOR A ICD OR PROCEDURE CODE
- ;
- ; RORFILE FILE #80 or #80.1
- ; RORICDIEN IEN of the #80 or #80.1
- ;
- ; Return Values:
- ; "" if error Or not found
- ; coding system name
- ;
- CSNAME(RORFILE,RORICDIEN) ;
- Q:$G(RORICDIEN)="" ""
- N RORICDSNAM,RORICDSYS
- S RORICDSYS=$$CSI^ICDEX(RORFILE,RORICDIEN)
- S RORICDSNAM=$$SNAM^ICDEX(RORICDSYS)
- S:RORICDSNAM=-1 RORICDSNAM=""
- Q RORICDSNAM
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHLUT1 4253 printed Jan 18, 2025@02:43:23 Page 2
- RORHLUT1 ;HCIOFO/SG - HL7 UTILITIES (HIGH LEVEL) ;8/24/05 1:55pm
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**19**;Feb 17, 2006;Build 43
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; #5747 $$CSI^ICDEX (controlled)
- +5 ; #5747 $$SNAM^ICDEX (controlled)
- +6 ;
- +7 ;******************************************************************************
- +8 ;******************************************************************************
- +9 ; --- ROUTINE MODIFICATION LOG ---
- +10 ;
- +11 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +12 ;----------- ---------- ----------- ----------------------------------------
- +13 ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
- +14 ;
- +15 ;******************************************************************************
- +16 ;******************************************************************************
- +17 ;
- +18 QUIT
- +19 ;
- +20 ;***** RETURNS A REASON WHY THE PATIENT HAS BEEN ADDED
- +21 ;
- +22 ; RORIENS IENS of Patient Record in Registry File
- +23 ;
- +24 ; CS HL7 component separator
- +25 ;
- ADREASON(RORIENS,CS) ;
- +1 NEW CODE,ICD,LAB,NAME,NODE,IEN,RORMSG,TMP,RORCODSYS,RORRULEIEN
- +2 SET (CODE,ICD,LAB)=0
- +3 SET NODE=$$ROOT^DILFD(798.01,","_RORIENS,1)
- +4 if NODE=""
- QUIT ""
- +5 ;--- Check the names of selection rules
- +6 SET IEN=0
- +7 FOR
- SET IEN=$ORDER(@NODE@("B",IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +8 SET NAME=$$GET1^DIQ(798.2,IEN_",",.01,,,"RORMSG")
- +9 IF $GET(DIERR)
- Begin DoDot:2
- +10 DO DBS^RORERR("RORMSG",-9,,,798.2,IEN_",")
- End DoDot:2
- QUIT
- +11 if $EXTRACT(NAME,1,2)'="VA"
- QUIT
- +12 IF NAME?1.E1" LAB"
- SET LAB=1
- QUIT
- +13 IF NAME?1.E1" PROBLEM".1" (ICD10)"
- SET ICD=1
- SET RORRULEIEN=IEN
- QUIT
- +14 IF NAME?1.E1" PTF".1" HIST".1" (ICD10)"
- SET ICD=1
- SET RORRULEIEN=IEN
- QUIT
- +15 IF NAME?1.E1" VISIT".1" HIST"
- SET ICD=1
- SET RORRULEIEN=IEN
- QUIT
- +16 IF NAME?1.E1" VPOV".1" (ICD10)"
- SET ICD=1
- SET RORRULEIEN=IEN
- QUIT
- End DoDot:1
- +17 ;--- Check if the patient has been added automatically
- +18 SET NAME="Automatically Added - "
- +19 IF ICD
- Begin DoDot:1
- +20 SET RORCODSYS=+$$GET1^DIQ(798.2,RORRULEIEN_",",7,"I")
- +21 SET CODE=$SELECT(RORCODSYS=30:10,1:7)
- +22 SET NAME=NAME_$SELECT(RORCODSYS=30:"ICD10",1:"ICD9")
- End DoDot:1
- +23 IF LAB
- Begin DoDot:1
- +24 SET CODE=8
- +25 IF ICD
- Begin DoDot:2
- +26 SET CODE=$SELECT(RORCODSYS=30:11,1:9)
- +27 SET NAME=NAME_" and "
- End DoDot:2
- +28 SET NAME=NAME_"Lab"
- End DoDot:1
- +29 ;---
- +30 QUIT $SELECT(CODE:CODE_CS_$$ESCAPE^RORHL7(NAME)_CS_"99VA799_1",1:"")
- +31 ;
- +32 ;***** RETURNS THE HL7 VALUE FOR THE DIVISION FIELD
- +33 ;
- +34 ; IEN44 IEN in the HOSPITAL LOCATION file (#44)
- +35 ;
- +36 ; [CS] Component separator ("^", by default))
- +37 ;
- +38 ; Return Values:
- +39 ; "" Error
- +40 ; '="" Value of the HL7 field
- +41 ;
- DIV44(IEN44,CS) ;
- +1 NEW DIV,IENS4,NAME,RORBUF,RORMSG,STN,TMP
- +2 if $GET(CS)=""
- SET CS="^"
- +3 SET DIV=$$SITE^RORUTL03(CS)
- +4 if IEN44'>0
- QUIT DIV
- +5 ;--- Get the pointer to the INSTITUTION file
- +6 SET IENS4=+$$GET1^DIQ(44,IEN44_",",3,"I",,"RORMSG")_","
- +7 IF $GET(DIERR)
- Begin DoDot:1
- +8 DO DBS^RORERR("RORMSG",-9,,,44,IEN44_",")
- End DoDot:1
- QUIT DIV
- +9 if IENS4'>0
- QUIT DIV
- +10 ;--- Load the station name and number
- +11 DO GETS^DIQ(4,IENS4,".01;99",,"RORBUF","RORMSG")
- +12 IF $GET(DIERR)
- Begin DoDot:1
- +13 DO DBS^RORERR("RORMSG",-9,,,4,IENS4)
- End DoDot:1
- QUIT DIV
- +14 SET STN=$EXTRACT($GET(ROROUT(4,IENS4,99)),1,3)
- +15 if STN=""
- QUIT DIV
- +16 ;--- Construct the HL7 value
- +17 SET NAME=$$ESCAPE^RORHL7($GET(RORBUF(4,IENS4,.01)))
- +18 QUIT STN_CS_NAME_CS_"99VA4"
- +19 ;
- +20 ;***** STORES THE MULTILINE TEXT IN THE OBX SEGMENT
- +21 ;
- +22 ; NODE Closed root of the text
- +23 ; OBX3 Segment identifier
- +24 ;
- SETOBXWP(NODE,OBX3) ;
- +1 NEW BR,CNT,I,I1,RORSEG,TMP
- +2 SET BR=$EXTRACT(HLECH,3)_".br"_$EXTRACT(HLECH,3)
- +3 if $DATA(@NODE)<10
- QUIT
- +4 ;--- Initialize the segment
- +5 SET RORSEG(0)="OBX"
- +6 ;--- OBX-2 - Value Type
- +7 SET RORSEG(2)="FT"
- +8 ;--- OBX-3 - Observation Identifier
- +9 SET RORSEG(3)=OBX3
- +10 ;--- OBX-5 - Observation Value
- +11 SET I=$ORDER(@NODE@(0))
- SET CNT=0
- +12 FOR
- if I'>0
- QUIT
- SET I1=$ORDER(@NODE@(I))
- Begin DoDot:1
- +13 SET TMP=$$ESCAPE^RORHL7(@NODE@(I))
- +14 SET CNT=CNT+1
- SET RORSEG(5,CNT)=$SELECT(I1>0:TMP_BR,1:TMP)
- End DoDot:1
- SET I=I1
- +15 ;--- OBX-11 - Observation Result Status
- +16 SET RORSEG(11)="F"
- +17 ;--- Store the segment
- +18 if $DATA(RORSEG(5))
- DO ADDSEG^RORHL7(.RORSEG)
- +19 QUIT
- +20 ;
- +21 ;***** RETURNS THE CODING SYSTEM NAME FOR A ICD OR PROCEDURE CODE
- +22 ;
- +23 ; RORFILE FILE #80 or #80.1
- +24 ; RORICDIEN IEN of the #80 or #80.1
- +25 ;
- +26 ; Return Values:
- +27 ; "" if error Or not found
- +28 ; coding system name
- +29 ;
- CSNAME(RORFILE,RORICDIEN) ;
- +1 if $GET(RORICDIEN)=""
- QUIT ""
- +2 NEW RORICDSNAM,RORICDSYS
- +3 SET RORICDSYS=$$CSI^ICDEX(RORFILE,RORICDIEN)
- +4 SET RORICDSNAM=$$SNAM^ICDEX(RORICDSYS)
- +5 if RORICDSNAM=-1
- SET RORICDSNAM=""
- +6 QUIT RORICDSNAM