- RORUPD09 ;HCIOFO/SG - PROCESSING OF THE 'PTF' FILE ;8/3/05 9:50am
- ;;1.5;CLINICAL CASE REGISTRIES;**18,25,26,37**;Feb 17, 2006;Build 9
- ;
- ;*****************************************************************************
- ;*****************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- ----------------------------------------
- ;ROR*1.5*18 APR 2012 C RAY Modified PTF RULE to use B xref #798.5
- ;ROR*1.5*25 FEB 2015 T KOPP Modified PTF rule to add new Diagnosis
- ; fields for ICD-10 PTF expansion.
- ;ROR*1.5*26 MAR 2015 T KOPP Added rule for PTF procedure codes check
- ; in API #3
- ;ROR*1.5*37 SEP 2020 F TRAXLER Added ALLPAT subroutine
- ;*****************************************************************************
- ;*****************************************************************************
- ; This routine uses the following IAs:
- ;
- ; #3157 RPC^DGPTFAPI
- ; #3545 Access to the "AAD" cross-reference and the field 80
- ; #10103 $$FMADD^XLFDT (supported)
- ; #2171 $$IEN^XUAF4 (supported)
- ;
- ;
- Q
- ;
- ;***** LOADS DATA ELEMENT VALUES
- ;
- ; IENS IENS of the current record
- ;
- ; Return values:
- ; <0 Error code
- ; 0 Ok
- ;
- LOAD(IENS) ;
- N RC S RC=0
- ;--- API #1 or #3
- I $S($D(RORUPD("SR",RORFILE,"F",1)):1,1:$D(RORUPD("SR",RORFILE,"F",3))) 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,RORBUF,VT
- . D RPC^DGPTFAPI(.RORBUF,+IENS)
- . I $G(RORBUF(0))<0 S API="RPC^DGPTFAPI" D Q
- . . S RC=$$ERROR^RORERR(-57,,,,RORBUF(0),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,1) Q:IP'>0
- . . . S IN=+$P(RORUPD("SR",RORFILE,"F",2,DE,VT),U,2)
- . . . S RORVALS("DV",RORFILE,DE,VT)=$P($G(RORBUF(IN)),U,IP)
- Q 0
- ;
- ;***** PROCESSING OF THE 'PTF' 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
- ;
- PTF(UPDSTART,PATIEN) ;
- N RORFILE ; File number
- ;
- N ADMDT,ADMIENS,EDT,IEN,LOCATION,NODE,RC,TMP
- S RORFILE=45,EDT=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,3,.UPDSTART,.EDT)
- . S:RC>1 UPDSTART=UPDSTART\1,EDT=$$FMADD^XLFDT(EDT\1,1)
- ;--- Subtract 1 second from the start date to include
- ; it into the interval
- S ADMDT=$$FMADD^XLFDT(UPDSTART,,,,-1)
- ;
- ;--- Browse through the admissions
- S NODE=RORUPD("ROOT",RORFILE),NODE=$NA(@NODE@("AAD",PATIEN))
- S RC=0
- F S ADMDT=$O(@NODE@(ADMDT)) Q:(ADMDT="")!(ADMDT'<EDT) D Q:RC
- . S IEN=""
- . F S IEN=$O(@NODE@(ADMDT,IEN)) Q:IEN="" D Q:RC
- . . S ADMIENS=IEN_","
- . . ;--- Load necessary data elements
- . . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
- . . . S TMP=$$LOAD(ADMIENS)
- . . . S TMP=$$GETDE^RORUPDUT(45,131)_$$GETDE^RORUPDUT(45,132)
- . . . S LOCATION=$S(TMP'="":$$IEN^XUAF4(TMP),1:"")
- . . ;--- Apply "before" rules
- . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"B",ADMDT,$G(LOCATION))
- . . I RC D INCEC^RORUPDUT(.RC) Q
- . . ;--- Apply "after" rules
- . . S RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"A",ADMDT,$G(LOCATION))
- . . I RC D INCEC^RORUPDUT(.RC) Q
- ;
- D CLRDES^RORUPDUT(RORFILE)
- Q RC
- ;
- ;***** IMPLEMENTATION OF THE 'PTF' Diagnosis RULE
- PTFRULE(ICD) ;
- N DATELMT,RC
- S RC=0
- F DATELMT=111,101:1:110,131:1:147 D Q:RC
- . S RC=+$D(^ROR(798.5,REGIEN,1,"B",+$G(RORVALS("DV",45,DATELMT,"I"))))
- Q RC
- ;
- ;***** IMPLEMENTATION OF THE 'PTF' Procedure RULE for ICD and CPT
- PTFRULE1(REGIEN) ;
- N ROR
- S RC=0
- I $D(^ROR(798.5,REGIEN,2,"B")) D Q:RC ;ICD procedure codes
- . 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
- I 'RC,$D(^ROR(798.5,REGIEN,3,"B")) D ;CPT procedure codes
- . 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
- Q RC
- ;
- ALLPAT(REGIEN) ;Is Admission Date (#2) value less than 2 years old
- N RC,ROR2YRS
- S RC=0,ROR2YRS=DT-20000
- I $D(RORVALS("DV",45,154,"I")) D
- . I RORVALS("DV",45,154,"I")>ROR2YRS S RC=1
- Q RC
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD09 4767 printed Jan 18, 2025@02:44:58 Page 2
- 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
- +2 ;
- +3 ;*****************************************************************************
- +4 ;*****************************************************************************
- +5 ; --- ROUTINE MODIFICATION LOG ---
- +6 ;
- +7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +8 ;----------- ---------- ----------- ----------------------------------------
- +9 ;ROR*1.5*18 APR 2012 C RAY Modified PTF RULE to use B xref #798.5
- +10 ;ROR*1.5*25 FEB 2015 T KOPP Modified PTF rule to add new Diagnosis
- +11 ; fields for ICD-10 PTF expansion.
- +12 ;ROR*1.5*26 MAR 2015 T KOPP Added rule for PTF procedure codes check
- +13 ; in API #3
- +14 ;ROR*1.5*37 SEP 2020 F TRAXLER Added ALLPAT subroutine
- +15 ;*****************************************************************************
- +16 ;*****************************************************************************
- +17 ; This routine uses the following IAs:
- +18 ;
- +19 ; #3157 RPC^DGPTFAPI
- +20 ; #3545 Access to the "AAD" cross-reference and the field 80
- +21 ; #10103 $$FMADD^XLFDT (supported)
- +22 ; #2171 $$IEN^XUAF4 (supported)
- +23 ;
- +24 ;
- +25 QUIT
- +26 ;
- +27 ;***** LOADS DATA ELEMENT VALUES
- +28 ;
- +29 ; IENS IENS of the current record
- +30 ;
- +31 ; Return values:
- +32 ; <0 Error code
- +33 ; 0 Ok
- +34 ;
- LOAD(IENS) ;
- +1 NEW RC
- SET RC=0
- +2 ;--- API #1 or #3
- +3 IF $SELECT($DATA(RORUPD("SR",RORFILE,"F",1)):1,1:$DATA(RORUPD("SR",RORFILE,"F",3)))
- 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,RORBUF,VT
- +8 DO RPC^DGPTFAPI(.RORBUF,+IENS)
- +9 IF $GET(RORBUF(0))<0
- SET API="RPC^DGPTFAPI"
- Begin DoDot:2
- +10 SET RC=$$ERROR^RORERR(-57,,,,RORBUF(0),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,1)
- 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(RORBUF(IN)),U,IP)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if RC<0
- QUIT RC
- +19 QUIT 0
- +20 ;
- +21 ;***** PROCESSING OF THE 'PTF' FILE
- +22 ;
- +23 ; UPDSTART Date of the earliest update
- +24 ; PATIEN Patient IEN
- +25 ;
- +26 ; Return values:
- +27 ; <0 Error code
- +28 ; 0 Continue processing of the current patient
- +29 ; 1 Stop processing
- +30 ;
- PTF(UPDSTART,PATIEN) ;
- +1 ; File number
- NEW RORFILE
- +2 ;
- +3 NEW ADMDT,ADMIENS,EDT,IEN,LOCATION,NODE,RC,TMP
- +4 SET RORFILE=45
- SET EDT=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,3,.UPDSTART,.EDT)
- +8 if RC>1
- SET UPDSTART=UPDSTART\1
- SET EDT=$$FMADD^XLFDT(EDT\1,1)
- End DoDot:1
- if RC'>0
- QUIT RC
- +9 ;--- Subtract 1 second from the start date to include
- +10 ; it into the interval
- +11 SET ADMDT=$$FMADD^XLFDT(UPDSTART,,,,-1)
- +12 ;
- +13 ;--- Browse through the admissions
- +14 SET NODE=RORUPD("ROOT",RORFILE)
- SET NODE=$NAME(@NODE@("AAD",PATIEN))
- +15 SET RC=0
- +16 FOR
- SET ADMDT=$ORDER(@NODE@(ADMDT))
- if (ADMDT="")!(ADMDT'<EDT)
- QUIT
- Begin DoDot:1
- +17 SET IEN=""
- +18 FOR
- SET IEN=$ORDER(@NODE@(ADMDT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:2
- +19 SET ADMIENS=IEN_","
- +20 ;--- Load necessary data elements
- +21 IF $DATA(RORUPD("SR",RORFILE,"F"))>1
- Begin DoDot:3
- +22 SET TMP=$$LOAD(ADMIENS)
- +23 SET TMP=$$GETDE^RORUPDUT(45,131)_$$GETDE^RORUPDUT(45,132)
- +24 SET LOCATION=$SELECT(TMP'="":$$IEN^XUAF4(TMP),1:"")
- End DoDot:3
- IF TMP<0
- DO INCEC^RORUPDUT()
- QUIT
- +25 ;--- Apply "before" rules
- +26 SET RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"B",ADMDT,$GET(LOCATION))
- +27 IF RC
- DO INCEC^RORUPDUT(.RC)
- QUIT
- +28 ;--- Apply "after" rules
- +29 SET RC=$$APLRULES^RORUPDUT(RORFILE,ADMIENS,"A",ADMDT,$GET(LOCATION))
- +30 IF RC
- DO INCEC^RORUPDUT(.RC)
- QUIT
- End DoDot:2
- if RC
- QUIT
- End DoDot:1
- if RC
- QUIT
- +31 ;
- +32 DO CLRDES^RORUPDUT(RORFILE)
- +33 QUIT RC
- +34 ;
- +35 ;***** IMPLEMENTATION OF THE 'PTF' Diagnosis RULE
- PTFRULE(ICD) ;
- +1 NEW DATELMT,RC
- +2 SET RC=0
- +3 FOR DATELMT=111,101:1:110,131:1:147
- Begin DoDot:1
- +4 SET RC=+$DATA(^ROR(798.5,REGIEN,1,"B",+$GET(RORVALS("DV",45,DATELMT,"I"))))
- End DoDot:1
- if RC
- QUIT
- +5 QUIT RC
- +6 ;
- +7 ;***** IMPLEMENTATION OF THE 'PTF' Procedure RULE for ICD and CPT
- PTFRULE1(REGIEN) ;
- +1 NEW ROR
- +2 SET RC=0
- +3 ;ICD procedure codes
- IF $DATA(^ROR(798.5,REGIEN,2,"B"))
- Begin DoDot:1
- +4 SET ROR=0
- FOR
- SET ROR=$ORDER(RORVALS("PPTF","I",ROR))
- if 'ROR
- QUIT
- IF +$DATA(^ROR(798.5,REGIEN,2,"B",+$GET(RORVALS("PPTF","I",ROR,"I"))))
- SET RC=1
- QUIT
- End DoDot:1
- if RC
- QUIT
- +5 ;CPT procedure codes
- IF 'RC
- IF $DATA(^ROR(798.5,REGIEN,3,"B"))
- Begin DoDot:1
- +6 SET ROR=0
- FOR
- SET ROR=$ORDER(RORVALS("PPTF","C",ROR))
- if 'ROR
- QUIT
- IF +$DATA(^ROR(798.5,REGIEN,3,"B",+$GET(RORVALS("PPTF","C",ROR,"I"))))
- SET RC=1
- QUIT
- End DoDot:1
- +7 QUIT RC
- +8 ;
- ALLPAT(REGIEN) ;Is Admission Date (#2) value less than 2 years old
- +1 NEW RC,ROR2YRS
- +2 SET RC=0
- SET ROR2YRS=DT-20000
- +3 IF $DATA(RORVALS("DV",45,154,"I"))
- Begin DoDot:1
- +4 IF RORVALS("DV",45,154,"I")>ROR2YRS
- SET RC=1
- End DoDot:1
- +5 QUIT RC
- +6 ;