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

RORX024A.m

Go to the documentation of this file. 
  1. RORX024A ;ALB/TK,MAF - HEP A/B VACCINE/IMMUNITY REPORTS (QUERY & STORE) ; 27 Jul 2016  3:04 PM
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**29,30,31,33,34,37,38,39**;Feb 17, 2006;Build 4
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #10103 FMADD^XLFDT (supported)
  1.  ; #2051  FIND1^DIC
  1.  ;   
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                 --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*29   APR 2016    T KOPP       Added for Hep A/B vaccine/immunity reports
  1.  ;ROR*1.5*30   MAR 2017    M FERRARESE  LOINC CODES result values changed to uppercase
  1.  ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
  1.  ;                                      identifiers.
  1.  ;ROR*1.5*33   MAY 2017    M FERRARESE  Adding Future Appointment
  1.  ;ROR*1.5*34   SEP 2018    M FERRARESE  Adding Future Appointment clinic name ; Fix LOINC code table for HEP A/B
  1.  ;ROR*1.5*37   NOV 2020    F TRAXLER    Adding UNDET check in POS subroutine
  1.  ;ROR*1.5*38   APR 2021    F TRAXLER    Fix bug introduced by ROR*1.5*37 change.
  1.  ;ROR*1.5*39   JUN 2021    F TRAXLER    Replace real SSN with zeroes.
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** QUERIES THE REGISTRY
  1.  ;
  1.  ; FLAGS         Flags for the $$SKIP^RORXU005
  1.  ; .NSPT         Number of selected patients is returned here
  1.  ; RORRTN        Routine name for Hep A (RORX024) or Hep B (RORX025) report
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. QUERY(FLAGS,NSPT,RORRTN) ;
  1.  N RORPTN        ; Number of patients in the registry
  1.  N RORVSDT       ; Vaccination search start date
  1.  N RORVEDT       ; Vaccination search end date
  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 RORICN        ; National ICN
  1.  N RORPACT       ;Patient Care Team
  1.  N RORPCP        ;Priamary Care Provider
  1.  N AGE,AGETYPE
  1.  N RORDAYS       ;Number of Days       PATCH 33
  1.  N RORFUT        ;Future appointments  PATCH 33
  1.  N RORCLIN       ;Future appointments clinic PATCH 34
  1.  ;
  1.  S:$G(RORRTN)="" RORRTN="RORX024"
  1.  N CNT,IEN,IENS,LTEDT,LTSDT,RORHEPB,PATIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
  1.  N RCC,FLAG
  1.  S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1.  S (CNT,NSPT,RC,SKIPEDT,SKIPSDT)=0
  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.  ;--- Number of patients in the registry
  1.  S RORPTN=$$REGSIZE^RORUTL02(+RORREG)  S:RORPTN<0 RORPTN=0
  1.  ;
  1.  ;--- Setup the immunity and vaccination parameters
  1.  I RORIMM  D
  1.  . ;--- Lab/LOINC codes date range
  1.  . S LTSDT=$$PARAM^RORTSK01("DATE_RANGE_7","START")\1
  1.  . S LTEDT=$$PARAM^RORTSK01("DATE_RANGE_7","END")\1
  1.  . ;--- Combined date range
  1.  . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
  1.  . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
  1.  . ;--- Shift the Labs end date
  1.  . S LTEDT=$$FMADD^XLFDT(LTEDT,1)
  1.  I RORVAC  D
  1.  . S RORVSDT=$$PARAM^RORTSK01("DATE_RANGE_6","START")\1
  1.  . S RORVEDT=$$PARAM^RORTSK01("DATE_RANGE_6","END")\1
  1.  . ;--- Combined date range
  1.  . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORVSDT)
  1.  . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORVEDT)
  1.  . ;--- Shift the vaccine end date
  1.  . S RORVEDT=$$FMADD^XLFDT(RORVEDT\1,1)
  1.  Q:'(RORIMM!RORVAC) 0
  1.  ;
  1.  ;=== Set up Clinic/Division list parameters
  1.  S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
  1.  ;
  1.  S RORHEPB=$S(RORRTN'="RORX024":"",1:$$FIND1^DIC(798.1,,"BQX","VA HEPB"))
  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.  . ; Ignore patients in Hep B registry if Hep B report
  1.  . I RORHEPB'="" Q:$D(^RORDATA(798,"AC",+RORHEPB,+IEN))
  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,SKIPSDT,SKIPEDT)
  1.  . S SKIP=1,UTIL=0
  1.  . ;--- Check if patient should be filtered because of ICD codes
  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.  . ;
  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.  . S RCC=0,SKIP=1
  1.  . D
  1.  . . ;--- Search for vaccination data in IMMUNIZATIONS file
  1.  . . I RORVAC D  Q:RCC<0
  1.  . . . N VAC,ROR8PAT,ROR8LST,RORVRES
  1.  . . . S ROR8PAT=$NA(^TMP(RORRTN,$J,"VAC"))
  1.  . . . S RORVRES=$NA(^TMP(RORRTN,$J,"VAC_RES")) K @RORVRES
  1.  . . . S VAC=$$QUERY^RORUTL21(PATIEN,ROR8PAT,RORVRES,RORVSDT,RORVEDT)
  1.  . . . I VAC<0 S RCC=-1 Q
  1.  . . . I RORVAC<0,'VAC S ^TMP(RORRTN,$J,"PAT",PATIEN,"VAC")=0 Q     ; No vaccination requested and none found 
  1.  . . . I RORVAC>0,VAC D  Q   ; Vaccination requested, at least one found
  1.  . . . . S ROR8LST=$NA(^TMP(RORRTN,$J,"PAT",PATIEN,"VAC"))
  1.  . . . . S RCC=$$PROCESS^RORUTL21(RORVRES,PATIEN,ROR8LST)
  1.  . . . . K @RORVRES
  1.  . . . . Q:RCC<0
  1.  . . . S RCC=-1  ;does not pass vaccination selection criteria validation
  1.  . . ;
  1.  . . ;--- Search for lab data positive results for selected LOINC codes
  1.  . . I RORIMM D  Q:RCC<0
  1.  . . . N IMM,ROR8LST,RORLOINC,RORLRES
  1.  . . . S RORLOINC=$NA(^TMP(RORRTN,$J,"IMM"))
  1.  . . . ; Extract positive lab test results for selected LOINC codes
  1.  . . . S IMM=$$LAB^RORX024(PATIEN,RORLOINC,.RORLRES,LTSDT,LTEDT)
  1.  . . . I IMM<0 S RCC=-1 Q
  1.  . . . I RORIMM<0,'IMM D  Q     ; No immunity requested and no positive test found
  1.  . . . . S ^TMP(RORRTN,$J,"PAT",PATIEN,"IMM")=""
  1.  . . . I RORIMM>0,IMM D  Q   ; Immunity requested, at least one positive lab test found
  1.  . . . . S ^TMP(RORRTN,$J,"PAT",PATIEN,"IMM")=RORLRES
  1.  . . . S RCC=-1  ;does not pass immunity selection criteria validation
  1.  . . S SKIP=0
  1.  . ;
  1.  . ;--- Check for any utilization in the corresponding date range
  1.  . I 'SKIP  D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
  1.  . . K TMP  S TMP("ALL")=1
  1.  . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
  1.  . . S:'UTIL SKIP=1
  1.  . ;
  1.  . ;--- Skip the patient if not all search criteria have been met
  1.  . I SKIP K ^TMP(RORRTN,$J,"PAT",PATIEN) Q
  1.  . ;
  1.  . ;--- Get and store the patient's data
  1.  . D VADEM^RORUTL05(PATIEN,1) S VA("BID")="0000"
  1.  . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
  1.  . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
  1.  . S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
  1.  . S TMP=$$DATE^RORXU002(VADM(6)\1)
  1.  . ;
  1.  . ;--- Patient age/DOB
  1.  . 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.  . ;
  1.  . ; IF Future Appointment only  Patch 33
  1.  . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D 
  1.  . . S RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
  1.  . . S RORFUT=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U)
  1.  . . S RORCLIN=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2)
  1.  . S ^TMP(RORRTN,$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
  1.  . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1.  . . S $P(^TMP(RORRTN,$J,"PAT",PATIEN),U,8)=RORFUT
  1.  . . S $P(^TMP(RORRTN,$J,"PAT",PATIEN),U,9)=RORCLIN
  1.  . S NSPT=NSPT+1
  1.  ;
  1.  ;---
  1.  Q $S(RC<0:RC,1:0)
  1.  ;
  1. POS(VAL) ; Returns 1 if lab test returns positive result (VAL)
  1.  ;Positive results are results that are equal to "P" or contain "POS", "DETEC" or "REA"
  1.  ;         -- AND -- do not contain "NEG", "NO" or "IND" or "UNDET" or "CANC" or "PEND"
  1.  N POS,X
  1.  S POS=0
  1.  S X=VAL
  1.  S VAL=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  I VAL["UNDET" Q POS
  1.  I VAL="P"!(VAL["POS")!(VAL["DETEC")!(VAL["REA") D
  1.  . I '(VAL["NEG"!(VAL["NO")!(VAL["IND")) S POS=1
  1.  Q POS
  1.  ;
  1.  ;***** STORES THE REPORT DATA
  1.  ;
  1.  ; REPORT        IEN of the REPORT element
  1.  ; [.]NSPT       # of patients in registry
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1.  ;
  1. STORE(REPORT,NSPT,RORRTN) ;
  1.  N CNT,DFN,DOD,ICN,ITEM,LAST4,NAME,NODE,PACT,PCP,PTCNT,PTLST,PTNAME,RC,VDATE,TMP,VAL,LTIMM,IMMLST,VACLST,VLST,AGETYPE,AGE,RORFUT,RORCLIN,RORDAYS
  1.  S RC=0,PTLST=-1
  1.  ;--- Force the "patient data" note in the output
  1.  D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
  1.  ;--- Create patient list
  1.  S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1.  D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
  1.  ;---
  1.  S (CNT,DFN,PTCNT)=0
  1.  F  S DFN=$O(^TMP(RORRTN,$J,"PAT",DFN))  Q:DFN'>0  D  Q:RC<0
  1.  . S TMP=$S(NSPT>0:CNT/NSPT,1:"")
  1.  . S RC=$$LOOP^RORTSK01(TMP)  Q:RC<0
  1.  . S CNT=CNT+1,NODE=$NA(^TMP(RORRTN,$J,"PAT",DFN))
  1.  . ;--- Patient's data
  1.  . S TMP=$G(@NODE)
  1.  . S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3),ICN=$P(TMP,U,4),PACT=$P(TMP,U,5),PCP=$P(TMP,U,6),AGE=$P(TMP,U,7)
  1.  . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S RORFUT=$P(TMP,U,8),RORCLIN=$P(TMP,U,9)
  1.  . ;--- Patient list
  1.  . S TMP=$S('RORIMM:1,RORIMM<0:$G(@NODE@("IMM"))="",1:$G(@NODE@("IMM"))'="")
  1.  . I TMP,$S('RORVAC:1,RORVAC<0:'$G(@NODE@("VAC")),1:$G(@NODE@("VAC"))) D
  1.  . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
  1.  . . ;--- Age/DOB
  1.  . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
  1.  . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
  1.  . . ;
  1.  . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
  1.  . . S PTCNT=PTCNT+1
  1.  . ;--- List of vaccines
  1.  . S VACLST=-1
  1.  . I $O(@NODE@("VAC",""))'="" S VACLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINES",,ITEM) Q:VACLST<0
  1.  . I RORVAC=1,VACLST'<0 S NAME="" F  S NAME=$O(@NODE@("VAC",NAME)) Q:NAME=""  D
  1.  . . S VLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINE",,VACLST)
  1.  . . Q:VLST<0
  1.  . . S VDATE=0
  1.  . . F  S VDATE=$O(@NODE@("VAC",NAME,VDATE))  Q:'VDATE  D
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"VAC_NAME",NAME,VLST,1)
  1.  . . . D ADDVAL^RORTSK11(RORTSK,"VAC_DATE",VDATE\1,VLST,1)
  1.  . ;--- Immunity
  1.  . I RORIMM=1,$G(@NODE@("IMM"))'="" D
  1.  . . S IMMLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,ITEM) Q:IMMLST<0
  1.  . . S LTIMM=$G(@NODE@("IMM"))
  1.  . . Q:LTIMM=""
  1.  . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",$P(LTIMM,U),IMMLST,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"DATE",$P(LTIMM,U,2)\1,IMMLST,1)
  1.  . . S VAL=$P(LTIMM,U,3)
  1.  . . S TMP=$S($$NUMERIC^RORUTL05(VAL):3,1:1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,IMMLST,TMP)
  1.  . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
  1.  . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
  1.  . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1.  . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
  1.  ;--- Inactivate the patient list tag if the list is empty
  1.  D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
  1.  ;---
  1.  Q 0
  1.  ;