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 Apr 09, 2024@20:48:09 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
