Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORUPD09

RORUPD09.m

Go to the documentation of this file.
  1. RORUPD09 ;HCIOFO/SG - PROCESSING OF THE 'PTF' FILE ;8/3/05 9:50am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**18,25,26,37**;Feb 17, 2006;Build 9
  1. ;
  1. ;*****************************************************************************
  1. ;*****************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*18 APR 2012 C RAY Modified PTF RULE to use B xref #798.5
  1. ;ROR*1.5*25 FEB 2015 T KOPP Modified PTF rule to add new Diagnosis
  1. ; fields for ICD-10 PTF expansion.
  1. ;ROR*1.5*26 MAR 2015 T KOPP Added rule for PTF procedure codes check
  1. ; in API #3
  1. ;ROR*1.5*37 SEP 2020 F TRAXLER Added ALLPAT subroutine
  1. ;*****************************************************************************
  1. ;*****************************************************************************
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #3157 RPC^DGPTFAPI
  1. ; #3545 Access to the "AAD" cross-reference and the field 80
  1. ; #10103 $$FMADD^XLFDT (supported)
  1. ; #2171 $$IEN^XUAF4 (supported)
  1. ;
  1. ;
  1. Q
  1. ;
  1. ;***** LOADS DATA ELEMENT VALUES
  1. ;
  1. ; IENS IENS of the current record
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. LOAD(IENS) ;
  1. N RC S RC=0
  1. ;--- API #1 or #3
  1. I $S($D(RORUPD("SR",RORFILE,"F",1)):1,1:$D(RORUPD("SR",RORFILE,"F",3))) D Q:RC<0 RC
  1. . S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
  1. ;--- API #2
  1. I $D(RORUPD("SR",RORFILE,"F",2)) D Q:RC<0 RC
  1. . N API,DE,IN,IP,RORBUF,VT
  1. . D RPC^DGPTFAPI(.RORBUF,+IENS)
  1. . I $G(RORBUF(0))<0 S API="RPC^DGPTFAPI" D Q
  1. . . S RC=$$ERROR^RORERR(-57,,,,RORBUF(0),API)
  1. . ;---
  1. . S DE=""
  1. . F S DE=$O(RORUPD("SR",RORFILE,"F",2,DE)) Q:DE="" D
  1. . . S VT=""
  1. . . F S VT=$O(RORUPD("SR",RORFILE,"F",2,DE,VT)) Q:VT="" D
  1. . . . S IP=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,1) Q:IP'>0
  1. . . . S IN=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
  1. . . . S RORVALS("DV",RORFILE,DE,VT)=$P($G(RORBUF(IN)),U,IP)
  1. Q 0
  1. ;
  1. ;***** PROCESSING OF THE 'PTF' FILE
  1. ;
  1. ; UPDSTART Date of the earliest update
  1. ; PATIEN Patient IEN
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Continue processing of the current patient
  1. ; 1 Stop processing
  1. ;
  1. PTF(UPDSTART,PATIEN) ;
  1. N RORFILE ; File number
  1. ;
  1. N ADMDT,ADMIENS,EDT,IEN,LOCATION,NODE,RC,TMP
  1. S RORFILE=45,EDT=RORUPD("DSEND")
  1. ;--- Check the event references if the events are enabled
  1. I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
  1. . S RC=$$GET^RORUPP02(PATIEN,3,.UPDSTART,.EDT)
  1. . S:RC>1 UPDSTART=UPDSTART\1,EDT=$$FMADD^XLFDT(EDT\1,1)
  1. ;--- Subtract 1 second from the start date to include
  1. ; it into the interval
  1. S ADMDT=$$FMADD^XLFDT(UPDSTART,,,,-1)
  1. ;
  1. ;--- Browse through the admissions
  1. S NODE=RORUPD("ROOT",RORFILE),NODE=$NA(@NODE@("AAD",PATIEN))
  1. S RC=0
  1. F S ADMDT=$O(@NODE@(ADMDT)) Q:(ADMDT="")!(ADMDT'<EDT) D Q:RC
  1. . S IEN=""
  1. . F S IEN=$O(@NODE@(ADMDT,IEN)) Q:IEN="" D Q:RC
  1. . . S ADMIENS=IEN_","
  1. . . ;--- Load necessary data elements
  1. . . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
  1. . . . S TMP=$$LOAD(ADMIENS)
  1. . . . S TMP=$$GETDE^RORUPDUT(45,131)_$$GETDE^RORUPDUT(45,132)
  1. . . . S LOCATION=$S(TMP'="":$$IEN^XUAF4(TMP),1:"")
  1. . . ;--- Apply "before" rules
  1. . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"B",ADMDT,$G(LOCATION))
  1. . . I RC D INCEC^RORUPDUT(.RC) Q
  1. . . ;--- Apply "after" rules
  1. . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"A",ADMDT,$G(LOCATION))
  1. . . I RC D INCEC^RORUPDUT(.RC) Q
  1. ;
  1. D CLRDES^RORUPDUT(RORFILE)
  1. Q RC
  1. ;
  1. ;***** IMPLEMENTATION OF THE 'PTF' Diagnosis RULE
  1. PTFRULE(ICD) ;
  1. N DATELMT,RC
  1. S RC=0
  1. F DATELMT=111,101:1:110,131:1:147 D Q:RC
  1. . S RC=+$D(^ROR(798.5,REGIEN,1,"B",+$G(RORVALS("DV",45,DATELMT,"I"))))
  1. Q RC
  1. ;
  1. ;***** IMPLEMENTATION OF THE 'PTF' Procedure RULE for ICD and CPT
  1. PTFRULE1(REGIEN) ;
  1. N ROR
  1. S RC=0
  1. I $D(^ROR(798.5,REGIEN,2,"B")) D Q:RC ;ICD procedure codes
  1. . S ROR=0 F S ROR=$O(RORVALS("PPTF","I",ROR)) Q:'ROR I +$D(^ROR(798.5,REGIEN,2,"B",+$G(RORVALS("PPTF","I",ROR,"I")))) S RC=1 Q
  1. I 'RC,$D(^ROR(798.5,REGIEN,3,"B")) D ;CPT procedure codes
  1. . S ROR=0 F S ROR=$O(RORVALS("PPTF","C",ROR)) Q:'ROR I +$D(^ROR(798.5,REGIEN,3,"B",+$G(RORVALS("PPTF","C",ROR,"I")))) S RC=1 Q
  1. Q RC
  1. ;
  1. ALLPAT(REGIEN) ;Is Admission Date (#2) value less than 2 years old
  1. N RC,ROR2YRS
  1. S RC=0,ROR2YRS=DT-20000
  1. I $D(RORVALS("DV",45,154,"I")) D
  1. . I RORVALS("DV",45,154,"I")>ROR2YRS S RC=1
  1. Q RC
  1. ;