Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL09.m
r613 r623 1 RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 3/13/06 9:24am 2 ;;1.5;CLINICAL CASE REGISTRIES;**1,5**;Feb 17, 2006;Build 10 3 ; 4 ; 11/29/2007 BAY/KAM ROR*1.5*5 Rem Call 218601 Correct Outpatient 5 ; CPTs not transmitting to the AAC 6 ; 7 ; This routine uses the following IAs: 8 ; 9 ; #93 Get stop code from the file #44 (controlled) 10 ; #1889 Use of the ENCEVENT^PXKENC API 11 ; #1995 $$CODEC^ICPTCOD (supported) 12 ; #2309 Read access to the 'AA' x-ref in VISIT file (#9000010) 13 ; #3990 $$CODEC^ICDCODE (supported) 14 ; #10060 Read access to the file #200 (supported) 15 ; #2438 Access to the file #40.8 (field #1) (controlled) 16 ; 17 Q 18 ; 19 ;***** PROCESSES DIAGNOSIS CODES 20 DIAGS() ; 21 N DIAG,IEN,K5,OID,REC,TMP 22 S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080" 23 S K5="" 24 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5)) Q:K5="" D 25 . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0) 26 . S IEN=+$P(REC,U) Q:IEN'>0 27 . ;--- 28 . S DIAG=$$CODEC^ICDCODE(IEN) 29 . D:DIAG'<0 SETOBX(OID,DIAG) 30 Q 0 31 ; 32 ;***** OUTPATIENT DATA SEGMENT BUILDER 33 ; 34 ; RORDFN DFN of Patient Record in File #2 35 ; 36 ; .DXDTS Reference to a local variable where the 37 ; data extraction time frames are stored. 38 ; 39 ; RORTY Set to either "PV1" or "OBR" 40 ; 41 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are 42 ; used by this function. 43 ; 44 ; Return Values: 45 ; <0 Error Code 46 ; 0 Ok 47 ; >0 Non-fatal error(s) 48 ; 49 EN1(RORDFN,DXDTS,RORTY) ; 50 N ERRCNT,PIEN,PV1CNT,RC 51 S (ERRCNT,RC)=0 52 ; 53 ;--- PV1 Segments 54 I RORTY="PV1" K ^TMP("PXKENC",$J),^TMP("RORHL09",$J) D 55 . N IDX,INVDT,ROREND 56 . S (IDX,PV1CNT)=0 57 . F S IDX=$O(DXDTS(2,IDX)) Q:IDX'>0 D Q:RC<0 58 . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1) 59 . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2) 60 . . F S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1) Q:'INVDT!(INVDT'>ROREND) D 61 . . . S PIEN="" 62 . . . F S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1) Q:'PIEN D 63 . . . . S TMP=$$PV1(PIEN,RORDFN) 64 . . . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 65 . . . . ;--- Reference for the corresponding OBR segment 66 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN 67 ; 68 ;--- OBR and OBX Segments 69 I RORTY="OBR" D K ^TMP("PXKENC",$J),^TMP("RORHL09",$J) 70 . S PV1CNT=0 71 . F S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT)) Q:PV1CNT'>0 D 72 . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT)) Q:PIEN'>0 73 . . ;--- 74 . . S TMP=$$OBR(PIEN,RORDFN) 75 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 76 . . ;--- 77 . . S TMP=$$OBX(PIEN,RORDFN) 78 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 79 ; 80 ;--- Check for errors 81 Q $S(RC<0:RC,1:ERRCNT) 82 ; 83 ;***** OBR SEGMENT BUILDER (OUTPATIENT) 84 ; 85 ; RORIEN IEN of file #9000010 86 ; RORDFN DFN of Patient Record in File #2 87 ; 88 ; Return Values: 89 ; <0 Error Code 90 ; 0 Ok 91 ; >0 Non-fatal error(s) 92 ; 93 OBR(RORIEN,RORDFN) ; 94 N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0 95 S (ERRCNT,RC)=0 96 D ECH^RORHL7(.CS) 97 ; 98 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0)) 99 ; 100 ;--- Initialize the segment 101 S RORSEG(0)="OBR" 102 ; 103 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010) 104 S RORSEG(3)=RORIEN 105 ; 106 ;--- OBR-4 - Universal Service ID 107 S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4" 108 ; 109 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY* 110 S TMP=$$FMTHL7^XLFDT($P(VST0,U)) 111 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC") 112 S RORSEG(7)=TMP 113 ; 114 ;--- OBR-24 - Diagnostic Service ID 115 S RORSEG(24)="PHY" 116 ; 117 ;--- OBR-44 - Division 118 S RORSEG(44)=$$SITE^RORUTL03(CS) 119 S TMP=+$P(VST0,U,6) ; LOC. OF ENCOUNTER (.06) 120 I TMP>0 D 121 . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2) 122 . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4" 123 ; 124 ;--- Store the segment 125 D ADDSEG^RORHL7(.RORSEG) 126 Q ERRCNT 127 ; 128 ;***** OBX SEGMENT BUILDER (OUTPATIENT) 129 ; 130 ; RORIEN IEN of file #9000010 131 ; RORDFN DFN of Patient Record in File #2 132 ; 133 ; Return Values: 134 ; <0 Error Code 135 ; 0 Ok 136 ; >0 Non-fatal error(s) 137 ; 138 OBX(RORIEN,RORDFN) ; 139 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP 140 S (ERRCNT,RC)=0 141 D ECH^RORHL7(.RORCS) 142 ; 143 ;--- Procedures 144 I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1 D Q:RC<0 RC 145 . S RC=$$PROCS() S:RC ERRCNT=ERRCNT+1 146 ;--- Diagnosis codes 147 I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1 D Q:RC<0 RC 148 . S RC=$$DIAGS() S:RC ERRCNT=ERRCNT+1 149 ; 150 Q ERRCNT 151 ; 152 ;***** PROCESSES PROCEDURES 153 PROCS() ; 154 N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP 155 S ERRCNT=0 156 S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080" 157 S K5="" 158 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5)) Q:K5="" D 159 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0)) 160 . S IEN=+$P(REC,U) Q:IEN'>0 161 . ;--- 162 . S PROC=$$CODEC^ICPTCOD(IEN) 163 . Q:PROC<0 164 . ;--- 165 . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4) 166 . ;12/06/2007 BAY/KAM REM CALL 218601 Modified next 8 lines 167 . ;--- 168 . I PRV>0 D 169 .. S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG") 170 .. I $G(DIERR) D S ERRCNT=ERRCNT+1 171 ... D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",") 172 . E S PRV="" 173 . ;----------> End of changes for 218601 174 . ;--- 175 . D SETOBX(OID,PROC,PRV) 176 Q ERRCNT 177 ; 178 ;***** PV1 SEGMENT BUILDER (OUTPATIENT) 179 ; 180 ; RORIEN IEN in the file #9000010 181 ; RORDFN DFN of Patient Record in File #2 182 ; 183 ; Return Values: 184 ; <0 Error Code 185 ; 0 Ok 186 ; "S" No visit data 187 ; >0 Non-fatal error(s) 188 ; 189 PV1(RORIEN,RORDFN) ; 190 N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0 191 S (ERRCNT,RC)=0 192 D ECH^RORHL7(.CS,,.REP) 193 ; 194 ;--- Get Visit Data 195 D ENCEVENT^PXKENC(RORIEN,1) 196 Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S" 197 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0)) 198 ; 199 ;--- Do not send visits with the following service categories: Daily 200 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N), 201 ; (E), Event Historical, Hospitalization (H). 202 Q:"HEDXNC"[$P(VST0,U,7) "S" 203 ; 204 ;--- Initialize the segment 205 S RORSEG(0)="PV1" 206 ; 207 ;--- PV1-2 - Patient Class 208 S RORSEG(2)="O" ; O - Outpatient 209 ; 210 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code) 211 S RORCLIN=+$P(VST0,U,22),BUF="" 212 I RORCLIN>0 D 213 . S IENS=RORCLIN_"," 214 . S TMP=$$GET1^DIQ(44,IENS,3.5,"I") Q:TMP'>0 215 . S BUF=$$GET1^DIQ(40.8,TMP,1) Q:BUF="" ; Station Number 216 . S TMP=$$STOPCODE^RORUTL18(+RORCLIN) 217 . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"") ; Stop Code 218 Q:$P(BUF,CS,6)="" "S" ; Stop Code is required 219 S RORSEG(3)=BUF 220 ; 221 ; PV1-4 - Admission Type 222 S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3) 223 S RORSEG(4)=TMP 224 ; 225 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name) 226 S (KK4,BUF)="" 227 F S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4)) Q:KK4="" D 228 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0)) 229 . S PRV=+$P(REC,U) Q:(PRV'>0)!($P(REC,U,4)'="P") 230 . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG") 231 . I $G(DIERR) D S ERRCNT=ERRCNT+1 232 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",") 233 . S BUF=BUF_REP_PRV 234 S RORSEG(7)=$P(BUF,REP,2,999) 235 ; 236 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY* 237 S RORSEG(19)=RORIEN 238 ; 239 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY* 240 S TMP=$$FMTHL7^XLFDT($P(VST0,U)) 241 I TMP'>0 D Q RC 242 . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC") 243 S RORSEG(44)=TMP 244 ; 245 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator) 246 S TMP=$P(VST0,U,11) 247 S RORSEG(51)=$S(TMP'="":TMP,1:0) 248 ; 249 ;--- Store the segment 250 D ADDSEG^RORHL7(.RORSEG) 251 Q ERRCNT 252 ; 253 ;***** LOW-LEVEL SEGMENT BUILDER 254 ; 255 ; OBX3 Observation Identifier 256 ; 257 ; OBX5 Observation Value 258 ; 259 ; [OBX16] Procedure Provider and Provider Class Name 260 ; 261 SETOBX(OBX3,OBX5,OBX16) ; 262 N RORSEG 263 S RORSEG(0)="OBX" 264 ;--- OBX-2 Value Type 265 S RORSEG(2)="FT" 266 ;--- OBX-3 Observation Identifier 267 S RORSEG(3)=OBX3 268 ;--- OBX-5 Observation Value 269 S RORSEG(5)=OBX5 270 ;--- OBX-11 Observation Result Status 271 S RORSEG(11)="F" 272 ;--- OBX-16 Responsible Observer (Procedure Provider) 273 S:$G(OBX16)'="" RORSEG(16)=OBX16 274 ;--- Store the segment 275 D ADDSEG^RORHL7(.RORSEG) 276 Q 1 RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 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 ; #93 Get stop code from the file #44 (controlled) 7 ; #1889 Use of the ENCEVENT^PXKENC API 8 ; #1995 $$CODEC^ICPTCOD (supported) 9 ; #2309 Read access to the 'AA' x-ref in VISIT file (#9000010) 10 ; #3990 $$CODEC^ICDCODE (supported) 11 ; #10060 Read access to the file #200 (supported) 12 ; #2438 Access to the file #40.8 (field #1) (controlled) 13 ; 14 Q 15 ; 16 ;***** PROCESSES DIAGNOSIS CODES 17 DIAGS() ; 18 N DIAG,IEN,K5,OID,REC,TMP 19 S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080" 20 S K5="" 21 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5)) Q:K5="" D 22 . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0) 23 . S IEN=+$P(REC,U) Q:IEN'>0 24 . ;--- 25 . S DIAG=$$CODEC^ICDCODE(IEN) 26 . D:DIAG'<0 SETOBX(OID,DIAG) 27 Q 0 28 ; 29 ;***** OUTPATIENT DATA SEGMENT BUILDER 30 ; 31 ; RORDFN DFN of Patient Record in File #2 32 ; 33 ; .DXDTS Reference to a local variable where the 34 ; data extraction time frames are stored. 35 ; 36 ; RORTY Set to either "PV1" or "OBR" 37 ; 38 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are 39 ; used by this function. 40 ; 41 ; Return Values: 42 ; <0 Error Code 43 ; 0 Ok 44 ; >0 Non-fatal error(s) 45 ; 46 EN1(RORDFN,DXDTS,RORTY) ; 47 N ERRCNT,PIEN,PV1CNT,RC 48 S (ERRCNT,RC)=0 49 ; 50 ;--- PV1 Segments 51 I RORTY="PV1" K ^TMP("PXKENC",$J),^TMP("RORHL09",$J) D 52 . N IDX,INVDT,ROREND 53 . S (IDX,PV1CNT)=0 54 . F S IDX=$O(DXDTS(2,IDX)) Q:IDX'>0 D Q:RC<0 55 . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1) 56 . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2) 57 . . F S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1) Q:'INVDT!(INVDT'>ROREND) D 58 . . . S PIEN="" 59 . . . F S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1) Q:'PIEN D 60 . . . . S TMP=$$PV1(PIEN,RORDFN) 61 . . . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 62 . . . . ;--- Reference for the corresponding OBR segment 63 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN 64 ; 65 ;--- OBR and OBX Segments 66 I RORTY="OBR" D K ^TMP("PXKENC",$J),^TMP("RORHL09",$J) 67 . S PV1CNT=0 68 . F S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT)) Q:PV1CNT'>0 D 69 . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT)) Q:PIEN'>0 70 . . ;--- 71 . . S TMP=$$OBR(PIEN,RORDFN) 72 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 73 . . ;--- 74 . . S TMP=$$OBX(PIEN,RORDFN) 75 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP 76 ; 77 ;--- Check for errors 78 Q $S(RC<0:RC,1:ERRCNT) 79 ; 80 ;***** OBR SEGMENT BUILDER (OUTPATIENT) 81 ; 82 ; RORIEN IEN of file #9000010 83 ; RORDFN DFN of Patient Record in File #2 84 ; 85 ; Return Values: 86 ; <0 Error Code 87 ; 0 Ok 88 ; >0 Non-fatal error(s) 89 ; 90 OBR(RORIEN,RORDFN) ; 91 N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0 92 S (ERRCNT,RC)=0 93 D ECH^RORHL7(.CS) 94 ; 95 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0)) 96 ; 97 ;--- Initialize the segment 98 S RORSEG(0)="OBR" 99 ; 100 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010) 101 S RORSEG(3)=RORIEN 102 ; 103 ;--- OBR-4 - Universal Service ID 104 S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4" 105 ; 106 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY* 107 S TMP=$$FMTHL7^XLFDT($P(VST0,U)) 108 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC") 109 S RORSEG(7)=TMP 110 ; 111 ;--- OBR-24 - Diagnostic Service ID 112 S RORSEG(24)="PHY" 113 ; 114 ;--- OBR-44 - Division 115 S RORSEG(44)=$$SITE^RORUTL03(CS) 116 S TMP=+$P(VST0,U,6) ; LOC. OF ENCOUNTER (.06) 117 I TMP>0 D 118 . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2) 119 . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4" 120 ; 121 ;--- Store the segment 122 D ADDSEG^RORHL7(.RORSEG) 123 Q ERRCNT 124 ; 125 ;***** OBX SEGMENT BUILDER (OUTPATIENT) 126 ; 127 ; RORIEN IEN of file #9000010 128 ; RORDFN DFN of Patient Record in File #2 129 ; 130 ; Return Values: 131 ; <0 Error Code 132 ; 0 Ok 133 ; >0 Non-fatal error(s) 134 ; 135 OBX(RORIEN,RORDFN) ; 136 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP 137 S (ERRCNT,RC)=0 138 D ECH^RORHL7(.RORCS) 139 ; 140 ;--- Procedures 141 I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1 D Q:RC<0 RC 142 . S RC=$$PROCS() S:RC ERRCNT=ERRCNT+1 143 ;--- Diagnosis codes 144 I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1 D Q:RC<0 RC 145 . S RC=$$DIAGS() S:RC ERRCNT=ERRCNT+1 146 ; 147 Q ERRCNT 148 ; 149 ;***** PROCESSES PROCEDURES 150 PROCS() ; 151 N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP 152 S ERRCNT=0 153 S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080" 154 S K5="" 155 F S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5)) Q:K5="" D 156 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0)) 157 . S IEN=+$P(REC,U) Q:IEN'>0 158 . ;--- 159 . S PROC=$$CODEC^ICPTCOD(IEN) 160 . Q:PROC<0 161 . ;--- 162 . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4) 163 . Q:PRV'>0 164 . ;--- 165 . S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG") 166 . I $G(DIERR) D S ERRCNT=ERRCNT+1 167 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",") 168 . ;--- 169 . D SETOBX(OID,PROC,PRV) 170 Q ERRCNT 171 ; 172 ;***** PV1 SEGMENT BUILDER (OUTPATIENT) 173 ; 174 ; RORIEN IEN in the file #9000010 175 ; RORDFN DFN of Patient Record in File #2 176 ; 177 ; Return Values: 178 ; <0 Error Code 179 ; 0 Ok 180 ; "S" No visit data 181 ; >0 Non-fatal error(s) 182 ; 183 PV1(RORIEN,RORDFN) ; 184 N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0 185 S (ERRCNT,RC)=0 186 D ECH^RORHL7(.CS,,.REP) 187 ; 188 ;--- Get Visit Data 189 D ENCEVENT^PXKENC(RORIEN,1) 190 Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S" 191 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0)) 192 ; 193 ;--- Do not send visits with the following service categories: Daily 194 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N), 195 ; (E), Event Historical, Hospitalization (H). 196 Q:"HEDXNC"[$P(VST0,U,7) "S" 197 ; 198 ;--- Initialize the segment 199 S RORSEG(0)="PV1" 200 ; 201 ;--- PV1-2 - Patient Class 202 S RORSEG(2)="O" ; O - Outpatient 203 ; 204 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code) 205 S RORCLIN=+$P(VST0,U,22),BUF="" 206 I RORCLIN>0 D 207 . S IENS=RORCLIN_"," 208 . S TMP=$$GET1^DIQ(44,IENS,3.5,"I") Q:TMP'>0 209 . S BUF=$$GET1^DIQ(40.8,TMP,1) Q:BUF="" ; Station Number 210 . S TMP=$$STOPCODE^RORUTL18(+RORCLIN) 211 . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"") ; Stop Code 212 Q:$P(BUF,CS,6)="" "S" ; Stop Code is required 213 S RORSEG(3)=BUF 214 ; 215 ; PV1-4 - Admission Type 216 S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3) 217 S RORSEG(4)=TMP 218 ; 219 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name) 220 S (KK4,BUF)="" 221 F S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4)) Q:KK4="" D 222 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0)) 223 . S PRV=+$P(REC,U) Q:(PRV'>0)!($P(REC,U,4)'="P") 224 . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG") 225 . I $G(DIERR) D S ERRCNT=ERRCNT+1 226 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",") 227 . S BUF=BUF_REP_PRV 228 S RORSEG(7)=$P(BUF,REP,2,999) 229 ; 230 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY* 231 S RORSEG(19)=RORIEN 232 ; 233 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY* 234 S TMP=$$FMTHL7^XLFDT($P(VST0,U)) 235 I TMP'>0 D Q RC 236 . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC") 237 S RORSEG(44)=TMP 238 ; 239 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator) 240 S TMP=$P(VST0,U,11) 241 S RORSEG(51)=$S(TMP'="":TMP,1:0) 242 ; 243 ;--- Store the segment 244 D ADDSEG^RORHL7(.RORSEG) 245 Q ERRCNT 246 ; 247 ;***** LOW-LEVEL SEGMENT BUILDER 248 ; 249 ; OBX3 Observation Identifier 250 ; 251 ; OBX5 Observation Value 252 ; 253 ; [OBX16] Procedure Provider and Provider Class Name 254 ; 255 SETOBX(OBX3,OBX5,OBX16) ; 256 N RORSEG 257 S RORSEG(0)="OBX" 258 ;--- OBX-2 Value Type 259 S RORSEG(2)="FT" 260 ;--- OBX-3 Observation Identifier 261 S RORSEG(3)=OBX3 262 ;--- OBX-5 Observation Value 263 S RORSEG(5)=OBX5 264 ;--- OBX-11 Observation Result Status 265 S RORSEG(11)="F" 266 ;--- OBX-16 Responsible Observer (Procedure Provider) 267 S:$G(OBX16)'="" RORSEG(16)=OBX16 268 ;--- Store the segment 269 D ADDSEG^RORHL7(.RORSEG) 270 Q
Note:
See TracChangeset
for help on using the changeset viewer.
