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

RORX006A.m

Go to the documentation of this file. 
  1. RORX006A ;HOIFO/BH,SG,VAC - LAB UTILIZATION (QUERY & SORT) ;4/7/09 2:07pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #2056         GET1^DIQ (supported)
  1.  ; 
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                 --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*8    MAR  2010   V CARR       Modified to handle ICD9 filter for
  1.  ;                                      'include' or 'exclude'.
  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   K GUPTA      Support for ICD-10 Coding System
  1.  ;ROR*1.5*21   SEP 2013    T KOPP       Add ICN column if Additional Identifier
  1.  ;                                       requested.
  1.  ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP , AGE/DOB as additional
  1.  ;                                       identifiers.
  1.  ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** LOADS AND PROCESSES THE LAB DATA
  1.  ;
  1.  ; DFN           Patient IEN (in file #2)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. LABDATA(DFN) ;
  1.  N DST,ENDT,NR,PTNO,PTNR,PRNT,RC,TSTIEN
  1.  S DST=$NA(^TMP("RORX006",$J))
  1.  ;
  1.  ;--- Get the data
  1.  S DST("RORCB")="$$LTSCB^RORX006A",DST("RORIDT")=""
  1.  S RC=$$LTSEARCH^RORUTL10(DFN,RORLTST,.DST,,RORSDT,ROREDT1)
  1.  Q:RC<0 RC  Q:$D(@DST@("PAT",DFN))<10 0
  1.  ;
  1.  ;--- Calculate intermediate totals of the tests
  1.  N PTNT ;added 'new' statement
  1.  S TSTIEN=0,(PTNR,PTNT)=0
  1.  F  S TSTIEN=$O(@DST@("PAT",DFN,"R",TSTIEN))  Q:TSTIEN'>0  D
  1.  . S NR=+$G(@DST@("PAT",DFN,"R",TSTIEN))
  1.  . S PTNR=PTNR+NR  ; Number of patient's results
  1.  . S PTNT=PTNT+1   ; Number of different tests
  1.  . ;---
  1.  . S @DST@("RES",TSTIEN,"P")=$G(@DST@("RES",TSTIEN,"P"))+1
  1.  . S @DST@("RES",TSTIEN,"R")=$G(@DST@("RES",TSTIEN,"R"))+NR
  1.  . ;---
  1.  . S TMP=$G(@DST@("RES",TSTIEN,"M"))
  1.  . D:NR'<TMP
  1.  . . I NR>TMP  S @DST@("RES",TSTIEN,"M")=NR_U_1  Q
  1.  . . S $P(@DST@("RES",TSTIEN,"M"),U,2)=$P(TMP,U,2)+1
  1.  ;
  1.  ;--- Orders
  1.  S @DST@("ORD")=$G(@DST@("ORD"))+$G(@DST@("PAT",DFN,"O"))
  1.  ;
  1.  ;--- Results
  1.  S @DST@("RES1",PTNR)=$G(@DST@("RES1",PTNR))+1
  1.  S @DST@("RES1",PTNR,RORPNAME,DFN)=""
  1.  ;
  1.  ;--- Other totals
  1.  S @DST@("PAT",DFN)=RORLAST4_U_RORDOD_U_$G(RORICN)_U_$G(RORPACT)_U_$G(RORPCP)_U_AGE
  1.  S @DST@("PAT",DFN,"R")=PTNR_U_PTNT
  1.  S @DST@("PAT")=$G(@DST@("PAT"))+1
  1.  S @DST@("RES")=$G(@DST@("RES"))+PTNR
  1.  Q 0
  1.  ;
  1.  ;***** LAB SEARCH CALLBACK
  1.  ;
  1.  ; .ROR8DST      Reference to the ROR8DST parameter.
  1.  ;
  1.  ; INVDT         IEN of the Lab test (inverted date)
  1.  ;
  1.  ; .RESULT       Reference to a local variable, which contains
  1.  ;               the result (see the $$LTSEARCH^RORUTL10).
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code (the search will be aborted)
  1.  ;        0  Ok
  1.  ;        1  Skip this result
  1.  ;        2  Skip this and all remaining results
  1.  ;
  1. LTSCB(ROR8DST,INVDT,RESULT) ;
  1.  N DFN,TMP,TSTIEN
  1.  S DFN=+ROR8DST("RORDFN"),TSTIEN=+RESULT(2)
  1.  ;--- Number of orders
  1.  I INVDT'=ROR8DST("RORIDT")  D  S ROR8DST("RORIDT")=INVDT
  1.  . S @ROR8DST@("PAT",DFN,"O")=$G(@ROR8DST@("PAT",DFN,"O"))+1
  1.  ;--- Number of results
  1.  S TMP=$G(@ROR8DST@("PAT",DFN,"R",TSTIEN))
  1.  S @ROR8DST@("PAT",DFN,"R",TSTIEN)=TMP+1
  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 RORDOD        ; Date of death of the current patient
  1.  N RORLAST4      ; Last 4 digits of the current patient's SSN
  1.  N RORPNAME      ; Name of the current patient
  1.  N RORPTN        ; Number of patients in the registry
  1.  N RORICN        ; National ICN of patient
  1.  N RORPACT       ; Primary Care Team
  1.  N RORPCP        ; Primary Care Physician
  1.  ;
  1.  N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE
  1.  N RCC,FLAG
  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.  N AGE,AGETYPE
  1.  ;
  1.  S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1.  S RORPTN=$$REGSIZE^RORUTL02(+RORREG)  S:RORPTN<0 RORPTN=0
  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.  S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  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 the 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.  . ;--- Check if ICD Filter Includes or Excludes Patient
  1.  . S RCC=0
  1.  . I FLAG'="ALL" D
  1.  . . S RCC=$$ICD^RORXU010(PATIEN)
  1.  . I (FLAG="INCLUDE")&(RCC=0) Q
  1.  . I (FLAG="EXCLUDE")&(RCC=1) Q
  1.  . ;--- End of ICD Filter check
  1.  . ;--- Check for Clinic or Division list and quit if not in list
  1.  . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
  1.  . ;--- Get the patient's data
  1.  . D VADEM^RORUTL05(PATIEN,1)
  1.  . S RORPNAME=VADM(1),RORLAST4="0000" ;VA("BID")
  1.  . S RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","ICN") S RORICN=$$ICN^RORUTL02(PATIEN)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PACT") S RORPACT=$$PACT^RORUTL02(PATIEN)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PCP") S RORPCP=$$PCP^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.  . ;
  1.  . ;--- Get the Lab data
  1.  . S RC=$$LABDATA(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 ECNT,IEN,NAME,NDLT,NODE,RC,RORMSG,TMP
  1.  S NODE=$NA(^TMP("RORX006",$J)),(ECNT,RC)=0
  1.  ;---
  1.  S RC=$$LOOP^RORTSK01(0)  Q:RC<0 RC
  1.  Q:$D(@NODE)<10 0
  1.  ;---
  1.  S IEN=0,NDLT=0
  1.  F  S IEN=$O(@NODE@("RES",IEN))  Q:IEN'>0  D
  1.  . S NDLT=NDLT+1
  1.  . K RORMSG S NAME=$$GET1^DIQ(60,IEN,.01,,,"RORMSG")
  1.  . ;D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,60,IEN)
  1.  . D:$G(RORMSG("DIERR")) DBS^RORERR("RORMSG",-9,,,60,IEN)
  1.  . S:NAME?." " NAME="Unknown ("_IEN_")"
  1.  . S TMP=+$G(@NODE@("RES",IEN,"R"))
  1.  . S @NODE@("RES","B",TMP,NAME,IEN)=""
  1.  ;--- Total numbers of Lab tests
  1.  S $P(@NODE@("RES"),U,2)=NDLT
  1.  ;---
  1.  Q $S(RC<0:RC,1:ECNT)