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

RORX013A.m

Go to the documentation of this file.
  1. RORX013A ;HCIOFO/SG - DIAGNOSIS CODES (QUERY & SORT) ;6/21/06 2:24pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;**1,13,19,21,25,31,34,39**;Feb 17, 2006;Build 4
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #928 ACTIVE^GMPLUTL (controlled)
  1. ; #1554 POV^PXAPIIB (controlled)
  1. ; #1905 SELECTED^VSIT (controlled)
  1. ; #2977 GETFLDS^GMPLEDT3 (controlled)
  1. ; #3157 RPC^DGPTFAPI (supported)
  1. ; #3545 Access to the "AAD" cross-reference and the field 80 (private)
  1. ; #92 ^DGPT(IEN,0) (controlled)
  1. ; #5747 $$CODEN^ICDEX, $$CODEC^ICDEX, $$VSTD^ICDEX (controlled)
  1. ; #6130 PTFICD^DGPTFUT
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
  1. ; clinics, or divisions for the report.
  1. ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System.
  1. ;ROR*1.5*21 SEP 2013 T KOPP Add Utilization date range to the report
  1. ; Add ICN to report, if requested
  1. ;ROR*1.5*25 OCT 2014 T KOPP Added PTF ICD-10 support for 25 diagnoses
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB as additional
  1. ; identifiers.
  1. ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_APPT and FUT_CLIN values
  1. ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;**** STORES THE ICD CODE
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ; SOURCE ICD source code ("I", "O", "PB")
  1. ; [ICDIEN] IEN of the ICD descriptor in file #80
  1. ; DATE Date when the code was entered
  1. ; [ICD] ICD code
  1. ;
  1. ; Either the ICDIEN or the ICD parameter must be provided.
  1. ;
  1. ICDSET(PATIEN,SOURCE,ICDIEN,DATE,ICD) ;
  1. Q:DATE'>0
  1. N TMP
  1. S ICDIEN=+$G(ICDIEN)
  1. I ICDIEN'>0 Q:$G(ICD)="" D Q:ICDIEN'>0
  1. . S ICDIEN=+$$CODEN^ICDEX(ICD,80)
  1. ;---
  1. Q:$$ICDGRCHK^RORXU008(.RORPTGRP,ICDIEN,RORICDL)
  1. ;---
  1. S TMP=+$G(@RORTMP@("PAT",PATIEN,ICDIEN))
  1. S:'TMP!(DATE<TMP) @RORTMP@("PAT",PATIEN,ICDIEN)=DATE_U_SOURCE
  1. S ^(SOURCE)=$G(@RORTMP@("PAT",PATIEN,ICDIEN,SOURCE))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
  1. Q
  1. ;
  1. ;***** SEARCHES FOR INPATIENT DIAGNOSES
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. INPAT(PATIEN) ;
  1. N ADMDT,DISDT,I,IEN,NODE,RC,RORBUF,RORMSG,DIERR,TMP
  1. S NODE=$NA(^DGPT("AAD",+PATIEN))
  1. S RC=0
  1. ;--- Browse through the admissions
  1. S ADMDT=ROREDT1
  1. F S ADMDT=$O(@NODE@(ADMDT),-1) Q:ADMDT'>0 D Q:RC
  1. . S IEN=""
  1. . F S IEN=$O(@NODE@(ADMDT,IEN),-1) Q:IEN'>0 D Q:RC
  1. . . Q:+$G(^DGPT(IEN,0))'=PATIEN
  1. . . Q:$$PTF^RORXU001(IEN,"FP",,.DISDT)
  1. . . ;--- Skip invalid and/or incomplete admissions
  1. . . I DISDT'>0 D Q:TMP!(DISDT'>0)
  1. . . . S TMP=$$CHKADM^RORXU001(PATIEN,ADMDT,.DISDT)
  1. . . ;--- Check if any appropriate admissions are left
  1. . . I DISDT<RORSDT S RC=1 Q
  1. . . Q:DISDT'<ROREDT1
  1. . . ;--- Load and process the admission data
  1. . . K RORBUF D RPC^DGPTFAPI(.RORBUF,IEN)
  1. . . I $G(RORBUF(0))<0 D Q
  1. . . . D ERROR^RORERR(-57,,,,RORBUF(0),"RPC^DGPTFAPI")
  1. . . S TMP=$P($G(RORBUF(1)),U,3)
  1. . . D:TMP'="" ICDSET(PATIEN,"I",,DISDT,TMP) ; ICD1
  1. . . D:$G(RORBUF(2))'="" ; ICD2 - ICD24
  1. . . . F I=1:1:24 S TMP=$P(RORBUF(2),U,I) D:TMP'=""
  1. . . . . D ICDSET(PATIEN,"I",,DISDT,TMP)
  1. . . S TMP=+$$GET1^DIQ(45,IEN,80,"I",,"RORMSG")
  1. . . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,45,IEN)
  1. . . D:TMP>0 ICDSET(PATIEN,"I",TMP,DISDT) ; PRINCIPAL DIAGNOSIS
  1. ;---
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** SEARCHES FOR OUTPATIENT DIAGNOSES
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. OUTPAT(PATIEN) ;
  1. N DATE,ICDIEN,RC,RORMSG,RORVPLST,TMP,VPIEN,VSIEN,VSIT
  1. D SELECTED^VSIT(PATIEN,RORSDT,ROREDT)
  1. ;--- Browse through the visits
  1. S (VSIEN,RC)=0
  1. F S VSIEN=$O(^TMP("VSIT",$J,VSIEN)) Q:VSIEN="" D Q:RC<0
  1. . S TMP=+$O(^TMP("VSIT",$J,VSIEN,"")) Q:TMP'>0
  1. . S DATE=$P($G(^TMP("VSIT",$J,VSIEN,TMP)),U) Q:DATE'>0
  1. . ;--- Get a list of V POV records
  1. . D POV^PXAPIIB(VSIEN,.RORVPLST)
  1. . ;--- Process the records
  1. . S (VPIEN,RC)=0
  1. . F S VPIEN=$O(RORVPLST(VPIEN)) Q:VPIEN'>0 D Q:RC
  1. . . S ICDIEN=+$P(RORVPLST(VPIEN),U)
  1. . . D:ICDIEN>0 ICDSET(PATIEN,"O",ICDIEN,DATE)
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** SEARCHES FOR PROBLEMS
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. PROBLEM(PATIEN) ;
  1. N DATE,GMPFLD,GMPORIG,GMPROV,GMPVAMC,ICDIEN,IEN,IS,RC,RORPLST,TMP
  1. ;--- Load a list of active problems
  1. D ACTIVE^GMPLUTL(PATIEN,.RORPLST)
  1. ;--- Browse through the problems
  1. S (GMPVAMC,GMPROV)=0
  1. S (IS,RC)=0
  1. F S IS=$O(RORPLST(IS)) Q:IS="" D Q:RC
  1. . S IEN=+$G(RORPLST(IS,0)) Q:IEN'>0
  1. . K GMPFLD,GMPORIG D GETFLDS^GMPLEDT3(IEN)
  1. . S ICDIEN=+$G(GMPFLD(.01)) Q:ICDIEN'>0
  1. . S DATE=$P($G(GMPFLD(.08)),U)
  1. . D:(DATE'<RORSDT)&(DATE<ROREDT1) ICDSET(PATIEN,"PB",ICDIEN,DATE)
  1. Q 0
  1. ;
  1. ;***** QUERIES THE REGISTRY
  1. ;
  1. ; FLAGS Flags for the $$SKIP^RORXU005
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. QUERY(FLAGS) ;
  1. N RORAPPTINFO ; Future appointmentdate_U_clinicname
  1. N RORAPPT ; Future appointment date
  1. N RORCLIN ; Future appointment clinic name
  1. N RORDOD ; Date of death
  1. N ROREDT1 ; Day after the end date
  1. N RORLAST4 ; Last 4 digits of the current patient's SSN
  1. N RORPNAME ; Name of the current patient
  1. N RORICN ; ICN of patient (optional)
  1. N RORPACT ; PACT of patient (optional)
  1. N RORPCP ; PCP of patient (optional)
  1. N RORPTGRP ; Temporary list of ICD groups
  1. N RORPTN ; Number of patients in the registry
  1. N RORCDLIST ; Flag to indicate whether a clinic or division list exists
  1. N RORCDSTDT ; Start date for clinic/division utilization search
  1. N RORCDENDT ; End date for clinic/division utilization search
  1. ;
  1. N CNT,ECNT,IEN,IENS,PATIEN,RC,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE,AGE,AGETYPE
  1. ;--- Utilization date range
  1. D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
  1. . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
  1. . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
  1. . ;--- Combined date range
  1. . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
  1. . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
  1. S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1. S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
  1. S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
  1. S (CNT,ECNT,RC)=0
  1. ;
  1. ;=== Set up Clinic/Division list parameters
  1. S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
  1. ;
  1. ;--- Browse through the registry records
  1. S IEN=0
  1. F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
  1. . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
  1. . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
  1. . S IENS=IEN_",",CNT=CNT+1
  1. . ;--- Get patient DFN
  1. . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
  1. . ;check for patient list and quit if not on list
  1. . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
  1. . ;--- Check if the patient should be skipped
  1. . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
  1. . ;
  1. . ;--- Check for Clinic or Division list and quit if not in list
  1. . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
  1. . ;
  1. . ;--- Check for any utilization in the corresponding date range
  1. . I $$PARAM^RORTSK01("PATIENTS","CAREONLY") D Q:'UTIL
  1. . . K TMP S TMP("ALL")=1
  1. . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
  1. . ;
  1. . M RORPTGRP=RORIGRP("C")
  1. . ;
  1. . ;--- Inpatient codes
  1. . S RC=$$INPAT(PATIEN)
  1. . I RC Q:RC<0 S ECNT=ECNT+RC
  1. . ;
  1. . ;--- Outpatient codes
  1. . S RC=$$OUTPAT(PATIEN)
  1. . I RC Q:RC<0 S ECNT=ECNT+RC
  1. . ;
  1. . ;--- Problem list
  1. . S RC=$$PROBLEM(PATIEN)
  1. . I RC Q:RC<0 S ECNT=ECNT+RC
  1. . ;
  1. . ;--- Skip the patient if no data has been found
  1. . Q:$D(@RORTMP@("PAT",PATIEN))<10
  1. . ;--- No ICD from some groups
  1. . I $D(RORPTGRP)>1 K @RORTMP@("PAT",PATIEN) Q
  1. . ;
  1. . ;--- Get the patient's data
  1. . D VADEM^RORUTL05(PATIEN,1)
  1. . S RORPNAME=VADM(1),RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1),RORLAST4="0000"
  1. . I $$PARAM^RORTSK01("PATIENTS","ICN") S RORICN=$$ICN^RORUTL02(PATIEN)
  1. . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1. . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
  1. . I $$PARAM^RORTSK01("PATIENTS","PACT") S RORPACT=$$PACT^RORUTL02(PATIEN)
  1. . I $$PARAM^RORTSK01("PATIENTS","PCP") S RORPCP=$$PCP^RORUTL02(PATIEN)
  1. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D ;patch 34
  1. . . S RORAPPTINFO=$$FUTAPPT^RORUTL02(PATIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
  1. . . S RORAPPT=$P(RORAPPTINFO,U,1),RORCLIN=$P(RORAPPTINFO,U,2)
  1. . ;--- Calculate the patient's totals
  1. . S RC=$$TOTALS(PATIEN)
  1. . I RC Q:RC<0 S ECNT=ECNT+RC
  1. ;---
  1. Q $S(RC<0:RC,1:ECNT)
  1. ;
  1. ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. SORT() ;
  1. N ICDIEN,TMP,TNC,TNDC
  1. ;---
  1. S ICDIEN=0,(TNC,TNDC)=0
  1. F S ICDIEN=$O(@RORTMP@("ICD",ICDIEN)) Q:ICDIEN'>0 D
  1. . S TNC=TNC+$G(@RORTMP@("ICD",ICDIEN,"C"))
  1. . S TNDC=TNDC+1
  1. S @RORTMP@("ICD")=TNC_U_TNDC
  1. ;---
  1. Q 0
  1. ;
  1. ;***** CALCULATES INTERMEDIATE TOTALS
  1. ;
  1. ; PATIEN Patient IEN (DFN)
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. TOTALS(PATIEN) ;
  1. N CNT,ICD,ICDIEN,ICDVST,PNODE,RC,TMP
  1. S PNODE=$NA(@RORTMP@("PAT",PATIEN))
  1. S @PNODE=RORLAST4_U_RORPNAME_U_RORDOD_U_$G(RORICN)_U_$G(RORPACT)_U_$G(RORPCP)_U_AGE_U_$G(RORAPPT)_U_$G(RORCLIN)
  1. S ^("PAT")=$G(@RORTMP@("PAT"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
  1. ;
  1. S ICDIEN=0
  1. F S ICDIEN=$O(@PNODE@(ICDIEN)) Q:ICDIEN'>0 D
  1. . S ICD=$P($G(@RORTMP@("ICD",ICDIEN)),U)
  1. . I ICD="" D
  1. . . S ICD=$$CODEC^ICDEX(80,ICDIEN)
  1. . . S ICDVST=$$VSTD^ICDEX(ICDIEN)
  1. . . S:ICD="" ICD="UNKN"
  1. . . S:ICDVST="" ICDVST="Unknown ("_ICDIEN_")"
  1. . . S @RORTMP@("ICD",ICDIEN)=ICD_U_ICDVST
  1. . ;---
  1. . S CNT=0
  1. . F TMP="I","O","PB" S CNT=CNT+$G(@PNODE@(ICDIEN,TMP))
  1. . S @PNODE@(ICDIEN,"C")=CNT
  1. . S ^("C")=$G(@RORTMP@("ICD",ICDIEN,"C"))+CNT ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
  1. . S ^("P")=$G(@RORTMP@("ICD",ICDIEN,"P"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX013
  1. Q 0