source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL06.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1RORHL06 ;HOIFO/BH,CRT - HL7 LIVER BIOPSY: OBR,OBX ; 3/13/06 9:23am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #1995 $$CPT^ICPTCOD (supported)
7 ; #10035 Read access to the PATIENT file (supported)
8 ;
9 Q
10 ;
11 ;***** SEARCHES FOR LIVER BIOPSY DATA
12 ;
13 ; RORDFN IEN of the patient in the PATIENT file (#2)
14 ;
15 ; RORSTDT Start Date (FileMan)
16 ; RORENDT End Date (FileMan)
17 ;
18 ; Return Values:
19 ; <0 Error code
20 ; 0 Ok
21 ; >0 Non-fatal error(s)
22 ;
23 ; The function uses the ^UTILITY($J,"W") global node.
24 ;
25EN1(RORDFN,RORSTDT,RORENDT) ;
26 N ERRCNT,FLDS,IDT,IENS,K5,LRDFN,QUIT,RC,SPECIMEN
27 S (ERRCNT,RC)=0
28 ;
29 ;--- Check if the patient exists
30 S RORDFN=+$G(RORDFN)
31 I '$D(^DPT(RORDFN)) D Q RC
32 . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
33 ;
34 S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
35 ;
36 S FLDS="1.1;1.4"
37 S RORENDT=$$INVDATE^RORUTL01(RORENDT)
38 S RORSTDT=$$INVDATE^RORUTL01(RORSTDT)
39 ;
40 S IDT=$O(^LR(LRDFN,"SP",RORSTDT))
41 F S IDT=$O(^LR(LRDFN,"SP",IDT),-1) Q:'IDT!(IDT'>RORENDT) D Q:RC<0
42 . S K5=0,QUIT=0
43 . F S K5=$O(^LR(LRDFN,"SP",IDT,.1,K5)) Q:'K5 D Q:QUIT!(RC<0)
44 . . S IENS=K5_","_IDT_","_LRDFN_","
45 . . S SPECIMEN=$$GET1^DIQ(63.812,IENS,.01,"E",,"RORMSG")
46 . . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
47 . . . D DBS^RORERR("RORMSG",-9,,,63.812,IENS)
48 . . I $$UP^XLFSTR(SPECIMEN)["LIVER" D
49 . . . S IENS=IDT_","_LRDFN_","
50 . . . S TMP=$$OBR(IENS)
51 . . . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
52 . . . S TMP=$$OBX(IENS,FLDS)
53 . . . I TMP S ERRCNT=ERRCNT+1 Q:TMP<0
54 . . . S QUIT=1
55 ;
56 Q $S(RC<0:RC,1:ERRCNT)
57 ;
58 ;***** LIVER BIOPSY OBR SEGMENT BUILDER
59 ;
60 ; RORIENS IENS of Liver Biopsy Record in File #63.08
61 ;
62 ; Return Values:
63 ; <0 Error code
64 ; 0 Ok
65 ; >0 Non-fatal error(s)
66 ;
67OBR(RORIENS) ;
68 N BUF,CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
69 S (ERRCNT,RC)=0
70 D ECH^RORHL7(.CS)
71 ;--- Check the parameters
72 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
73 ;
74 ;--- Load the data (with a temporary fix for invalid
75 ;--- output transform of the .01 field - ROR*1*8)
76 D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
77 I $G(DIERR) D S ERRCNT=ERRCNT+1
78 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
79 D GETS^DIQ(63.08,RORIENS,".06;.07;.08","IE","ROROUT","RORMSG")
80 I $G(DIERR) D S ERRCNT=ERRCNT+1
81 . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
82 ;
83 ;--- Initialize the segment
84 S RORSEG(0)="OBR"
85 ;
86 ;--- OBR-3 - Surgical Path Acc #
87 S RORSEG(3)=$G(ROROUT(63.08,RORIENS,.06,"E"))
88 ;
89 ;--- OBR-4 - Liver Biopsy CPT Code
90 S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
91 I TMP<0 D S ERRCNT=ERRCNT+1,TMP=""
92 . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
93 S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
94 S $P(BUF,CS,3)="C4"
95 S RORSEG(4)=BUF
96 ;
97 ;--- OBR-7 - Date/Time Specimen Taken
98 S TMP=$G(ROROUT(63.08,RORIENS,.01,"I"))
99 Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
100 S RORSEG(7)=$$FMTHL7^XLFDT(TMP)
101 ;
102 ;--- OBR-16 - Surgeon/Physician
103 S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
104 ;
105 ;--- OBR-24 - Service Section ID
106 S RORSEG(24)="SP"
107 ;
108 ;--- OBR-44 - Division
109 S TMP=$G(ROROUT(63.08,RORIENS,.08,"E"))
110 S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
111 S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
112 ;
113 ;--- Store the segment
114 D ADDSEG^RORHL7(.RORSEG)
115 Q $S(RC<0:RC,1:ERRCNT)
116 ;
117 ;***** LIVER BIOPSY OBX SEGMENT(S) BUILDER
118 ;
119 ; RORIENS IENS of Liver Biopsy Record in File #63.08
120 ; RORFLDS List of WP fields to return as OBX'es
121 ;
122 ; Return Values:
123 ; <0 Error code
124 ; 0 Ok
125 ; >0 Non-fatal error(s)
126 ;
127OBX(RORIENS,RORFLDS) ;
128 N BUF,CS,DIWF,DIWL,DIWR,ERRCNT,FLD,I,RORII,PZ,RC,RORMSG,ROROUT,RORRES,RORSEG,SCS,TMP,X
129 S (ERRCNT,RC)=0
130 D ECH^RORHL7(.CS,.SCS)
131 ;--- Check the parameters
132 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
133 ;
134 ;--- Load the data
135 D GETS^DIQ(63.08,RORIENS,RORFLDS,"EI","ROROUT","RORMSG")
136 I $G(DIERR) D S ERRCNT=ERRCNT+1
137 . D DBS^RORERR("RORMSG",-99,,,63.08,RORIENS)
138 ;
139 ;--- Initialize the segment
140 S RORSEG(0)="OBX"
141 ;
142 ;--- OBX-2
143 S RORSEG(2)="FT"
144 ;
145 ;--- OBX-11
146 S RORSEG(11)="F"
147 ;
148 F PZ=1:1 S FLD=$P(RORFLDS,";",PZ) Q:FLD="" D Q:RC<0
149 . S BUF=47000,TMP=$$CPT^ICPTCOD(BUF)
150 . I TMP<0 D S ERRCNT=ERRCNT+1,TMP=""
151 . . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
152 . S $P(BUF,SCS,2)=$$GET1^DID(63.08,FLD,,"LABEL",,"RORMSG")
153 . S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
154 . S $P(BUF,CS,3)="C4"
155 . S RORSEG(3)=BUF
156 . ;---
157 . K ^UTILITY($J,"W")
158 . S DIWL=1,DIWR=72
159 . S RORII=0
160 . F S RORII=$O(ROROUT(63.08,RORIENS,FLD,RORII)) Q:'RORII D
161 . . S X=ROROUT(63.08,RORIENS,FLD,RORII) D ^DIWP
162 . ;---
163 . S I=0
164 . F S I=$O(^UTILITY($J,"W",DIWL,I)) Q:'I D
165 . . S RORSEG(5)=$G(^UTILITY($J,"W",DIWL,I,0))
166 . . ;--- Store the segment
167 . . D ADDSEG^RORHL7(.RORSEG)
168 ;
169 Q $S(RC<0:RC,1:ERRCNT)
Note: See TracBrowser for help on using the repository browser.