source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL12.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1RORHL12 ;HOIFO/BH,SG - HL7 MICROBIOLOGY DATA: OBR ; 3/13/06 9:24am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #4335 $$GETDATA^LA7UTL1A (controlled)
7 ;
8 Q
9 ;
10 ;***** SEARCHES FOR MICROBIOLOGY DATA
11 ;
12 ; RORDFN IEN of the patient in the PATIENT file (#2)
13 ;
14 ; .DXDTS Reference to a local variable where the
15 ; data extraction time frames are stored.
16 ;
17 ; [CDSMODE] Search the data by:
18 ; 0 completion/result date (default)
19 ; 1 specimen collection date
20 ;
21 ; Return Values:
22 ; <0 Error code
23 ; 0 Ok
24 ; >0 Non-fatal error(s)
25 ;
26EN1(RORDFN,DXDTS,CDSMODE) ;
27 N ERRCNT,IDX,LRDFN,RC,RCL,RORENDT,RORMIIEN,RORREF,RORSTDT,RORTMP,TMP
28 S (ERRCNT,RC)=0
29 ;--- Check the parameters
30 S CDSMODE=$S($G(CDSMODE):"CD",1:"RAD")
31 ;
32 S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
33 S RORTMP=$$ALLOC^RORTMP()
34 ;
35 S IDX=0
36 F S IDX=$O(DXDTS(11,IDX)) Q:IDX'>0 D Q:RC<0
37 . S RORSTDT=$P(DXDTS(11,IDX),U),RORENDT=$P(DXDTS(11,IDX),U,2)
38 . K @RORTMP
39 . ;--- Get microbiology data
40 . S RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,CDSMODE,RORTMP)
41 . I RCL<0 D Q
42 . . S TMP="$$GETDATA^LA7UTL1A"
43 . . S RC=$$ERROR^RORERR(-56,,$P(RCL,U,2),RORDFN,+RCL,TMP)
44 . ;--- Process the data
45 . S RORMIIEN=""
46 . F S RORMIIEN=$O(@RORTMP@(LRDFN,RORMIIEN)) Q:RORMIIEN="" D
47 . . S RORREF=$NA(@RORTMP@(LRDFN,RORMIIEN))
48 . . ;---
49 . . S TMP=$$OBR(RORREF)
50 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
51 . . ;---
52 . . S TMP=$$OBX^RORHL121(RORREF)
53 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
54 ;
55 D FREE^RORTMP(RORTMP)
56 Q $S(RC<0:RC,1:ERRCNT)
57 ;
58 ;***** MICROBIOLOGY OBR SEGMENT BUILDER
59 ;
60 ; RORREF Global reference for MI entry
61 ;
62 ; Return Values:
63 ; <0 Error code
64 ; 0 Ok
65 ; >0 Non-fatal error(s)
66 ;
67OBR(RORREF) ;
68 N CS,ERRCNT,RC,RORSEG
69 S (ERRCNT,RC)=0
70 D ECH^RORHL7(.CS)
71 ;
72 ;--- Initialize the segment
73 S RORSEG(0)="OBR"
74 ;
75 ;--- OBR-3 - Accession Number
76 S TMP=$G(@RORREF@(0,.06,"I"))
77 I TMP="" D Q RC
78 . S RC=$$ERROR^RORERR(-100,,,,"No accession #","$$GETDATA^LA7UTL1A")
79 S RORSEG(3)=TMP
80 ;
81 ;--- OBR-4 - Universal Service ID
82 S RORSEG(4)="87999"_CS_"MICROBIOLOGY"_CS_"C4"
83 ;
84 ;--- OBR-7 - Accession Date
85 S TMP=$$FMTHL7^XLFDT($G(@RORREF@(0,.01,"I")))
86 I TMP'>0 D Q RC
87 . S RC=$$ERROR^RORERR(-100,,,,"No accession date","$$GETDATA^LA7UTL1A")
88 S RORSEG(7)=TMP
89 ;
90 ;--- OBR-11 - Urine Screen
91 S RORSEG(11)=$G(@RORREF@(0,11.57,"I"))
92 ;
93 ;--- OBR-13 - Site/Specimen
94 S RORSEG(13)=$$ESCAPE^RORHL7($G(@RORREF@(0,.05,"E")))
95 ;
96 ;--- OBR-20 - Collection Sample
97 S RORSEG(20)=$$ESCAPE^RORHL7($G(@RORREF@(0,.055,"E")))
98 ;
99 ;--- OBR-21 - Sputum Screen
100 S RORSEG(21)=$$ESCAPE^RORHL7($G(@RORREF@(0,11.58,"E")))
101 ;
102 ;--- OBR-24 - Diagnostic Service ID
103 S RORSEG(24)="MB"
104 ;
105 ;--- OBR-25 - Sterility Control
106 S TMP=$G(@RORREF@(0,11.51,"I"))
107 S RORSEG(25)=$S(TMP="P":"F",TMP="N":"R",1:"")
108 ;
109 ;--- OBR-44 - Division
110 S RORSEG(44)=$$SITE^RORUTL03(CS)
111 ;
112 ;--- Store the segment
113 D ADDSEG^RORHL7(.RORSEG)
114 Q ERRCNT
Note: See TracBrowser for help on using the repository browser.