RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 3/13/06 9:24am
 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
 ;
 ; This routine uses the following IAs:
 ;
 ; #93       Get stop code from the file #44 (controlled)
 ; #1889     Use of the ENCEVENT^PXKENC API
 ; #1995     $$CODEC^ICPTCOD (supported)
 ; #2309     Read access to the 'AA' x-ref in VISIT file (#9000010)
 ; #3990     $$CODEC^ICDCODE (supported)
 ; #10060    Read access to the file #200 (supported)
 ; #2438     Access to the file #40.8 (field #1) (controlled)
 ;
 Q
 ;
 ;***** PROCESSES DIAGNOSIS CODES
DIAGS() ;
 N DIAG,IEN,K5,OID,REC,TMP
 S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080"
 S K5=""
 F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5))  Q:K5=""  D
 . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0)
 . S IEN=+$P(REC,U)  Q:IEN'>0
 . ;---
 . S DIAG=$$CODEC^ICDCODE(IEN)
 . D:DIAG'<0 SETOBX(OID,DIAG)
 Q 0
 ;
 ;***** OUTPATIENT DATA SEGMENT BUILDER
 ;
 ; RORDFN        DFN of Patient Record in File #2
 ;
 ; .DXDTS        Reference to a local variable where the
 ;               data extraction time frames are stored.
 ;
 ; RORTY         Set to either "PV1" or "OBR"
 ;
 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are
 ; used by this function.
 ;
 ; Return Values:
 ;       <0  Error Code
 ;        0  Ok
 ;       >0  Non-fatal error(s)
 ;
EN1(RORDFN,DXDTS,RORTY) ;
 N ERRCNT,PIEN,PV1CNT,RC
 S (ERRCNT,RC)=0
 ;
 ;--- PV1 Segments
 I RORTY="PV1"  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)  D
 . N IDX,INVDT,ROREND
 . S (IDX,PV1CNT)=0
 . F  S IDX=$O(DXDTS(2,IDX))  Q:IDX'>0  D  Q:RC<0
 . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1)
 . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2)
 . . F  S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1)  Q:'INVDT!(INVDT'>ROREND)  D
 . . . S PIEN=""
 . . . F  S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1)  Q:'PIEN  D
 . . . . S TMP=$$PV1(PIEN,RORDFN)
 . . . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
 . . . . ;--- Reference for the corresponding OBR segment
 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN
 ;
 ;--- OBR and OBX Segments
 I RORTY="OBR"  D  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)
 . S PV1CNT=0
 . F  S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT))  Q:PV1CNT'>0  D
 . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT))  Q:PIEN'>0
 . . ;---
 . . S TMP=$$OBR(PIEN,RORDFN)
 . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
 . . ;---
 . . S TMP=$$OBX(PIEN,RORDFN)
 . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
 ;
 ;--- Check for errors
 Q $S(RC<0:RC,1:ERRCNT)
 ;
 ;***** OBR SEGMENT BUILDER (OUTPATIENT)
 ;
 ; RORIEN        IEN of file #9000010
 ; RORDFN        DFN of Patient Record in File #2
 ;
 ; Return Values:
 ;       <0  Error Code
 ;        0  Ok
 ;       >0  Non-fatal error(s)
 ;
OBR(RORIEN,RORDFN) ;
 N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0
 S (ERRCNT,RC)=0
 D ECH^RORHL7(.CS)
 ;
 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
 ;
 ;--- Initialize the segment
 S RORSEG(0)="OBR"
 ;
 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010) 
 S RORSEG(3)=RORIEN
 ;
 ;--- OBR-4 - Universal Service ID
 S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4"
 ;
 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY*
 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC")
 S RORSEG(7)=TMP
 ;
 ;--- OBR-24 - Diagnostic Service ID
 S RORSEG(24)="PHY"
 ;
 ;--- OBR-44 - Division
 S RORSEG(44)=$$SITE^RORUTL03(CS)
 S TMP=+$P(VST0,U,6)  ; LOC. OF ENCOUNTER (.06)
 I TMP>0  D
 . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2)
 . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4"
 ;
 ;--- Store the segment
 D ADDSEG^RORHL7(.RORSEG)
 Q ERRCNT
 ;
 ;***** OBX SEGMENT BUILDER (OUTPATIENT)
 ;
 ; RORIEN        IEN of file #9000010
 ; RORDFN        DFN of Patient Record in File #2
 ;
 ; Return Values:
 ;       <0  Error Code
 ;        0  Ok
 ;       >0  Non-fatal error(s)
 ;
OBX(RORIEN,RORDFN) ;
 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP
 S (ERRCNT,RC)=0
 D ECH^RORHL7(.RORCS)
 ;
 ;--- Procedures
 I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1  D  Q:RC<0 RC
 . S RC=$$PROCS()  S:RC ERRCNT=ERRCNT+1
 ;--- Diagnosis codes
 I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1  D  Q:RC<0 RC
 . S RC=$$DIAGS()  S:RC ERRCNT=ERRCNT+1
 ;
 Q ERRCNT
 ; 
 ;***** PROCESSES PROCEDURES
PROCS() ;
 N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP
 S ERRCNT=0
 S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080"
 S K5=""
 F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5))  Q:K5=""  D
 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0))
 . S IEN=+$P(REC,U)  Q:IEN'>0
 . ;---
 . S PROC=$$CODEC^ICPTCOD(IEN)
 . Q:PROC<0
 . ;---
 . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4)
 . Q:PRV'>0
 . ;---
 . S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1
 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",")
 . ;---
 . D SETOBX(OID,PROC,PRV)
 Q ERRCNT
 ;
 ;***** PV1 SEGMENT BUILDER (OUTPATIENT)
 ;
 ; RORIEN        IEN in the file #9000010
 ; RORDFN        DFN of Patient Record in File #2
 ;
 ; Return Values:
 ;       <0  Error Code
 ;        0  Ok
 ;      "S"  No visit data
 ;       >0  Non-fatal error(s)
 ;
PV1(RORIEN,RORDFN) ;
 N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0
 S (ERRCNT,RC)=0
 D ECH^RORHL7(.CS,,.REP)
 ;
 ;--- Get Visit Data
 D ENCEVENT^PXKENC(RORIEN,1)
 Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S"
 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
 ;
 ;--- Do not send visits with the following service categories: Daily
 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N),
 ;                    (E), Event Historical, Hospitalization (H).
 Q:"HEDXNC"[$P(VST0,U,7) "S"
 ;
 ;--- Initialize the segment
 S RORSEG(0)="PV1"
 ;
 ;--- PV1-2 - Patient Class
 S RORSEG(2)="O"  ; O - Outpatient
 ;
 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code)
 S RORCLIN=+$P(VST0,U,22),BUF=""
 I RORCLIN>0  D
 . S IENS=RORCLIN_","
 . S TMP=$$GET1^DIQ(44,IENS,3.5,"I")  Q:TMP'>0
 . S BUF=$$GET1^DIQ(40.8,TMP,1)       Q:BUF=""  ; Station Number
 . S TMP=$$STOPCODE^RORUTL18(+RORCLIN)
 . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"")            ; Stop Code
 Q:$P(BUF,CS,6)="" "S"  ; Stop Code is required
 S RORSEG(3)=BUF
 ;
 ; PV1-4  - Admission Type
 S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3)
 S RORSEG(4)=TMP
 ;
 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name)
 S (KK4,BUF)=""
 F  S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4))  Q:KK4=""  D
 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0))
 . S PRV=+$P(REC,U)  Q:(PRV'>0)!($P(REC,U,4)'="P")
 . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1
 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",")
 . S BUF=BUF_REP_PRV
 S RORSEG(7)=$P(BUF,REP,2,999)
 ;
 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY*
 S RORSEG(19)=RORIEN
 ;
 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY*
 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
 I TMP'>0  D  Q RC
 . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC")
 S RORSEG(44)=TMP
 ;
 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator)
 S TMP=$P(VST0,U,11)
 S RORSEG(51)=$S(TMP'="":TMP,1:0)
 ;
 ;--- Store the segment
 D ADDSEG^RORHL7(.RORSEG)
 Q ERRCNT
 ;
 ;***** LOW-LEVEL SEGMENT BUILDER
 ;
 ; OBX3          Observation Identifier
 ;
 ; OBX5          Observation Value
 ;
 ; [OBX16]       Procedure Provider and Provider Class Name
 ;
SETOBX(OBX3,OBX5,OBX16) ;
 N RORSEG
 S RORSEG(0)="OBX"
 ;--- OBX-2 Value Type
 S RORSEG(2)="FT"
 ;--- OBX-3 Observation Identifier
 S RORSEG(3)=OBX3
 ;--- OBX-5 Observation Value
 S RORSEG(5)=OBX5
 ;--- OBX-11 Observation Result Status
 S RORSEG(11)="F"
 ;--- OBX-16 Responsible Observer (Procedure Provider)
 S:$G(OBX16)'="" RORSEG(16)=OBX16
 ;--- Store the segment
 D ADDSEG^RORHL7(.RORSEG)
 Q