- 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 Apr 23, 2025@17:58:10 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 ;
