RORHL08 ;HOIFO/BH - HL7 INPATIENT DATA: PV1,OBR ; 3/13/06 9:24am
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #92 Read access to the PTF file (controlled)
; #994 Read access to the PTF CLOSE OUT file (controlled)
;
Q
;
;***** INPATIENT 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("RORHL08",$J) global node is used by this function.
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
EN1(RORDFN,DXDTS,RORTY) ;
N ERRCNT,IENS,INIEN,PV1CNT,RC,RORMSG,TMP
S (ERRCNT,RC)=0
;
;--- PV1 Segments
I RORTY="PV1" K ^TMP("RORHL08",$J) D
. N DATE,ENDT,IDX,STDT,TYPE,XREF
. S XREF=$NA(^TMP("RORPTF",$J,"PDI",RORDFN))
. S (IDX,PV1CNT)=0
. F S IDX=$O(DXDTS(3,IDX)) Q:IDX'>0 D Q:RC<0
. . S STDT=$P(DXDTS(3,IDX),U),ENDT=$P(DXDTS(3,IDX),U,2)
. . ;---
. . S TMP=$$UPDNDX(STDT,ENDT)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . ;---
. . S DATE=$O(@XREF@(STDT),-1)
. . F S DATE=$O(@XREF@(DATE)) Q:'DATE!(DATE'<ENDT) D
. . . S INIEN=""
. . . F S INIEN=$O(@XREF@(DATE,INIEN)) Q:'INIEN D
. . . . S IENS=INIEN_","
. . . . ;--- Skip non-PTF records
. . . . S TYPE=$$GET1^DIQ(45,IENS,11,"I",,"RORMSG")
. . . . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
. . . . . D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
. . . . Q:TYPE'="1"
. . . . ;--- Generate the PV1 segment
. . . . S TMP=$$PV1(INIEN,RORDFN)
. . . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . . . ;--- Reference for the corresponding OBR and OBX segments
. . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL08",$J,PV1CNT)=INIEN
;
;--- OBR and OBX Segments
I RORTY="OBR" D K ^TMP("RORHL08",$J)
. S PV1CNT=0
. F S PV1CNT=$O(^TMP("RORHL08",$J,PV1CNT)) Q:PV1CNT'>0 D
. . S INIEN=+$G(^TMP("RORHL08",$J,PV1CNT)) Q:INIEN'>0
. . ;---
. . S TMP=$$OBR(INIEN,RORDFN)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . ;---
. . S TMP=$$OBX^RORHL081(INIEN,RORDFN)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
;
;--- Check for errors
Q $S(RC<0:RC,1:ERRCNT)
;
;***** MERGES THE TIME FRAME INTO THE LIST
;
; .DXDTS Reference to a local array where the time frames
; are returned: DXDTS(StartDT)=StartDT^EndDT.
;
; STDT Start date
; ENDT End date
;
; This procedure merges the provided time frame [STDT,ENDT[ into
; the list stored in the ^TMP("RORPTF",$J,"DTF") global node and
; returns a list of time frames that should be updated into a
; local array defined by the DXDTS parameter.
;
; Variants of positional relationship of the existing time frames
; and the one that is being added to the list:
;
; (1) +--------TMP +----------+
; STDT--------ENDT
;
; (2) +--------TMP
; STDT--------ENDT
;
; (3) TMP--------+
; STDT--------ENDT
;
; (4) +--------+
; STDT------------------ENDT
;
MERGEDTF(DXDTS,STDT,ENDT) ;
N DATE,DXE,DXS,ENDT0,EXIT,STDT0,TMP K DXDTS
Q:STDT>ENDT
S STDT0=STDT,(DXE,ENDT0)=ENDT
;--- Merge time frames if possible
S DATE=$O(^TMP("RORPTF",$J,"DTF",ENDT)),EXIT=0
F S DATE=$O(^TMP("RORPTF",$J,"DTF",DATE),-1) Q:DATE="" D Q:EXIT
. S DXS=$P(^TMP("RORPTF",$J,"DTF",DATE),U,2)
. I DXS<STDT S EXIT=1 Q ; (1)
. S:DXS>ENDT ENDT=DXS,DFLT=0 ; (2)
. S:DXS<DXE DXDTS(DXS)=DXS_U_DXE
. S DXE=$P(^TMP("RORPTF",$J,"DTF",DATE),U)
. S:DXE<STDT STDT=DXE,DFLT=0 ; (3)
. K ^TMP("RORPTF",$J,"DTF",DATE)
S:DXE>STDT0 DXDTS(STDT0)=STDT0_U_DXE
;--- Store the new time frame
S ^TMP("RORPTF",$J,"DTF",STDT)=STDT_U_ENDT
Q
;
;***** OBR SEGMENT BUILDER (INPATIENT)
;
; RORIEN IEN of file #45
;
; 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,IENS,OBDT,RC,RORMSG,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Order Number (IEN in the PTF file #45)
S RORSEG(3)=RORIEN
;
;--- OBR-4 - Universal Service ID
S RORSEG(4)="IP"_CS_"Inpatient"_CS_"C4"
;
;--- OBR-7 -Observation Date/Time (Admission Date/Time) *KEY*
S IENS=RORIEN_","
S OBDT=$$GET1^DIQ(45,IENS,2,"I",,"RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
;---
S OBDT=$$FMTHL7^XLFDT(OBDT)
Q:OBDT'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
S RORSEG(7)=OBDT
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="PHY"
;
;--- OBR-44 - Division
S RORSEG(44)=$$SITE^RORUTL03(CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** PV1 SEGMENT BUILDER (INPATIENT)
;
; RORIEN IEN of file #45
;
; RORDFN DFN of Patient Record in File #2
;
; Return Values:
; <0 Error Code
; 0 Ok
; "S" No inpatient data
; >0 Non-fatal error(s)
;
PV1(RORIEN,RORDFN) ;
N BUF,CS,ERRCNT,IENS,RC,RORBUF,RORMSG,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Load the data
S IENS=RORIEN_","
D GETS^DIQ(45,IENS,"2;70;71;72","I","RORBUF","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
;
;--- Initialize the segment
S RORSEG(0)="PV1"
;
;--- PV1-2 - Patient Class
S RORSEG(2)="I" ; I - Inpatient
;
;--- PV1-3 - Assigned Patient Location (Station Number)
S TMP=$E($P($$SITE^VASITE,U,3),1,3) ; Strip the suffix
Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No station number","$$SITE^VASITE")
S RORSEG(3)=TMP
;
;--- PV1-6 - Prior Patient Location (Bed Section at Discharge)
I $G(RORBUF(45,IENS,71,"I"))>0 D
. S BUF=""
. S $P(BUF,CS,3)=RORBUF(45,IENS,71,"I") ; Bed Section IEN
. S TMP=$$EXTERNAL^DILFD(45,71,,$P(BUF,CS,3),"RORMSG")
. I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
. . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IENS)
. S $P(BUF,CS,9)=$$ESCAPE^RORHL7(TMP) ; Bed Section Name
. S RORSEG(6)=BUF
;
;--- PV1-19 - Visit Number (IEN in the PTF file #45) *KEY*
S RORSEG(19)=RORIEN
;
;--- PV1-36 - Discharge Disposition
S RORSEG(36)=$G(RORBUF(45,IENS,72,"I"))
;
;--- PV1-44 - Admit Date/Time *KEY*
S TMP=$$FMTHL7^XLFDT($G(RORBUF(45,IENS,2,"I")))
Q:TMP'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
S RORSEG(44)=TMP
;
;--- PV1-45 - Discharge Date/Time
S RORSEG(45)=$$FM2HL^RORHL7($G(RORBUF(45,IENS,70,"I")))
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** UPDATES TEMPORARY PTF INDEX
;
; STDT Start date
; ENDT End date
;
; This function updates the temporary PTF index with records
; closed in the provided time frame.
;
; Return Values:
; <0 Error Code
; 0 Ok
;
UPDNDX(STDT,ENDT) ;
N DATE,DXDTS,IDX,IEN,PATIEN,RC,RORMSG,TMP
;--- Get time frames that should be processed
D MERGEDTF(.DXDTS,STDT,ENDT) Q:$D(DXDTS)<10 0
;--- Update the index
S IDX=0
F S IDX=$O(DXDTS(IDX)) Q:IDX'>0 D
. S STDT=$P(DXDTS(IDX),U),ENDT=$P(DXDTS(IDX),U,2)
. S DATE=$O(^DGP(45.84,"AC",STDT),-1)
. F S DATE=$O(^DGP(45.84,"AC",DATE)) Q:'DATE!(DATE'<ENDT) D
. . S IEN=0
. . F S IEN=$O(^DGP(45.84,"AC",DATE,IEN)) Q:IEN'>0 D
. . . ;--- Patient IEN (entries of file #45.84 are DINUM'ed)
. . . S PATIEN=$$GET1^DIQ(45,IEN,.01,"I",,"RORMSG")
. . . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,45,IEN) Q
. . . ;--- Create index entry
. . . S:PATIEN>0 ^TMP("RORPTF",$J,"PDI",PATIEN,DATE,IEN)=""
;---
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL08 7783 printed Apr 09, 2024@20:49:21 Page 2
RORHL08 ;HOIFO/BH - HL7 INPATIENT DATA: PV1,OBR ; 3/13/06 9:24am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #92 Read access to the PTF file (controlled)
+6 ; #994 Read access to the PTF CLOSE OUT file (controlled)
+7 ;
+8 QUIT
+9 ;
+10 ;***** INPATIENT DATA SEGMENT BUILDER
+11 ;
+12 ; RORDFN DFN of Patient Record in File #2
+13 ;
+14 ; .DXDTS Reference to a local variable where the
+15 ; data extraction time frames are stored.
+16 ;
+17 ; RORTY Set to either "PV1" or "OBR"
+18 ;
+19 ; The ^TMP("RORHL08",$J) global node is used by this function.
+20 ;
+21 ; Return Values:
+22 ; <0 Error Code
+23 ; 0 Ok
+24 ; >0 Non-fatal error(s)
+25 ;
EN1(RORDFN,DXDTS,RORTY) ;
+1 NEW ERRCNT,IENS,INIEN,PV1CNT,RC,RORMSG,TMP
+2 SET (ERRCNT,RC)=0
+3 ;
+4 ;--- PV1 Segments
+5 IF RORTY="PV1"
KILL ^TMP("RORHL08",$JOB)
Begin DoDot:1
+6 NEW DATE,ENDT,IDX,STDT,TYPE,XREF
+7 SET XREF=$NAME(^TMP("RORPTF",$JOB,"PDI",RORDFN))
+8 SET (IDX,PV1CNT)=0
+9 FOR
SET IDX=$ORDER(DXDTS(3,IDX))
if IDX'>0
QUIT
Begin DoDot:2
+10 SET STDT=$PIECE(DXDTS(3,IDX),U)
SET ENDT=$PIECE(DXDTS(3,IDX),U,2)
+11 ;---
+12 SET TMP=$$UPDNDX(STDT,ENDT)
+13 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+14 ;---
+15 SET DATE=$ORDER(@XREF@(STDT),-1)
+16 FOR
SET DATE=$ORDER(@XREF@(DATE))
if 'DATE!(DATE'<ENDT)
QUIT
Begin DoDot:3
+17 SET INIEN=""
+18 FOR
SET INIEN=$ORDER(@XREF@(DATE,INIEN))
if 'INIEN
QUIT
Begin DoDot:4
+19 SET IENS=INIEN_","
+20 ;--- Skip non-PTF records
+21 SET TYPE=$$GET1^DIQ(45,IENS,11,"I",,"RORMSG")
+22 IF $GET(DIERR)
Begin DoDot:5
+23 DO DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
End DoDot:5
SET ERRCNT=ERRCNT+1
QUIT
+24 if TYPE'="1"
QUIT
+25 ;--- Generate the PV1 segment
+26 SET TMP=$$PV1(INIEN,RORDFN)
+27 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+28 ;--- Reference for the corresponding OBR and OBX segments
+29 if TMP'="S"
SET PV1CNT=PV1CNT+1
SET ^TMP("RORHL08",$JOB,PV1CNT)=INIEN
End DoDot:4
End DoDot:3
End DoDot:2
if RC<0
QUIT
End DoDot:1
+30 ;
+31 ;--- OBR and OBX Segments
+32 IF RORTY="OBR"
Begin DoDot:1
+33 SET PV1CNT=0
+34 FOR
SET PV1CNT=$ORDER(^TMP("RORHL08",$JOB,PV1CNT))
if PV1CNT'>0
QUIT
Begin DoDot:2
+35 SET INIEN=+$GET(^TMP("RORHL08",$JOB,PV1CNT))
if INIEN'>0
QUIT
+36 ;---
+37 SET TMP=$$OBR(INIEN,RORDFN)
+38 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+39 ;---
+40 SET TMP=$$OBX^RORHL081(INIEN,RORDFN)
+41 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:2
End DoDot:1
KILL ^TMP("RORHL08",$JOB)
+42 ;
+43 ;--- Check for errors
+44 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+45 ;
+46 ;***** MERGES THE TIME FRAME INTO THE LIST
+47 ;
+48 ; .DXDTS Reference to a local array where the time frames
+49 ; are returned: DXDTS(StartDT)=StartDT^EndDT.
+50 ;
+51 ; STDT Start date
+52 ; ENDT End date
+53 ;
+54 ; This procedure merges the provided time frame [STDT,ENDT[ into
+55 ; the list stored in the ^TMP("RORPTF",$J,"DTF") global node and
+56 ; returns a list of time frames that should be updated into a
+57 ; local array defined by the DXDTS parameter.
+58 ;
+59 ; Variants of positional relationship of the existing time frames
+60 ; and the one that is being added to the list:
+61 ;
+62 ; (1) +--------TMP +----------+
+63 ; STDT--------ENDT
+64 ;
+65 ; (2) +--------TMP
+66 ; STDT--------ENDT
+67 ;
+68 ; (3) TMP--------+
+69 ; STDT--------ENDT
+70 ;
+71 ; (4) +--------+
+72 ; STDT------------------ENDT
+73 ;
MERGEDTF(DXDTS,STDT,ENDT) ;
+1 NEW DATE,DXE,DXS,ENDT0,EXIT,STDT0,TMP
KILL DXDTS
+2 if STDT>ENDT
QUIT
+3 SET STDT0=STDT
SET (DXE,ENDT0)=ENDT
+4 ;--- Merge time frames if possible
+5 SET DATE=$ORDER(^TMP("RORPTF",$JOB,"DTF",ENDT))
SET EXIT=0
+6 FOR
SET DATE=$ORDER(^TMP("RORPTF",$JOB,"DTF",DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+7 SET DXS=$PIECE(^TMP("RORPTF",$JOB,"DTF",DATE),U,2)
+8 ; (1)
IF DXS<STDT
SET EXIT=1
QUIT
+9 ; (2)
if DXS>ENDT
SET ENDT=DXS
SET DFLT=0
+10 if DXS<DXE
SET DXDTS(DXS)=DXS_U_DXE
+11 SET DXE=$PIECE(^TMP("RORPTF",$JOB,"DTF",DATE),U)
+12 ; (3)
if DXE<STDT
SET STDT=DXE
SET DFLT=0
+13 KILL ^TMP("RORPTF",$JOB,"DTF",DATE)
End DoDot:1
if EXIT
QUIT
+14 if DXE>STDT0
SET DXDTS(STDT0)=STDT0_U_DXE
+15 ;--- Store the new time frame
+16 SET ^TMP("RORPTF",$JOB,"DTF",STDT)=STDT_U_ENDT
+17 QUIT
+18 ;
+19 ;***** OBR SEGMENT BUILDER (INPATIENT)
+20 ;
+21 ; RORIEN IEN of file #45
+22 ;
+23 ; RORDFN DFN of Patient Record in File #2
+24 ;
+25 ; Return Values:
+26 ; <0 Error Code
+27 ; 0 Ok
+28 ; >0 Non-fatal error(s)
+29 ;
OBR(RORIEN,RORDFN) ;
+1 NEW CS,ERRCNT,IENS,OBDT,RC,RORMSG,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="OBR"
+7 ;
+8 ;--- OBR-3 - Order Number (IEN in the PTF file #45)
+9 SET RORSEG(3)=RORIEN
+10 ;
+11 ;--- OBR-4 - Universal Service ID
+12 SET RORSEG(4)="IP"_CS_"Inpatient"_CS_"C4"
+13 ;
+14 ;--- OBR-7 -Observation Date/Time (Admission Date/Time) *KEY*
+15 SET IENS=RORIEN_","
+16 SET OBDT=$$GET1^DIQ(45,IENS,2,"I",,"RORMSG")
+17 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
+18 ;---
+19 SET OBDT=$$FMTHL7^XLFDT(OBDT)
+20 if OBDT'>0
QUIT $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
+21 SET RORSEG(7)=OBDT
+22 ;
+23 ;--- OBR-24 - Diagnostic Service ID
+24 SET RORSEG(24)="PHY"
+25 ;
+26 ;--- OBR-44 - Division
+27 SET RORSEG(44)=$$SITE^RORUTL03(CS)
+28 ;
+29 ;--- Store the segment
+30 DO ADDSEG^RORHL7(.RORSEG)
+31 QUIT ERRCNT
+32 ;
+33 ;***** PV1 SEGMENT BUILDER (INPATIENT)
+34 ;
+35 ; RORIEN IEN of file #45
+36 ;
+37 ; RORDFN DFN of Patient Record in File #2
+38 ;
+39 ; Return Values:
+40 ; <0 Error Code
+41 ; 0 Ok
+42 ; "S" No inpatient data
+43 ; >0 Non-fatal error(s)
+44 ;
PV1(RORIEN,RORDFN) ;
+1 NEW BUF,CS,ERRCNT,IENS,RC,RORBUF,RORMSG,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Load the data
+6 SET IENS=RORIEN_","
+7 DO GETS^DIQ(45,IENS,"2;70;71;72","I","RORBUF","RORMSG")
+8 IF $GET(DIERR)
Begin DoDot:1
+9 DO DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+10 ;
+11 ;--- Initialize the segment
+12 SET RORSEG(0)="PV1"
+13 ;
+14 ;--- PV1-2 - Patient Class
+15 ; I - Inpatient
SET RORSEG(2)="I"
+16 ;
+17 ;--- PV1-3 - Assigned Patient Location (Station Number)
+18 ; Strip the suffix
SET TMP=$EXTRACT($PIECE($$SITE^VASITE,U,3),1,3)
+19 if TMP'>0
QUIT $$ERROR^RORERR(-100,,,,"No station number","$$SITE^VASITE")
+20 SET RORSEG(3)=TMP
+21 ;
+22 ;--- PV1-6 - Prior Patient Location (Bed Section at Discharge)
+23 IF $GET(RORBUF(45,IENS,71,"I"))>0
Begin DoDot:1
+24 SET BUF=""
+25 ; Bed Section IEN
SET $PIECE(BUF,CS,3)=RORBUF(45,IENS,71,"I")
+26 SET TMP=$$EXTERNAL^DILFD(45,71,,$PIECE(BUF,CS,3),"RORMSG")
+27 IF $GET(DIERR)
Begin DoDot:2
+28 DO DBS^RORERR("RORMSG",-99,,RORDFN,45,IENS)
End DoDot:2
SET ERRCNT=ERRCNT+1
QUIT
+29 ; Bed Section Name
SET $PIECE(BUF,CS,9)=$$ESCAPE^RORHL7(TMP)
+30 SET RORSEG(6)=BUF
End DoDot:1
+31 ;
+32 ;--- PV1-19 - Visit Number (IEN in the PTF file #45) *KEY*
+33 SET RORSEG(19)=RORIEN
+34 ;
+35 ;--- PV1-36 - Discharge Disposition
+36 SET RORSEG(36)=$GET(RORBUF(45,IENS,72,"I"))
+37 ;
+38 ;--- PV1-44 - Admit Date/Time *KEY*
+39 SET TMP=$$FMTHL7^XLFDT($GET(RORBUF(45,IENS,2,"I")))
+40 if TMP'>0
QUIT $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
+41 SET RORSEG(44)=TMP
+42 ;
+43 ;--- PV1-45 - Discharge Date/Time
+44 SET RORSEG(45)=$$FM2HL^RORHL7($GET(RORBUF(45,IENS,70,"I")))
+45 ;
+46 ;--- Store the segment
+47 DO ADDSEG^RORHL7(.RORSEG)
+48 QUIT ERRCNT
+49 ;
+50 ;***** UPDATES TEMPORARY PTF INDEX
+51 ;
+52 ; STDT Start date
+53 ; ENDT End date
+54 ;
+55 ; This function updates the temporary PTF index with records
+56 ; closed in the provided time frame.
+57 ;
+58 ; Return Values:
+59 ; <0 Error Code
+60 ; 0 Ok
+61 ;
UPDNDX(STDT,ENDT) ;
+1 NEW DATE,DXDTS,IDX,IEN,PATIEN,RC,RORMSG,TMP
+2 ;--- Get time frames that should be processed
+3 DO MERGEDTF(.DXDTS,STDT,ENDT)
if $DATA(DXDTS)<10
QUIT 0
+4 ;--- Update the index
+5 SET IDX=0
+6 FOR
SET IDX=$ORDER(DXDTS(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 SET STDT=$PIECE(DXDTS(IDX),U)
SET ENDT=$PIECE(DXDTS(IDX),U,2)
+8 SET DATE=$ORDER(^DGP(45.84,"AC",STDT),-1)
+9 FOR
SET DATE=$ORDER(^DGP(45.84,"AC",DATE))
if 'DATE!(DATE'<ENDT)
QUIT
Begin DoDot:2
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^DGP(45.84,"AC",DATE,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+12 ;--- Patient IEN (entries of file #45.84 are DINUM'ed)
+13 SET PATIEN=$$GET1^DIQ(45,IEN,.01,"I",,"RORMSG")
+14 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-99,,,45,IEN)
QUIT
+15 ;--- Create index entry
+16 if PATIEN>0
SET ^TMP("RORPTF",$JOB,"PDI",PATIEN,DATE,IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;---
+18 QUIT 0
