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

RORX001.m

Go to the documentation of this file.
  1. RORX001 ;HOIFO/SG,VAC - LIST OF REGISTRY PATIENTS ;4/16/09 11:53am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**8,10,14,17,19,21,31,39**;Feb 17, 2006;Build 4
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #2051 LIST^DIC (supported)
  1. ; #2056 GET1^DIQ, GETS^DIQ (supported)
  1. ; #10061 DEM^VADPT (supported)
  1. ; #10103 FMADD^XLFDT (supported)
  1. ;
  1. ; This routine modified March 2009 to handle ICD9 Filter for Include
  1. ; or Exclude
  1. Q
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*14 APR 2011 A SAUNDERS Added column and data for 'FIRSTDIAG'.
  1. ;ROR*1.5*17 AUG 2011 C RAY Added params 'CONFIRM_AFTER', 'CONFDT_AFTER'
  1. ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
  1. ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
  1. ; additional identifier option selected
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional identifiers.
  1. ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. ;***** OUTPUTS THE REPORT HEADER
  1. ;
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. N COL,COLUMNS,HEADER,TMP,AGETYPE
  1. S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
  1. S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
  1. D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
  1. S RORFLDS=".01"
  1. ;--- Required columns
  1. F COL="#","NAME" D
  1. . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
  1. . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
  1. ;--- Age/DOB header if needed
  1. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
  1. . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
  1. . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",AGETYPE)
  1. ;
  1. ;--- Additional columns
  1. F COL="DOD","CSSN","LAST4","SELRULES","SELDT","CONFDT","PENDCOMM","FIRSTDIAG" D
  1. . Q:'$$OPTCOL^RORXU006(COL)
  1. . S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
  1. . D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
  1. ; --- ICN if selected must be last column on report
  1. I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNHDR^RORXU006(RORTSK,COLUMNS)
  1. I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTHDR^RORXU006(RORTSK,COLUMNS)
  1. I $$PARAM^RORTSK01("PATIENTS","PCP") D PCPHDR^RORXU006(RORTSK,COLUMNS)
  1. ;---
  1. S:$$OPTCOL^RORXU006("CONFDT") RORFLDS=RORFLDS_";2"
  1. S:$$OPTCOL^RORXU006("SELDT") RORFLDS=RORFLDS_";3.2"
  1. S:$$OPTCOL^RORXU006("PENDCOMM") RORFLDS=RORFLDS_";12"
  1. Q 0
  1. ;
  1. ;***** ADDS THE PATIENT DATA TO THE REPORT
  1. ;
  1. ; IENS IENS of the patient's record in the registry
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. PATIENT(IENS,PARTAG) ;
  1. N DFN,IATIME,NAME,RC,RORBUF,RORMSG,TMP,VA,VADM,VAHOW,VAROOT,PTAG,AGETYPE,AGE
  1. K RORMSG D GETS^DIQ(798,IENS,RORFLDS,"I","RORBUF","RORMSG")
  1. Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
  1. S DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. ;--- Load the demographic data
  1. D DEM^VADPT
  1. ;--- The <PATIENT> tag
  1. S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
  1. ;--- Patient Name
  1. D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
  1. ;--- Age/DOB
  1. I $$PARAM^RORTSK01("AGE_RANGE","TYPE")'="ALL" S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
  1. . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
  1. . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
  1. ;
  1. ;--- Date of Death
  1. D:$$OPTCOL^RORXU006("DOD")
  1. . S TMP=$$DATE^RORXU002(VADM(6)\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
  1. ;--- Coded SSN
  1. D:$$OPTCOL^RORXU006("CSSN")
  1. . S TMP="000000000"
  1. . D ADDVAL^RORTSK11(RORTSK,"CSSN",TMP,PTAG,1)
  1. ;--- Last 4 digits of the SSN
  1. D:$$OPTCOL^RORXU006("LAST4")
  1. . S VA("BID")="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
  1. ;--- Selection Rules
  1. I $$OPTCOL^RORXU006("SELRULES") D Q:RC<0 RC
  1. . S RC=$$SELRULES(IENS,PTAG)
  1. ;--- Date Selected for the Registry
  1. D:$$OPTCOL^RORXU006("SELDT")
  1. . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,3.2,"I"))\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"SELDT",TMP,PTAG,1)
  1. ;--- Date Confirmed in the Registry
  1. D:$$OPTCOL^RORXU006("CONFDT")
  1. . S TMP=$$DATE^RORXU002($G(RORBUF(798,IENS,2,"I"))\1)
  1. . D ADDVAL^RORTSK11(RORTSK,"CONFDT",TMP,PTAG,1)
  1. ;--- Pending Comment
  1. D:$$OPTCOL^RORXU006("PENDCOMM")
  1. . S TMP=$G(RORBUF(798,IENS,12,"I"))
  1. . S TMP=$S($L(TMP)>0:TMP,1:"")
  1. . D ADDVAL^RORTSK11(RORTSK,"PENDCOMM",TMP,PTAG,1)
  1. ;--- First Healthcare Setting to Diagnose HIV
  1. D:$$OPTCOL^RORXU006("FIRSTDIAG")
  1. . K RORBUF,RORMSG D GETS^DIQ(799.4,IENS,12.08,"I","RORBUF","RORMSG")
  1. . S TMP=$G(RORBUF(799.4,IENS,12.08,"I"))
  1. . S TMP=$S($G(TMP)=1:"Yes",$G(TMP)=0:"No",$G(TMP)=9:"Unknown",1:"")
  1. . D ADDVAL^RORTSK11(RORTSK,"FIRSTDIAG",$G(TMP),PTAG,1)
  1. ;--- ICN
  1. I $$PARAM^RORTSK01("PATIENTS","ICN") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D ICNDATA^RORXU006(RORTSK,DFN,PTAG)
  1. ;
  1. ;--- PACT
  1. I $$PARAM^RORTSK01("PATIENTS","PACT") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D PACTDATA^RORXU006(RORTSK,DFN,PTAG)
  1. ;
  1. ;--- PCP
  1. I $$PARAM^RORTSK01("PATIENTS","PCP") D
  1. . S:'$D(DFN) DFN=$G(RORBUF(798,IENS,.01,"I"))
  1. . D PCPDATA^RORXU006(RORTSK,DFN,PTAG)
  1. Q 0
  1. ;
  1. ;***** COMPILES A LIST OF REGISTRY PATIENTS
  1. ; REPORT CODE: 001
  1. ;
  1. ; .RORTSK Task number and task parameters
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. REGPTLST(RORTSK) ;
  1. N RORFLDS ; Fields to load from the file #798
  1. N RORPTN ; Number of patients in the registry
  1. N RORREG ; Registry IEN
  1. ;
  1. N BODY,CNT,ECNT,IEN,IENS,MODE,PTNAME,RC,REPORT,SFLAGS,TMP,XREFNODE
  1. N RCC,FLAG,RORCDT,PARAMS
  1. ;--- Root node of the report
  1. S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
  1. Q:REPORT<0 REPORT
  1. ;
  1. ;--- Get and prepare the report parameters
  1. S RORREG=$$PARAM^RORTSK01("REGIEN")
  1. S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,,,.SFLAGS) Q:PARAMS<0 PARAMS
  1. S SFLAGS=$TR(SFLAGS,"DG")
  1. I '$$PARAM^RORTSK01("PATIENTS","CONFIRMED"),'$$PARAM^RORTSK01("PATIENTS","CONFIRM_AFTER") S SFLAGS=SFLAGS_"C"
  1. S:'$$PARAM^RORTSK01("PATIENTS","PENDING") SFLAGS=SFLAGS_"G"
  1. S RORCDT=$$PARAM^RORTSK01("PATIENTS","CONFDT_AFTER")
  1. D ADDVAL^RORTSK11(RORTSK,"TYPE",SFLAGS,REPORT)
  1. ;--- After date range
  1. I RORCDT D
  1. . S SFLAGS=SFLAGS_"P"
  1. . S RORCDT=$$FMADD^XLFDT(RORCDT,1) ;add one day
  1. ;
  1. ;--- Initialize constants and variables
  1. S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
  1. S ECNT=0,XREFNODE=$NA(^RORDATA(798,"ARP",RORREG_"#"))
  1. ;
  1. ;--- The report header and list of patients
  1. S RC=$$HEADER(REPORT) Q:RC<0 RC
  1. S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1. D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
  1. Q:BODY<0 BODY
  1. ;
  1. ;--- Browse through the registry records
  1. S PTNAME="",(CNT,RC)=0
  1. S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1. F S PTNAME=$O(@XREFNODE@(PTNAME)) Q:PTNAME="" D Q:RC<0
  1. . S IEN=0
  1. . F S IEN=$O(@XREFNODE@(PTNAME,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. . . ;--- Check if the patient should be skipped
  1. . . Q:$$SKIP^RORXU005(IEN,SFLAGS,RORCDT)
  1. . .;--- Check the patient against the ICD Filter
  1. . . S DFN=$$PTIEN^RORUTL01(+IENS)
  1. . . S RCC=0
  1. . . I FLAG'="ALL" D
  1. . . . S RCC=$$ICD^RORXU010(DFN)
  1. . . I (FLAG="INCLUDE")&(RCC=0) Q
  1. . . I (FLAG="EXCLUDE")&(RCC=1) Q
  1. . .;--- End of filter check
  1. . . ;--- Process the registry record
  1. . . I $$PATIENT(IENS,BODY)<0 S ECNT=ECNT+1 Q
  1. ;---
  1. Q $S(RC<0:RC,ECNT>0:-43,1:0)
  1. ;
  1. ;***** ADDS THE SELECTION RULES TO THE REPORT
  1. ;
  1. ; IENS IENS of the patient's record in the registry
  1. ; PARTAG Reference (IEN) to the parent tag
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. SELRULES(IENS,PARTAG) ;
  1. N CNT,I,RORBUF,RORMSG,RT,SRLTAG,TMP
  1. ;--- Load the list of selection rules
  1. K RORMSG D LIST^DIC(798.01,","_IENS,"@;.01I;1I",,,,,"B",,,"RORBUF","RORMSG")
  1. ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
  1. Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
  1. ;--- The <SELRULES> ... </SELRULES> tags
  1. S SRLTAG=$$ADDVAL^RORTSK11(RORTSK,"SELRULES",,PARTAG)
  1. ;--- Add the selection rules to the report
  1. S I="",CNT=0
  1. F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D
  1. . S RT=$$ADDVAL^RORTSK11(RORTSK,"RULE",,SRLTAG),CNT=CNT+1
  1. . S TMP=$G(RORBUF("DILIST","ID",I,.01))
  1. . K RORMSG S TMP=$$GET1^DIQ(798.2,TMP_",",4,,,"RORMSG")
  1. . ;Q:$G(DIERR)!(TMP="")
  1. . Q:$G(RORMSG("DIERR"))!(TMP="")
  1. . D ADDATTR^RORTSK11(RORTSK,RT,"DESCR",TMP)
  1. . S TMP=$$DATE^RORXU002($G(RORBUF("DILIST","ID",I,1))\1)
  1. . D:TMP'="" ADDATTR^RORTSK11(RORTSK,RT,"DATE",TMP)
  1. ;--- Add the default item if no selection rules have been found
  1. D:CNT'>0
  1. . S RT=$$ADDVAL^RORTSK11(RORTSK,"RULE",,SRLTAG)
  1. . D ADDATTR^RORTSK11(RORTSK,RT,"DESCR","Manual Entry")
  1. ;
  1. Q 0
  1. ;