| 1 | RORHLUT1 ;HCIOFO/SG - HL7 UTILITIES (HIGH LEVEL) ; 8/24/05 1:55pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** RETURNS A REASON WHY THE PATIENT HAS BEEN ADDED
|
|---|
| 7 | ;
|
|---|
| 8 | ; RORIENS IENS of Patient Record in Registry File
|
|---|
| 9 | ;
|
|---|
| 10 | ; CS HL7 component separator
|
|---|
| 11 | ;
|
|---|
| 12 | ADREASON(RORIENS,CS) ;
|
|---|
| 13 | N CODE,ICD9,LAB,NAME,NODE,IEN,RORMSG,TMP
|
|---|
| 14 | S (CODE,ICD9,LAB)=0
|
|---|
| 15 | S NODE=$$ROOT^DILFD(798.01,","_RORIENS,1)
|
|---|
| 16 | Q:NODE="" ""
|
|---|
| 17 | ;--- Check the names of selection rules
|
|---|
| 18 | S IEN=0
|
|---|
| 19 | F S IEN=$O(@NODE@("B",IEN)) Q:IEN'>0 D
|
|---|
| 20 | . S NAME=$$GET1^DIQ(798.2,IEN_",",.01,,,"RORMSG")
|
|---|
| 21 | . I $G(DIERR) D Q
|
|---|
| 22 | . . D DBS^RORERR("RORMSG",-9,,,798.2,IEN_",")
|
|---|
| 23 | . Q:$E(NAME,1,2)'="VA"
|
|---|
| 24 | . I NAME?1.E1" LAB" S LAB=1 Q
|
|---|
| 25 | . I NAME?1.E1" PROBLEM" S ICD9=1 Q
|
|---|
| 26 | . I NAME?1.E1" PTF".1" HIST" S ICD9=1 Q
|
|---|
| 27 | . I NAME?1.E1" VISIT".1" HIST" S ICD9=1 Q
|
|---|
| 28 | . I NAME?1.E1" VPOV" S ICD9=1 Q
|
|---|
| 29 | ;--- Check if the patient has been added automatically
|
|---|
| 30 | S NAME="Automatically Added - "
|
|---|
| 31 | I ICD9 S CODE=7,NAME=NAME_"ICD9"
|
|---|
| 32 | I LAB S CODE=8 D:ICD9 S NAME=NAME_"Lab"
|
|---|
| 33 | . S CODE=9,NAME=NAME_" and "
|
|---|
| 34 | ;---
|
|---|
| 35 | Q $S(CODE:CODE_CS_$$ESCAPE^RORHL7(NAME)_CS_"99VA799_1",1:"")
|
|---|
| 36 | ;
|
|---|
| 37 | ;***** RETURNS THE HL7 VALUE FOR THE DIVISION FIELD
|
|---|
| 38 | ;
|
|---|
| 39 | ; IEN44 IEN in the HOSPITAL LOCATION file (#44)
|
|---|
| 40 | ;
|
|---|
| 41 | ; [CS] Component separator ("^", by default))
|
|---|
| 42 | ;
|
|---|
| 43 | ; Return Values:
|
|---|
| 44 | ; "" Error
|
|---|
| 45 | ; '="" Value of the HL7 field
|
|---|
| 46 | ;
|
|---|
| 47 | DIV44(IEN44,CS) ;
|
|---|
| 48 | N DIV,IENS4,NAME,RORBUF,RORMSG,STN,TMP
|
|---|
| 49 | S:$G(CS)="" CS="^"
|
|---|
| 50 | S DIV=$$SITE^RORUTL03(CS)
|
|---|
| 51 | Q:IEN44'>0 DIV
|
|---|
| 52 | ;--- Get the pointer to the INSTITUTION file
|
|---|
| 53 | S IENS4=+$$GET1^DIQ(44,IEN44_",",3,"I",,"RORMSG")_","
|
|---|
| 54 | I $G(DIERR) D Q DIV
|
|---|
| 55 | . D DBS^RORERR("RORMSG",-9,,,44,IEN44_",")
|
|---|
| 56 | Q:IENS4'>0 DIV
|
|---|
| 57 | ;--- Load the station name and number
|
|---|
| 58 | D GETS^DIQ(4,IENS4,".01;99",,"RORBUF","RORMSG")
|
|---|
| 59 | I $G(DIERR) D Q DIV
|
|---|
| 60 | . D DBS^RORERR("RORMSG",-9,,,4,IENS4)
|
|---|
| 61 | S STN=$E($G(ROROUT(4,IENS4,99)),1,3)
|
|---|
| 62 | Q:STN="" DIV
|
|---|
| 63 | ;--- Construct the HL7 value
|
|---|
| 64 | S NAME=$$ESCAPE^RORHL7($G(RORBUF(4,IENS4,.01)))
|
|---|
| 65 | Q STN_CS_NAME_CS_"99VA4"
|
|---|
| 66 | ;
|
|---|
| 67 | ;***** STORES THE MULTILINE TEXT IN THE OBX SEGMENT
|
|---|
| 68 | ;
|
|---|
| 69 | ; NODE Closed root of the text
|
|---|
| 70 | ; OBX3 Segment identifier
|
|---|
| 71 | ;
|
|---|
| 72 | SETOBXWP(NODE,OBX3) ;
|
|---|
| 73 | N BR,CNT,I,I1,RORSEG,TMP
|
|---|
| 74 | S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
|
|---|
| 75 | Q:$D(@NODE)<10
|
|---|
| 76 | ;--- Initialize the segment
|
|---|
| 77 | S RORSEG(0)="OBX"
|
|---|
| 78 | ;--- OBX-2 - Value Type
|
|---|
| 79 | S RORSEG(2)="FT"
|
|---|
| 80 | ;--- OBX-3 - Observation Identifier
|
|---|
| 81 | S RORSEG(3)=OBX3
|
|---|
| 82 | ;--- OBX-5 - Observation Value
|
|---|
| 83 | S I=$O(@NODE@(0)),CNT=0
|
|---|
| 84 | F Q:I'>0 S I1=$O(@NODE@(I)) D S I=I1
|
|---|
| 85 | . S TMP=$$ESCAPE^RORHL7(@NODE@(I))
|
|---|
| 86 | . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1>0:TMP_BR,1:TMP)
|
|---|
| 87 | ;--- OBX-11 - Observation Result Status
|
|---|
| 88 | S RORSEG(11)="F"
|
|---|
| 89 | ;--- Store the segment
|
|---|
| 90 | D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
|
|---|
| 91 | Q
|
|---|
