RORUPD08 ;HCIOFO/SG - PROCESSING OF 'VISIT' & 'V POV' FILES ;10/27/05 11:08am
;;1.5;CLINICAL CASE REGISTRIES;**19,37**;Feb 17, 2006;Build 9
;
; This routine uses the following IAs:
;
; #1554 POV^PXAPIIB
; #1905 SELECTED^VSIT
; #1906 LOOKUP^VSIT
; #5747 $$CODEC^ICDEX (controlled)
; #1907 $$HISTORIC^VSIT (CONTROLLED)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
;ROR*1.5*37 SEP 2020 F TRAXLER Added ALLPAT subroutine
;******************************************************************************
;******************************************************************************
;
Q
;
;***** LOADS 'V POV' DATA ELEMENTS
;
; IENS IENS of the current record
;
; Return values:
; <0 Error code
; 0 Ok
;
LOADVPOV(IENS) ;
N RC S RC=0
;--- API #1
I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
. S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
;--- API #2
I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
. N BUF,DE,IP,RORMSG,TMP,VT
. S BUF=$G(RORVPLST(+IENS)),DE=""
. F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
. . S VT=""
. . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
. . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U)
. . . S:IP>0 RORVALS("DV",RORFILE,DE,VT)=$P(BUF,U,IP)
. ;--- External value of the POV field (.01)
. I $D(RORUPD("SR",RORFILE,"F",2,112,"E")) D Q:RC<0
. . S TMP=+$P(BUF,U) Q:TMP'>0
. . S TMP=$$CODEC^ICDEX(80,TMP)
. . S RORVALS("DV",RORFILE,112,"E")=$S(TMP'<0:TMP,1:"")
Q 0
;
;***** LOAD 'VISIT' DATA ELEMENTS
;
; IENS IENS of the current record
;
; Return values:
; <0 Error code
; 0 Ok
;
LOADVSIT(IENS) ;
N RC S RC=0
;--- API #1
I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
. S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
;--- API #2
I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
. N API,DE,IN,IP,TMP,VSIT,VT
. S TMP=$$LOOKUP^VSIT(+IENS,"B",0)
. I TMP<0 S API="$$LOOKUP^VSIT" D Q
. . S RC=$$ERROR^RORERR(-57,,,,TMP,API)
. ;---
. S DE=""
. F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
. . S VT=""
. . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
. . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U) Q:IP'>0
. . . S IN=$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
. . . S RORVALS("DV",RORFILE,DE,VT)=$P($G(VSIT(IN)),U,IP)
. ;---
Q 0
;
;***** PROCESSING OF THE 'VISIT' FILE
;
; UPDSTART Date of the earliest update
; PATIEN Patient IEN
;
; Return values:
; <0 Error code
; 0 Continue processing of the current patient
; 1 Stop processing
;
; The function uses the ^TMP("VSIT",$J) global node.
;
VISIT(UPDSTART,PATIEN) ;
N RORFILE ; File number
;
N DATE,DSEND,IEN,LOCATION,RC,TMP,VISIENS
S RORFILE=9000010,DSEND=RORUPD("DSEND")
;--- Check the event references if the events are enabled
I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
. S RC=$$GET^RORUPP02(PATIEN,2,.UPDSTART,.DSEND)
. S:RC>1 UPDSTART=UPDSTART\1,DSEND=$$FMADD^XLFDT(DSEND\1,1)
;--- Get a list of visits
D SELECTED^VSIT(PATIEN,UPDSTART,DSEND)
;
;--- Browse through the visits
S (IEN,RC)=0
F S IEN=$O(^TMP("VSIT",$J,IEN)) Q:IEN="" D Q:RC
. S VISIENS=IEN_",",TMP=+$O(^TMP("VSIT",$J,IEN,""))
. I $$HISTORIC^VSIT(IEN)=1 D I 1 ;is visit historical?
. . N RORTMP,VSIT
. . S RORTMP=$$LOOKUP^VSIT(IEN,"I",0)
. . Q:RORTMP<0
. . S DATE=VSIT("CDT") ;visit creation date
. E S DATE=$P($G(^TMP("VSIT",$J,IEN,TMP)),U) ;visit date
. ;--- Load necessary data elements
. I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
. . S TMP=$$LOADVSIT(VISIENS) Q:TMP<0
. . S LOCATION=$$GETDE^RORUPDUT(RORFILE,129)
. ;--- Apply "before" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"B",DATE,$G(LOCATION))
. I RC D INCEC^RORUPDUT(.RC) Q
. ;
. ;--- Process V POV file
. I $D(RORUPD("SR",9000010.07)) D I RC D INCEC^RORUPDUT(.RC) Q
. . S RC=$$VPOV(IEN,DATE,$G(LOCATION))
. ;
. ;--- Apply "after" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"A",DATE,$G(LOCATION))
. I RC D INCEC^RORUPDUT(.RC) Q
;
K ^TMP("VSIT",$J)
D CLRDES^RORUPDUT(RORFILE)
Q RC
;
;***** PROCESSING OF THE 'V POV' FILE
;
; VISITIEN IEN of the visit (in the "VISIT" file)
; DATE Visit date
; LOCATION Institution IEN
;
; Return values:
; <0 Error code
; 0 Continue processing of the current patient
; 1 Stop processing
;
VPOV(VISITIEN,DATE,LOCATION) ;
N RORFILE ; File number
N RORVPLST ; List of records in the file
;
N IEN,NODE,RC,TMP,VPIENS
S RORFILE=9000010.07
D CLRVALS^RORUPDUT(RORFILE)
;--- Get a list of records
D POV^PXAPIIB(VISITIEN,.RORVPLST)
;
S (IEN,RC)=0
F S IEN=$O(RORVPLST(IEN)) Q:IEN="" D Q:RC
. S VPIENS=IEN_","
. ;--- Load necessary data elements
. I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
. . S TMP=$$LOADVPOV(VPIENS)
. ;--- Apply "before" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"B",DATE,LOCATION)
. I RC D INCEC^RORUPDUT(.RC) Q
. ;--- Apply "after" rules
. S RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"A",DATE,LOCATION)
. I RC D INCEC^RORUPDUT(.RC) Q
;
D CLRDES^RORUPDUT(RORFILE)
Q RC
;
ALLPAT(REGIEN) ;Is Visit/Admit Date/Time (#.01) less than 2 years old
N RC,ROR2YRS
S RC=0,ROR2YRS=DT-20000
I $D(RORVALS("DV",9000010,155,"I")) D
. I RORVALS("DV",9000010,155,"I")>ROR2YRS S RC=1
Q RC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD08 5962 printed Nov 22, 2024@16:53:56 Page 2
RORUPD08 ;HCIOFO/SG - PROCESSING OF 'VISIT' & 'V POV' FILES ;10/27/05 11:08am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**19,37**;Feb 17, 2006;Build 9
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1554 POV^PXAPIIB
+6 ; #1905 SELECTED^VSIT
+7 ; #1906 LOOKUP^VSIT
+8 ; #5747 $$CODEC^ICDEX (controlled)
+9 ; #1907 $$HISTORIC^VSIT (CONTROLLED)
+10 ;
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ; --- ROUTINE MODIFICATION LOG ---
+14 ;
+15 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+16 ;----------- ---------- ----------- ----------------------------------------
+17 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+18 ;ROR*1.5*37 SEP 2020 F TRAXLER Added ALLPAT subroutine
+19 ;******************************************************************************
+20 ;******************************************************************************
+21 ;
+22 QUIT
+23 ;
+24 ;***** LOADS 'V POV' DATA ELEMENTS
+25 ;
+26 ; IENS IENS of the current record
+27 ;
+28 ; Return values:
+29 ; <0 Error code
+30 ; 0 Ok
+31 ;
LOADVPOV(IENS) ;
+1 NEW RC
SET RC=0
+2 ;--- API #1
+3 IF $DATA(RORUPD("SR",RORFILE,"F",1))
Begin DoDot:1
+4 SET RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
End DoDot:1
if RC<0
QUIT RC
+5 ;--- API #2
+6 IF $DATA(RORUPD("SR",RORFILE,"F",2))
Begin DoDot:1
+7 NEW BUF,DE,IP,RORMSG,TMP,VT
+8 SET BUF=$GET(RORVPLST(+IENS))
SET DE=""
+9 FOR
SET DE=$ORDER(RORUPD("SR",RORFILE,"F",2,DE))
if DE=""
QUIT
Begin DoDot:2
+10 SET VT=""
+11 FOR
SET VT=$ORDER(RORUPD("SR",RORFILE,"F",2,DE,VT))
if VT=""
QUIT
Begin DoDot:3
+12 SET IP=+$PIECE(RORUPD("SR",RORFILE,"F",2,DE,VT),U)
+13 if IP>0
SET RORVALS("DV",RORFILE,DE,VT)=$PIECE(BUF,U,IP)
End DoDot:3
End DoDot:2
+14 ;--- External value of the POV field (.01)
+15 IF $DATA(RORUPD("SR",RORFILE,"F",2,112,"E"))
Begin DoDot:2
+16 SET TMP=+$PIECE(BUF,U)
if TMP'>0
QUIT
+17 SET TMP=$$CODEC^ICDEX(80,TMP)
+18 SET RORVALS("DV",RORFILE,112,"E")=$SELECT(TMP'<0:TMP,1:"")
End DoDot:2
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT RC
+19 QUIT 0
+20 ;
+21 ;***** LOAD 'VISIT' DATA ELEMENTS
+22 ;
+23 ; IENS IENS of the current record
+24 ;
+25 ; Return values:
+26 ; <0 Error code
+27 ; 0 Ok
+28 ;
LOADVSIT(IENS) ;
+1 NEW RC
SET RC=0
+2 ;--- API #1
+3 IF $DATA(RORUPD("SR",RORFILE,"F",1))
Begin DoDot:1
+4 SET RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
End DoDot:1
if RC<0
QUIT RC
+5 ;--- API #2
+6 IF $DATA(RORUPD("SR",RORFILE,"F",2))
Begin DoDot:1
+7 NEW API,DE,IN,IP,TMP,VSIT,VT
+8 SET TMP=$$LOOKUP^VSIT(+IENS,"B",0)
+9 IF TMP<0
SET API="$$LOOKUP^VSIT"
Begin DoDot:2
+10 SET RC=$$ERROR^RORERR(-57,,,,TMP,API)
End DoDot:2
QUIT
+11 ;---
+12 SET DE=""
+13 FOR
SET DE=$ORDER(RORUPD("SR",RORFILE,"F",2,DE))
if DE=""
QUIT
Begin DoDot:2
+14 SET VT=""
+15 FOR
SET VT=$ORDER(RORUPD("SR",RORFILE,"F",2,DE,VT))
if VT=""
QUIT
Begin DoDot:3
+16 SET IP=+$PIECE(RORUPD("SR",RORFILE,"F",2,DE,VT),U)
if IP'>0
QUIT
+17 SET IN=$PIECE(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
+18 SET RORVALS("DV",RORFILE,DE,VT)=$PIECE($GET(VSIT(IN)),U,IP)
End DoDot:3
End DoDot:2
+19 ;---
End DoDot:1
if RC<0
QUIT RC
+20 QUIT 0
+21 ;
+22 ;***** PROCESSING OF THE 'VISIT' FILE
+23 ;
+24 ; UPDSTART Date of the earliest update
+25 ; PATIEN Patient IEN
+26 ;
+27 ; Return values:
+28 ; <0 Error code
+29 ; 0 Continue processing of the current patient
+30 ; 1 Stop processing
+31 ;
+32 ; The function uses the ^TMP("VSIT",$J) global node.
+33 ;
VISIT(UPDSTART,PATIEN) ;
+1 ; File number
NEW RORFILE
+2 ;
+3 NEW DATE,DSEND,IEN,LOCATION,RC,TMP,VISIENS
+4 SET RORFILE=9000010
SET DSEND=RORUPD("DSEND")
+5 ;--- Check the event references if the events are enabled
+6 IF $GET(RORUPD("FLAGS"))["E"
Begin DoDot:1
+7 SET RC=$$GET^RORUPP02(PATIEN,2,.UPDSTART,.DSEND)
+8 if RC>1
SET UPDSTART=UPDSTART\1
SET DSEND=$$FMADD^XLFDT(DSEND\1,1)
End DoDot:1
if RC'>0
QUIT RC
+9 ;--- Get a list of visits
+10 DO SELECTED^VSIT(PATIEN,UPDSTART,DSEND)
+11 ;
+12 ;--- Browse through the visits
+13 SET (IEN,RC)=0
+14 FOR
SET IEN=$ORDER(^TMP("VSIT",$JOB,IEN))
if IEN=""
QUIT
Begin DoDot:1
+15 SET VISIENS=IEN_","
SET TMP=+$ORDER(^TMP("VSIT",$JOB,IEN,""))
+16 ;is visit historical?
IF $$HISTORIC^VSIT(IEN)=1
Begin DoDot:2
+17 NEW RORTMP,VSIT
+18 SET RORTMP=$$LOOKUP^VSIT(IEN,"I",0)
+19 if RORTMP<0
QUIT
+20 ;visit creation date
SET DATE=VSIT("CDT")
End DoDot:2
IF 1
+21 ;visit date
IF '$TEST
SET DATE=$PIECE($GET(^TMP("VSIT",$JOB,IEN,TMP)),U)
+22 ;--- Load necessary data elements
+23 IF $DATA(RORUPD("SR",RORFILE,"F"))>1
Begin DoDot:2
+24 SET TMP=$$LOADVSIT(VISIENS)
if TMP<0
QUIT
+25 SET LOCATION=$$GETDE^RORUPDUT(RORFILE,129)
End DoDot:2
IF TMP<0
DO INCEC^RORUPDUT()
QUIT
+26 ;--- Apply "before" rules
+27 SET RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"B",DATE,$GET(LOCATION))
+28 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
+29 ;
+30 ;--- Process V POV file
+31 IF $DATA(RORUPD("SR",9000010.07))
Begin DoDot:2
+32 SET RC=$$VPOV(IEN,DATE,$GET(LOCATION))
End DoDot:2
IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
+33 ;
+34 ;--- Apply "after" rules
+35 SET RC=$$APLRULES^RORUPDUT(RORFILE,VISIENS,"A",DATE,$GET(LOCATION))
+36 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
End DoDot:1
if RC
QUIT
+37 ;
+38 KILL ^TMP("VSIT",$JOB)
+39 DO CLRDES^RORUPDUT(RORFILE)
+40 QUIT RC
+41 ;
+42 ;***** PROCESSING OF THE 'V POV' FILE
+43 ;
+44 ; VISITIEN IEN of the visit (in the "VISIT" file)
+45 ; DATE Visit date
+46 ; LOCATION Institution IEN
+47 ;
+48 ; Return values:
+49 ; <0 Error code
+50 ; 0 Continue processing of the current patient
+51 ; 1 Stop processing
+52 ;
VPOV(VISITIEN,DATE,LOCATION) ;
+1 ; File number
NEW RORFILE
+2 ; List of records in the file
NEW RORVPLST
+3 ;
+4 NEW IEN,NODE,RC,TMP,VPIENS
+5 SET RORFILE=9000010.07
+6 DO CLRVALS^RORUPDUT(RORFILE)
+7 ;--- Get a list of records
+8 DO POV^PXAPIIB(VISITIEN,.RORVPLST)
+9 ;
+10 SET (IEN,RC)=0
+11 FOR
SET IEN=$ORDER(RORVPLST(IEN))
if IEN=""
QUIT
Begin DoDot:1
+12 SET VPIENS=IEN_","
+13 ;--- Load necessary data elements
+14 IF $DATA(RORUPD("SR",RORFILE,"F"))>1
Begin DoDot:2
+15 SET TMP=$$LOADVPOV(VPIENS)
End DoDot:2
IF TMP<0
DO INCEC^RORUPDUT()
QUIT
+16 ;--- Apply "before" rules
+17 SET RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"B",DATE,LOCATION)
+18 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
+19 ;--- Apply "after" rules
+20 SET RC=$$APLRULES^RORUPDUT(RORFILE,VPIENS,"A",DATE,LOCATION)
+21 IF RC
DO INCEC^RORUPDUT(.RC)
QUIT
End DoDot:1
if RC
QUIT
+22 ;
+23 DO CLRDES^RORUPDUT(RORFILE)
+24 QUIT RC
+25 ;
ALLPAT(REGIEN) ;Is Visit/Admit Date/Time (#.01) less than 2 years old
+1 NEW RC,ROR2YRS
+2 SET RC=0
SET ROR2YRS=DT-20000
+3 IF $DATA(RORVALS("DV",9000010,155,"I"))
Begin DoDot:1
+4 IF RORVALS("DV",9000010,155,"I")>ROR2YRS
SET RC=1
End DoDot:1
+5 QUIT RC
+6 ;
