Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHLUT1

RORHLUT1.m

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