RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ;3/13/06 9:24am
;;1.5;CLINICAL CASE REGISTRIES;**1,5,19**;Feb 17, 2006;Build 43
;
; 11/29/2007 BAY/KAM ROR*1.5*5 Rem Call 218601 Correct Outpatient
; CPTs not transmitting to the AAC
;
; 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)
; #10060 Read access to the file #200 (supported)
; #2438 Access to the file #40.8 (field #1) (controlled)
; #5747 $$CODEC^ICDEX (controlled)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
;
;******************************************************************************
;******************************************************************************
Q
;
;***** PROCESSES DIAGNOSIS CODES
DIAGS() ;
N DIAG,IEN,K5,OID,REC,RORICDSNAM
S OID="OICD"_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^ICDEX(80,IEN) Q:+DIAG=-1
. S RORICDSNAM=$$CSNAME^RORHLUT1(80,IEN)
. D SETOBX(OID,RORICDSNAM_":"_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)
. ;12/06/2007 BAY/KAM REM CALL 218601 Modified next 8 lines
. ;---
. I PRV>0 D
.. 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_",")
. E S PRV=""
. ;----------> End of changes for 218601
. ;---
. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL09 8920 printed Apr 09, 2024@20:47:24 Page 2
RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ;3/13/06 9:24am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,5,19**;Feb 17, 2006;Build 43
+2 ;
+3 ; 11/29/2007 BAY/KAM ROR*1.5*5 Rem Call 218601 Correct Outpatient
+4 ; CPTs not transmitting to the AAC
+5 ;
+6 ; This routine uses the following IAs:
+7 ;
+8 ; #93 Get stop code from the file #44 (controlled)
+9 ; #1889 Use of the ENCEVENT^PXKENC API
+10 ; #1995 $$CODEC^ICPTCOD (supported)
+11 ; #2309 Read access to the 'AA' x-ref in VISIT file (#9000010)
+12 ; #10060 Read access to the file #200 (supported)
+13 ; #2438 Access to the file #40.8 (field #1) (controlled)
+14 ; #5747 $$CODEC^ICDEX (controlled)
+15 ;
+16 ;******************************************************************************
+17 ;******************************************************************************
+18 ; --- ROUTINE MODIFICATION LOG ---
+19 ;
+20 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+21 ;----------- ---------- ----------- ----------------------------------------
+22 ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
+23 ;
+24 ;******************************************************************************
+25 ;******************************************************************************
+26 QUIT
+27 ;
+28 ;***** PROCESSES DIAGNOSIS CODES
DIAGS() ;
+1 NEW DIAG,IEN,K5,OID,REC,RORICDSNAM
+2 SET OID="OICD"_RORCS_"Diagnosis"_RORCS_"VA080"
+3 SET K5=""
+4 FOR
SET K5=$ORDER(^TMP("PXKENC",$JOB,RORIEN,"POV",K5))
if K5=""
QUIT
Begin DoDot:1
+5 SET REC=^TMP("PXKENC",$JOB,RORIEN,"POV",K5,0)
+6 SET IEN=+$PIECE(REC,U)
if IEN'>0
QUIT
+7 ;---
+8 SET DIAG=$$CODEC^ICDEX(80,IEN)
if +DIAG=-1
QUIT
+9 SET RORICDSNAM=$$CSNAME^RORHLUT1(80,IEN)
+10 DO SETOBX(OID,RORICDSNAM_":"_DIAG)
End DoDot:1
+11 QUIT 0
+12 ;
+13 ;***** OUTPATIENT DATA SEGMENT BUILDER
+14 ;
+15 ; RORDFN DFN of Patient Record in File #2
+16 ;
+17 ; .DXDTS Reference to a local variable where the
+18 ; data extraction time frames are stored.
+19 ;
+20 ; RORTY Set to either "PV1" or "OBR"
+21 ;
+22 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are
+23 ; used by this function.
+24 ;
+25 ; Return Values:
+26 ; <0 Error Code
+27 ; 0 Ok
+28 ; >0 Non-fatal error(s)
+29 ;
EN1(RORDFN,DXDTS,RORTY) ;
+1 NEW ERRCNT,PIEN,PV1CNT,RC
+2 SET (ERRCNT,RC)=0
+3 ;
+4 ;--- PV1 Segments
+5 IF RORTY="PV1"
KILL ^TMP("PXKENC",$JOB),^TMP("RORHL09",$JOB)
Begin DoDot:1
+6 NEW IDX,INVDT,ROREND
+7 SET (IDX,PV1CNT)=0
+8 FOR
SET IDX=$ORDER(DXDTS(2,IDX))
if IDX'>0
QUIT
Begin DoDot:2
+9 SET INVDT=9999999-$$FMADD^XLFDT($PIECE(DXDTS(2,IDX),U)\1,-1)
+10 SET ROREND=9999999-$PIECE(DXDTS(2,IDX),U,2)
+11 FOR
SET INVDT=$ORDER(^AUPNVSIT("AA",RORDFN,INVDT),-1)
if 'INVDT!(INVDT'>ROREND)
QUIT
Begin DoDot:3
+12 SET PIEN=""
+13 FOR
SET PIEN=$ORDER(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1)
if 'PIEN
QUIT
Begin DoDot:4
+14 SET TMP=$$PV1(PIEN,RORDFN)
+15 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+16 ;--- Reference for the corresponding OBR segment
+17 if TMP'="S"
SET PV1CNT=PV1CNT+1
SET ^TMP("RORHL09",$JOB,PV1CNT)=PIEN
End DoDot:4
End DoDot:3
End DoDot:2
if RC<0
QUIT
End DoDot:1
+18 ;
+19 ;--- OBR and OBX Segments
+20 IF RORTY="OBR"
Begin DoDot:1
+21 SET PV1CNT=0
+22 FOR
SET PV1CNT=$ORDER(^TMP("RORHL09",$JOB,PV1CNT))
if PV1CNT'>0
QUIT
Begin DoDot:2
+23 SET PIEN=+$GET(^TMP("RORHL09",$JOB,PV1CNT))
if PIEN'>0
QUIT
+24 ;---
+25 SET TMP=$$OBR(PIEN,RORDFN)
+26 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+27 ;---
+28 SET TMP=$$OBX(PIEN,RORDFN)
+29 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:2
End DoDot:1
KILL ^TMP("PXKENC",$JOB),^TMP("RORHL09",$JOB)
+30 ;
+31 ;--- Check for errors
+32 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+33 ;
+34 ;***** OBR SEGMENT BUILDER (OUTPATIENT)
+35 ;
+36 ; RORIEN IEN of file #9000010
+37 ; RORDFN DFN of Patient Record in File #2
+38 ;
+39 ; Return Values:
+40 ; <0 Error Code
+41 ; 0 Ok
+42 ; >0 Non-fatal error(s)
+43 ;
OBR(RORIEN,RORDFN) ;
+1 NEW CS,ERRCNT,RC,RORSEG,STN,TMP,VST0
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 SET VST0=$GET(^TMP("PXKENC",$JOB,RORIEN,"VST",RORIEN,0))
+6 ;
+7 ;--- Initialize the segment
+8 SET RORSEG(0)="OBR"
+9 ;
+10 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010)
+11 SET RORSEG(3)=RORIEN
+12 ;
+13 ;--- OBR-4 - Universal Service ID
+14 SET RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4"
+15 ;
+16 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY*
+17 SET TMP=$$FMTHL7^XLFDT($PIECE(VST0,U))
+18 if TMP'>0
QUIT $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC")
+19 SET RORSEG(7)=TMP
+20 ;
+21 ;--- OBR-24 - Diagnostic Service ID
+22 SET RORSEG(24)="PHY"
+23 ;
+24 ;--- OBR-44 - Division
+25 SET RORSEG(44)=$$SITE^RORUTL03(CS)
+26 ; LOC. OF ENCOUNTER (.06)
SET TMP=+$PIECE(VST0,U,6)
+27 IF TMP>0
Begin DoDot:1
+28 SET TMP=$$NS^XUAF4(TMP)
SET STN=$PIECE(TMP,U,2)
+29 if STN'=""
SET RORSEG(44)=STN_CS_$PIECE(TMP,U)_CS_"99VA4"
End DoDot:1
+30 ;
+31 ;--- Store the segment
+32 DO ADDSEG^RORHL7(.RORSEG)
+33 QUIT ERRCNT
+34 ;
+35 ;***** OBX SEGMENT BUILDER (OUTPATIENT)
+36 ;
+37 ; RORIEN IEN of file #9000010
+38 ; RORDFN DFN of Patient Record in File #2
+39 ;
+40 ; Return Values:
+41 ; <0 Error Code
+42 ; 0 Ok
+43 ; >0 Non-fatal error(s)
+44 ;
OBX(RORIEN,RORDFN) ;
+1 NEW ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.RORCS)
+4 ;
+5 ;--- Procedures
+6 IF $DATA(^TMP("PXKENC",$JOB,RORIEN,"CPT"))>1
Begin DoDot:1
+7 SET RC=$$PROCS()
if RC
SET ERRCNT=ERRCNT+1
End DoDot:1
if RC<0
QUIT RC
+8 ;--- Diagnosis codes
+9 IF $DATA(^TMP("PXKENC",$JOB,RORIEN,"POV"))>1
Begin DoDot:1
+10 SET RC=$$DIAGS()
if RC
SET ERRCNT=ERRCNT+1
End DoDot:1
if RC<0
QUIT RC
+11 ;
+12 QUIT ERRCNT
+13 ;
+14 ;***** PROCESSES PROCEDURES
PROCS() ;
+1 NEW CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP
+2 SET ERRCNT=0
+3 SET OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080"
+4 SET K5=""
+5 FOR
SET K5=$ORDER(^TMP("PXKENC",$JOB,RORIEN,"CPT",K5))
if K5=""
QUIT
Begin DoDot:1
+6 SET REC=$GET(^TMP("PXKENC",$JOB,RORIEN,"CPT",K5,0))
+7 SET IEN=+$PIECE(REC,U)
if IEN'>0
QUIT
+8 ;---
+9 SET PROC=$$CODEC^ICPTCOD(IEN)
+10 if PROC<0
QUIT
+11 ;---
+12 SET PRV=+$PIECE($GET(^TMP("PXKENC",$JOB,RORIEN,"CPT",K5,12)),U,4)
+13 ;12/06/2007 BAY/KAM REM CALL 218601 Modified next 8 lines
+14 ;---
+15 IF PRV>0
Begin DoDot:2
+16 SET $PIECE(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
+17 IF $GET(DIERR)
Begin DoDot:3
+18 DO DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",")
End DoDot:3
SET ERRCNT=ERRCNT+1
End DoDot:2
+19 IF '$TEST
SET PRV=""
+20 ;----------> End of changes for 218601
+21 ;---
+22 DO SETOBX(OID,PROC,PRV)
End DoDot:1
+23 QUIT ERRCNT
+24 ;
+25 ;***** PV1 SEGMENT BUILDER (OUTPATIENT)
+26 ;
+27 ; RORIEN IEN in the file #9000010
+28 ; RORDFN DFN of Patient Record in File #2
+29 ;
+30 ; Return Values:
+31 ; <0 Error Code
+32 ; 0 Ok
+33 ; "S" No visit data
+34 ; >0 Non-fatal error(s)
+35 ;
PV1(RORIEN,RORDFN) ;
+1 NEW BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS,,.REP)
+4 ;
+5 ;--- Get Visit Data
+6 DO ENCEVENT^PXKENC(RORIEN,1)
+7 if $DATA(^TMP("PXKENC",$JOB,RORIEN))<10
QUIT "S"
+8 SET VST0=$GET(^TMP("PXKENC",$JOB,RORIEN,"VST",RORIEN,0))
+9 ;
+10 ;--- Do not send visits with the following service categories: Daily
+11 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N),
+12 ; (E), Event Historical, Hospitalization (H).
+13 if "HEDXNC"[$PIECE(VST0,U,7)
QUIT "S"
+14 ;
+15 ;--- Initialize the segment
+16 SET RORSEG(0)="PV1"
+17 ;
+18 ;--- PV1-2 - Patient Class
+19 ; O - Outpatient
SET RORSEG(2)="O"
+20 ;
+21 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code)
+22 SET RORCLIN=+$PIECE(VST0,U,22)
SET BUF=""
+23 IF RORCLIN>0
Begin DoDot:1
+24 SET IENS=RORCLIN_","
+25 SET TMP=$$GET1^DIQ(44,IENS,3.5,"I")
if TMP'>0
QUIT
+26 ; Station Number
SET BUF=$$GET1^DIQ(40.8,TMP,1)
if BUF=""
QUIT
+27 SET TMP=$$STOPCODE^RORUTL18(+RORCLIN)
+28 ; Stop Code
SET $PIECE(BUF,CS,6)=$SELECT(TMP>0:TMP,1:"")
End DoDot:1
+29 ; Stop Code is required
if $PIECE(BUF,CS,6)=""
QUIT "S"
+30 SET RORSEG(3)=BUF
+31 ;
+32 ; PV1-4 - Admission Type
+33 SET TMP=$PIECE($GET(^TMP("PXKENC",$JOB,RORIEN,"VST",RORIEN,150)),U,3)
+34 SET RORSEG(4)=TMP
+35 ;
+36 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name)
+37 SET (KK4,BUF)=""
+38 FOR
SET KK4=$ORDER(^TMP("PXKENC",$JOB,RORIEN,"PRV",KK4))
if KK4=""
QUIT
Begin DoDot:1
+39 SET REC=$GET(^TMP("PXKENC",$JOB,RORIEN,"PRV",KK4,0))
+40 SET PRV=+$PIECE(REC,U)
if (PRV'>0)!($PIECE(REC,U,4)'="P")
QUIT
+41 SET $PIECE(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
+42 IF $GET(DIERR)
Begin DoDot:2
+43 DO DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",")
End DoDot:2
SET ERRCNT=ERRCNT+1
+44 SET BUF=BUF_REP_PRV
End DoDot:1
+45 SET RORSEG(7)=$PIECE(BUF,REP,2,999)
+46 ;
+47 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY*
+48 SET RORSEG(19)=RORIEN
+49 ;
+50 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY*
+51 SET TMP=$$FMTHL7^XLFDT($PIECE(VST0,U))
+52 IF TMP'>0
Begin DoDot:1
+53 SET RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC")
End DoDot:1
QUIT RC
+54 SET RORSEG(44)=TMP
+55 ;
+56 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator)
+57 SET TMP=$PIECE(VST0,U,11)
+58 SET RORSEG(51)=$SELECT(TMP'="":TMP,1:0)
+59 ;
+60 ;--- Store the segment
+61 DO ADDSEG^RORHL7(.RORSEG)
+62 QUIT ERRCNT
+63 ;
+64 ;***** LOW-LEVEL SEGMENT BUILDER
+65 ;
+66 ; OBX3 Observation Identifier
+67 ;
+68 ; OBX5 Observation Value
+69 ;
+70 ; [OBX16] Procedure Provider and Provider Class Name
+71 ;
SETOBX(OBX3,OBX5,OBX16) ;
+1 NEW RORSEG
+2 SET RORSEG(0)="OBX"
+3 ;--- OBX-2 Value Type
+4 SET RORSEG(2)="FT"
+5 ;--- OBX-3 Observation Identifier
+6 SET RORSEG(3)=OBX3
+7 ;--- OBX-5 Observation Value
+8 SET RORSEG(5)=OBX5
+9 ;--- OBX-11 Observation Result Status
+10 SET RORSEG(11)="F"
+11 ;--- OBX-16 Responsible Observer (Procedure Provider)
+12 if $GET(OBX16)'=""
SET RORSEG(16)=OBX16
+13 ;--- Store the segment
+14 DO ADDSEG^RORHL7(.RORSEG)
+15 QUIT
