RORX024A ;ALB/TK,MAF - HEP A/B VACCINE/IMMUNITY REPORTS (QUERY & STORE) ; 27 Jul 2016 3:04 PM
;;1.5;CLINICAL CASE REGISTRIES;**29,30,31,33,34,37,38,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10103 FMADD^XLFDT (supported)
; #2051 FIND1^DIC
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*29 APR 2016 T KOPP Added for Hep A/B vaccine/immunity reports
;ROR*1.5*30 MAR 2017 M FERRARESE LOINC CODES result values changed to uppercase
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*33 MAY 2017 M FERRARESE Adding Future Appointment
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name ; Fix LOINC code table for HEP A/B
;ROR*1.5*37 NOV 2020 F TRAXLER Adding UNDET check in POS subroutine
;ROR*1.5*38 APR 2021 F TRAXLER Fix bug introduced by ROR*1.5*37 change.
;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
;******************************************************************************
;******************************************************************************
Q
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
; .NSPT Number of selected patients is returned here
; RORRTN Routine name for Hep A (RORX024) or Hep B (RORX025) report
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS,NSPT,RORRTN) ;
N RORPTN ; Number of patients in the registry
N RORVSDT ; Vaccination search start date
N RORVEDT ; Vaccination search end date
N RORCDLIST ; Flag to indicate whether a clinic or division list exists
N RORCDSTDT ; Start date for clinic/division utilization search
N RORCDENDT ; End date for clinic/division utilization search
N RORICN ; National ICN
N RORPACT ;Patient Care Team
N RORPCP ;Priamary Care Provider
N AGE,AGETYPE
N RORDAYS ;Number of Days PATCH 33
N RORFUT ;Future appointments PATCH 33
N RORCLIN ;Future appointments clinic PATCH 34
;
S:$G(RORRTN)="" RORRTN="RORX024"
N CNT,IEN,IENS,LTEDT,LTSDT,RORHEPB,PATIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
N RCC,FLAG
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S (CNT,NSPT,RC,SKIPEDT,SKIPSDT)=0
;--- Utilization date range
D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
. S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
;--- Number of patients in the registry
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
;
;--- Setup the immunity and vaccination parameters
I RORIMM D
. ;--- Lab/LOINC codes date range
. S LTSDT=$$PARAM^RORTSK01("DATE_RANGE_7","START")\1
. S LTEDT=$$PARAM^RORTSK01("DATE_RANGE_7","END")\1
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
. ;--- Shift the Labs end date
. S LTEDT=$$FMADD^XLFDT(LTEDT,1)
I RORVAC D
. S RORVSDT=$$PARAM^RORTSK01("DATE_RANGE_6","START")\1
. S RORVEDT=$$PARAM^RORTSK01("DATE_RANGE_6","END")\1
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORVSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORVEDT)
. ;--- Shift the vaccine end date
. S RORVEDT=$$FMADD^XLFDT(RORVEDT\1,1)
Q:'(RORIMM!RORVAC) 0
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
;
S RORHEPB=$S(RORRTN'="RORX024":"",1:$$FIND1^DIC(798.1,,"BQX","VA HEPB"))
;--- Browse through the registry records
S IEN=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S IENS=IEN_",",CNT=CNT+1
. ; Ignore patients in Hep B registry if Hep B report
. I RORHEPB'="" Q:$D(^RORDATA(798,"AC",+RORHEPB,+IEN))
. ;--- Get patient DFN
. S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
. S SKIP=1,UTIL=0
. ;--- Check if patient should be filtered because of ICD codes
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;
. S RCC=0,SKIP=1
. D
. . ;--- Search for vaccination data in IMMUNIZATIONS file
. . I RORVAC D Q:RCC<0
. . . N VAC,ROR8PAT,ROR8LST,RORVRES
. . . S ROR8PAT=$NA(^TMP(RORRTN,$J,"VAC"))
. . . S RORVRES=$NA(^TMP(RORRTN,$J,"VAC_RES")) K @RORVRES
. . . S VAC=$$QUERY^RORUTL21(PATIEN,ROR8PAT,RORVRES,RORVSDT,RORVEDT)
. . . I VAC<0 S RCC=-1 Q
. . . I RORVAC<0,'VAC S ^TMP(RORRTN,$J,"PAT",PATIEN,"VAC")=0 Q ; No vaccination requested and none found
. . . I RORVAC>0,VAC D Q ; Vaccination requested, at least one found
. . . . S ROR8LST=$NA(^TMP(RORRTN,$J,"PAT",PATIEN,"VAC"))
. . . . S RCC=$$PROCESS^RORUTL21(RORVRES,PATIEN,ROR8LST)
. . . . K @RORVRES
. . . . Q:RCC<0
. . . S RCC=-1 ;does not pass vaccination selection criteria validation
. . ;
. . ;--- Search for lab data positive results for selected LOINC codes
. . I RORIMM D Q:RCC<0
. . . N IMM,ROR8LST,RORLOINC,RORLRES
. . . S RORLOINC=$NA(^TMP(RORRTN,$J,"IMM"))
. . . ; Extract positive lab test results for selected LOINC codes
. . . S IMM=$$LAB^RORX024(PATIEN,RORLOINC,.RORLRES,LTSDT,LTEDT)
. . . I IMM<0 S RCC=-1 Q
. . . I RORIMM<0,'IMM D Q ; No immunity requested and no positive test found
. . . . S ^TMP(RORRTN,$J,"PAT",PATIEN,"IMM")=""
. . . I RORIMM>0,IMM D Q ; Immunity requested, at least one positive lab test found
. . . . S ^TMP(RORRTN,$J,"PAT",PATIEN,"IMM")=RORLRES
. . . S RCC=-1 ;does not pass immunity selection criteria validation
. . S SKIP=0
. ;
. ;--- Check for any utilization in the corresponding date range
. I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. . K TMP S TMP("ALL")=1
. . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
. . S:'UTIL SKIP=1
. ;
. ;--- Skip the patient if not all search criteria have been met
. I SKIP K ^TMP(RORRTN,$J,"PAT",PATIEN) Q
. ;
. ;--- Get and store the patient's data
. D VADEM^RORUTL05(PATIEN,1) S VA("BID")="0000"
. S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
. S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
. S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
. S TMP=$$DATE^RORXU002(VADM(6)\1)
. ;
. ;--- Patient age/DOB
. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
. . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. ;
. ; IF Future Appointment only Patch 33
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . S RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
. . S RORFUT=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U)
. . S RORCLIN=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2)
. S ^TMP(RORRTN,$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . S $P(^TMP(RORRTN,$J,"PAT",PATIEN),U,8)=RORFUT
. . S $P(^TMP(RORRTN,$J,"PAT",PATIEN),U,9)=RORCLIN
. S NSPT=NSPT+1
;
;---
Q $S(RC<0:RC,1:0)
;
POS(VAL) ; Returns 1 if lab test returns positive result (VAL)
;Positive results are results that are equal to "P" or contain "POS", "DETEC" or "REA"
; -- AND -- do not contain "NEG", "NO" or "IND" or "UNDET" or "CANC" or "PEND"
N POS,X
S POS=0
S X=VAL
S VAL=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
I VAL["UNDET" Q POS
I VAL="P"!(VAL["POS")!(VAL["DETEC")!(VAL["REA") D
. I '(VAL["NEG"!(VAL["NO")!(VAL["IND")) S POS=1
Q POS
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
; [.]NSPT # of patients in registry
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
;
STORE(REPORT,NSPT,RORRTN) ;
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
S RC=0,PTLST=-1
;--- Force the "patient data" note in the output
D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
;--- Create patient list
S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
;---
S (CNT,DFN,PTCNT)=0
F S DFN=$O(^TMP(RORRTN,$J,"PAT",DFN)) Q:DFN'>0 D Q:RC<0
. S TMP=$S(NSPT>0:CNT/NSPT,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1,NODE=$NA(^TMP(RORRTN,$J,"PAT",DFN))
. ;--- Patient's data
. S TMP=$G(@NODE)
. 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)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S RORFUT=$P(TMP,U,8),RORCLIN=$P(TMP,U,9)
. ;--- Patient list
. S TMP=$S('RORIMM:1,RORIMM<0:$G(@NODE@("IMM"))="",1:$G(@NODE@("IMM"))'="")
. I TMP,$S('RORVAC:1,RORVAC<0:'$G(@NODE@("VAC")),1:$G(@NODE@("VAC"))) D
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
. . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
. . ;--- Age/DOB
. . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
. . ;
. . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
. . S PTCNT=PTCNT+1
. ;--- List of vaccines
. S VACLST=-1
. I $O(@NODE@("VAC",""))'="" S VACLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINES",,ITEM) Q:VACLST<0
. I RORVAC=1,VACLST'<0 S NAME="" F S NAME=$O(@NODE@("VAC",NAME)) Q:NAME="" D
. . S VLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINE",,VACLST)
. . Q:VLST<0
. . S VDATE=0
. . F S VDATE=$O(@NODE@("VAC",NAME,VDATE)) Q:'VDATE D
. . . D ADDVAL^RORTSK11(RORTSK,"VAC_NAME",NAME,VLST,1)
. . . D ADDVAL^RORTSK11(RORTSK,"VAC_DATE",VDATE\1,VLST,1)
. ;--- Immunity
. I RORIMM=1,$G(@NODE@("IMM"))'="" D
. . S IMMLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,ITEM) Q:IMMLST<0
. . S LTIMM=$G(@NODE@("IMM"))
. . Q:LTIMM=""
. . D ADDVAL^RORTSK11(RORTSK,"LTNAME",$P(LTIMM,U),IMMLST,1)
. . D ADDVAL^RORTSK11(RORTSK,"DATE",$P(LTIMM,U,2)\1,IMMLST,1)
. . S VAL=$P(LTIMM,U,3)
. . S TMP=$S($$NUMERIC^RORUTL05(VAL):3,1:1)
. . D ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,IMMLST,TMP)
. I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
. I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
. I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
;--- Inactivate the patient list tag if the list is empty
D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
;---
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX024A 11805 printed Apr 09, 2024@20:50:20 Page 2
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
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10103 FMADD^XLFDT (supported)
+6 ; #2051 FIND1^DIC
+7 ;
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*29 APR 2016 T KOPP Added for Hep A/B vaccine/immunity reports
+15 ;ROR*1.5*30 MAR 2017 M FERRARESE LOINC CODES result values changed to uppercase
+16 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+17 ; identifiers.
+18 ;ROR*1.5*33 MAY 2017 M FERRARESE Adding Future Appointment
+19 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name ; Fix LOINC code table for HEP A/B
+20 ;ROR*1.5*37 NOV 2020 F TRAXLER Adding UNDET check in POS subroutine
+21 ;ROR*1.5*38 APR 2021 F TRAXLER Fix bug introduced by ROR*1.5*37 change.
+22 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+23 ;******************************************************************************
+24 ;******************************************************************************
+25 QUIT
+26 ;
+27 ;***** QUERIES THE REGISTRY
+28 ;
+29 ; FLAGS Flags for the $$SKIP^RORXU005
+30 ; .NSPT Number of selected patients is returned here
+31 ; RORRTN Routine name for Hep A (RORX024) or Hep B (RORX025) report
+32 ;
+33 ; Return Values:
+34 ; <0 Error code
+35 ; 0 Ok
+36 ; >0 Number of non-fatal errors
+37 ;
QUERY(FLAGS,NSPT,RORRTN) ;
+1 ; Number of patients in the registry
NEW RORPTN
+2 ; Vaccination search start date
NEW RORVSDT
+3 ; Vaccination search end date
NEW RORVEDT
+4 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+5 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+6 ; End date for clinic/division utilization search
NEW RORCDENDT
+7 ; National ICN
NEW RORICN
+8 ;Patient Care Team
NEW RORPACT
+9 ;Priamary Care Provider
NEW RORPCP
+10 NEW AGE,AGETYPE
+11 ;Number of Days PATCH 33
NEW RORDAYS
+12 ;Future appointments PATCH 33
NEW RORFUT
+13 ;Future appointments clinic PATCH 34
NEW RORCLIN
+14 ;
+15 if $GET(RORRTN)=""
SET RORRTN="RORX024"
+16 NEW CNT,IEN,IENS,LTEDT,LTSDT,RORHEPB,PATIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
+17 NEW RCC,FLAG
+18 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+19 SET (CNT,NSPT,RC,SKIPEDT,SKIPSDT)=0
+20 ;--- Utilization date range
+21 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+22 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+23 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
+24 ;--- Combined date range
+25 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
+26 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
End DoDot:1
+27 ;--- Number of patients in the registry
+28 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+29 ;
+30 ;--- Setup the immunity and vaccination parameters
+31 IF RORIMM
Begin DoDot:1
+32 ;--- Lab/LOINC codes date range
+33 SET LTSDT=$$PARAM^RORTSK01("DATE_RANGE_7","START")\1
+34 SET LTEDT=$$PARAM^RORTSK01("DATE_RANGE_7","END")\1
+35 ;--- Combined date range
+36 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
+37 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
+38 ;--- Shift the Labs end date
+39 SET LTEDT=$$FMADD^XLFDT(LTEDT,1)
End DoDot:1
+40 IF RORVAC
Begin DoDot:1
+41 SET RORVSDT=$$PARAM^RORTSK01("DATE_RANGE_6","START")\1
+42 SET RORVEDT=$$PARAM^RORTSK01("DATE_RANGE_6","END")\1
+43 ;--- Combined date range
+44 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORVSDT)
+45 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORVEDT)
+46 ;--- Shift the vaccine end date
+47 SET RORVEDT=$$FMADD^XLFDT(RORVEDT\1,1)
End DoDot:1
+48 if '(RORIMM!RORVAC)
QUIT 0
+49 ;
+50 ;=== Set up Clinic/Division list parameters
+51 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+52 ;
+53 SET RORHEPB=$SELECT(RORRTN'="RORX024":"",1:$$FIND1^DIC(798.1,,"BQX","VA HEPB"))
+54 ;--- Browse through the registry records
+55 SET IEN=0
+56 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+57 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+58 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+59 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+60 SET IENS=IEN_","
SET CNT=CNT+1
+61 ; Ignore patients in Hep B registry if Hep B report
+62 IF RORHEPB'=""
if $DATA(^RORDATA(798,"AC",+RORHEPB,+IEN))
QUIT
+63 ;--- Get patient DFN
+64 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+65 ;check for patient list and quit if not on list
+66 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+67 ;--- Check if the patient should be skipped
+68 if $$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
QUIT
+69 SET SKIP=1
SET UTIL=0
+70 ;--- Check if patient should be filtered because of ICD codes
+71 SET RCC=0
+72 IF FLAG'="ALL"
Begin DoDot:2
+73 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+74 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+75 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+76 ;
+77 ;--- Check for Clinic or Division list and quit if not in list
+78 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+79 ;
+80 SET RCC=0
SET SKIP=1
+81 Begin DoDot:2
+82 ;--- Search for vaccination data in IMMUNIZATIONS file
+83 IF RORVAC
Begin DoDot:3
+84 NEW VAC,ROR8PAT,ROR8LST,RORVRES
+85 SET ROR8PAT=$NAME(^TMP(RORRTN,$JOB,"VAC"))
+86 SET RORVRES=$NAME(^TMP(RORRTN,$JOB,"VAC_RES"))
KILL @RORVRES
+87 SET VAC=$$QUERY^RORUTL21(PATIEN,ROR8PAT,RORVRES,RORVSDT,RORVEDT)
+88 IF VAC<0
SET RCC=-1
QUIT
+89 ; No vaccination requested and none found
IF RORVAC<0
IF 'VAC
SET ^TMP(RORRTN,$JOB,"PAT",PATIEN,"VAC")=0
QUIT
+90 ; Vaccination requested, at least one found
IF RORVAC>0
IF VAC
Begin DoDot:4
+91 SET ROR8LST=$NAME(^TMP(RORRTN,$JOB,"PAT",PATIEN,"VAC"))
+92 SET RCC=$$PROCESS^RORUTL21(RORVRES,PATIEN,ROR8LST)
+93 KILL @RORVRES
+94 if RCC<0
QUIT
End DoDot:4
QUIT
+95 ;does not pass vaccination selection criteria validation
SET RCC=-1
End DoDot:3
if RCC<0
QUIT
+96 ;
+97 ;--- Search for lab data positive results for selected LOINC codes
+98 IF RORIMM
Begin DoDot:3
+99 NEW IMM,ROR8LST,RORLOINC,RORLRES
+100 SET RORLOINC=$NAME(^TMP(RORRTN,$JOB,"IMM"))
+101 ; Extract positive lab test results for selected LOINC codes
+102 SET IMM=$$LAB^RORX024(PATIEN,RORLOINC,.RORLRES,LTSDT,LTEDT)
+103 IF IMM<0
SET RCC=-1
QUIT
+104 ; No immunity requested and no positive test found
IF RORIMM<0
IF 'IMM
Begin DoDot:4
+105 SET ^TMP(RORRTN,$JOB,"PAT",PATIEN,"IMM")=""
End DoDot:4
QUIT
+106 ; Immunity requested, at least one positive lab test found
IF RORIMM>0
IF IMM
Begin DoDot:4
+107 SET ^TMP(RORRTN,$JOB,"PAT",PATIEN,"IMM")=RORLRES
End DoDot:4
QUIT
+108 ;does not pass immunity selection criteria validation
SET RCC=-1
End DoDot:3
if RCC<0
QUIT
+109 SET SKIP=0
End DoDot:2
+110 ;
+111 ;--- Check for any utilization in the corresponding date range
+112 IF 'SKIP
if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:2
+113 KILL TMP
SET TMP("ALL")=1
+114 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
+115 if 'UTIL
SET SKIP=1
End DoDot:2
+116 ;
+117 ;--- Skip the patient if not all search criteria have been met
+118 IF SKIP
KILL ^TMP(RORRTN,$JOB,"PAT",PATIEN)
QUIT
+119 ;
+120 ;--- Get and store the patient's data
+121 DO VADEM^RORUTL05(PATIEN,1)
SET VA("BID")="0000"
+122 SET RORICN=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+123 SET RORPACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
+124 SET RORPCP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
+125 SET TMP=$$DATE^RORXU002(VADM(6)\1)
+126 ;
+127 ;--- Patient age/DOB
+128 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:2
+129 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:2
+130 ;
+131 ; IF Future Appointment only Patch 33
+132 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+133 SET RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
+134 SET RORFUT=$PIECE($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U)
+135 SET RORCLIN=$PIECE($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2)
End DoDot:2
+136 SET ^TMP(RORRTN,$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
+137 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+138 SET $PIECE(^TMP(RORRTN,$JOB,"PAT",PATIEN),U,8)=RORFUT
+139 SET $PIECE(^TMP(RORRTN,$JOB,"PAT",PATIEN),U,9)=RORCLIN
End DoDot:2
+140 SET NSPT=NSPT+1
End DoDot:1
if RC<0
QUIT
+141 ;
+142 ;---
+143 QUIT $SELECT(RC<0:RC,1:0)
+144 ;
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"
+2 ; -- AND -- do not contain "NEG", "NO" or "IND" or "UNDET" or "CANC" or "PEND"
+3 NEW POS,X
+4 SET POS=0
+5 SET X=VAL
+6 SET VAL=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+7 IF VAL["UNDET"
QUIT POS
+8 IF VAL="P"!(VAL["POS")!(VAL["DETEC")!(VAL["REA")
Begin DoDot:1
+9 IF '(VAL["NEG"!(VAL["NO")!(VAL["IND"))
SET POS=1
End DoDot:1
+10 QUIT POS
+11 ;
+12 ;***** STORES THE REPORT DATA
+13 ;
+14 ; REPORT IEN of the REPORT element
+15 ; [.]NSPT # of patients in registry
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ; >0 Number of non-fatal errors
+21 ;
+22 ;
STORE(REPORT,NSPT,RORRTN) ;
+1 NEW 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
+2 SET RC=0
SET PTLST=-1
+3 ;--- Force the "patient data" note in the output
+4 DO ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
+5 ;--- Create patient list
+6 SET PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+7 DO ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
+8 ;---
+9 SET (CNT,DFN,PTCNT)=0
+10 FOR
SET DFN=$ORDER(^TMP(RORRTN,$JOB,"PAT",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+11 SET TMP=$SELECT(NSPT>0:CNT/NSPT,1:"")
+12 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+13 SET CNT=CNT+1
SET NODE=$NAME(^TMP(RORRTN,$JOB,"PAT",DFN))
+14 ;--- Patient's data
+15 SET TMP=$GET(@NODE)
+16 SET LAST4=$PIECE(TMP,U)
SET PTNAME=$PIECE(TMP,U,2)
SET DOD=$PIECE(TMP,U,3)
SET ICN=$PIECE(TMP,U,4)
SET PACT=$PIECE(TMP,U,5)
SET PCP=$PIECE(TMP,U,6)
SET AGE=$PIECE(TMP,U,7)
+17 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
SET RORFUT=$PIECE(TMP,U,8)
SET RORCLIN=$PIECE(TMP,U,9)
+18 ;--- Patient list
+19 SET TMP=$SELECT('RORIMM:1,RORIMM<0:$GET(@NODE@("IMM"))="",1:$GET(@NODE@("IMM"))'="")
+20 IF TMP
IF $SELECT('RORVAC:1,RORVAC<0:'$GET(@NODE@("VAC")),1:$GET(@NODE@("VAC")))
Begin DoDot:2
+21 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
+22 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+23 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+24 ;--- Age/DOB
+25 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:3
+26 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
End DoDot:3
+27 ;
+28 DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
+29 SET PTCNT=PTCNT+1
End DoDot:2
+30 ;--- List of vaccines
+31 SET VACLST=-1
+32 IF $ORDER(@NODE@("VAC",""))'=""
SET VACLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINES",,ITEM)
if VACLST<0
QUIT
+33 IF RORVAC=1
IF VACLST'<0
SET NAME=""
FOR
SET NAME=$ORDER(@NODE@("VAC",NAME))
if NAME=""
QUIT
Begin DoDot:2
+34 SET VLST=$$ADDVAL^RORTSK11(RORTSK,"VACCINE",,VACLST)
+35 if VLST<0
QUIT
+36 SET VDATE=0
+37 FOR
SET VDATE=$ORDER(@NODE@("VAC",NAME,VDATE))
if 'VDATE
QUIT
Begin DoDot:3
+38 DO ADDVAL^RORTSK11(RORTSK,"VAC_NAME",NAME,VLST,1)
+39 DO ADDVAL^RORTSK11(RORTSK,"VAC_DATE",VDATE\1,VLST,1)
End DoDot:3
End DoDot:2
+40 ;--- Immunity
+41 IF RORIMM=1
IF $GET(@NODE@("IMM"))'=""
Begin DoDot:2
+42 SET IMMLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,ITEM)
if IMMLST<0
QUIT
+43 SET LTIMM=$GET(@NODE@("IMM"))
+44 if LTIMM=""
QUIT
+45 DO ADDVAL^RORTSK11(RORTSK,"LTNAME",$PIECE(LTIMM,U),IMMLST,1)
+46 DO ADDVAL^RORTSK11(RORTSK,"DATE",$PIECE(LTIMM,U,2)\1,IMMLST,1)
+47 SET VAL=$PIECE(LTIMM,U,3)
+48 SET TMP=$SELECT($$NUMERIC^RORUTL05(VAL):3,1:1)
+49 DO ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,IMMLST,TMP)
End DoDot:2
+50 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+51 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+52 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+53 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+54 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
+55 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
End DoDot:2
End DoDot:1
if RC<0
QUIT
+56 ;--- Inactivate the patient list tag if the list is empty
+57 if PTCNT'>0
DO UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
+58 ;---
+59 QUIT 0
+60 ;
