source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHLUT1.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1RORHLUT1 ;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 ;
12ADREASON(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 ;
47DIV44(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 ;
72SETOBXWP(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
Note: See TracBrowser for help on using the repository browser.