RORX024 ;ALB/TK,MAF - HEP A VACCINE OR IMMUNITY REPORT ; 27 Jul 2016 3:03 PM
;;1.5;CLINICAL CASE REGISTRIES;**29,31,32,33,34**;Feb 17, 2006;Build 45
;
;******************************************************************************
; This routine uses the following IAs:
;
; #10103 HL7TFM^XLFDT
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ---------------------------------------
;ROR*1.5*29 APR 2016 T KOPP Added 'Hep A vaccine or immunity report'
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*32 11/01/17 S ALSAHHAR Print the most recent Immunity result
;ROR*1.5*33 MAR 2018 M FERRARESE Adding FUTURE APPOINTMENT as additional identifiers.
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name ; Fix LOINC code table for HEP A/B
;******************************************************************************
;******************************************************************************
;
Q
;
;***** COMPILES THE "HEP A VACCINE OR IMMUNITY" REPORT
; REPORT CODE: 024
;
; .RORTSK Task number and task parameters
;
; The ^TMP("RORX024",$J) global node is used by this function.
;
; ^TMP("RORX024",$J,
; "PAT",
; DFN, Patient descriptor
; ^01: Last 4 digits of SSN
; ^02: Patient name
; ^03: Date of Death
; ^04: ICN
; ^05: Patient Care Team
; ^06: Priamary Care Provider
; ^07: Age/DOB
; "IMM") Result if positive test found or "" if no positive test found
; ^01: Local lab test name
; ^02: Collected date (FM)
; ^03: Lab test result
;
; "VAC", Number of results
; ^01: #
; VaccineName,
; VaccineDate) Always null if node exists
; ^01: Null
;
; Return Values:
; <0 Error code
; 0 Ok
;
HEPARPT(RORTSK) ;
N RORIMM ; Immunity wanted mode (-1|0|1) no|not selected|yes (verified by lab test)
N RORVAC ; Vaccination (-1|0|1) not received|not selected|received (verified by immunization record)
N RORREG ; Registry IEN
N RORVEDT ; Vaccination end date
N RORVSDT ; Vaccination start date
N RORLEDT ; Lab test/LOINC end date
N RORLSDT ; Lab test/LOINC start date
N RORRTN ; Routine to invoke for hep A processing
N RORDAYS ; Future Days patch 33
N RORFUT ; Future Appointment patch 33
;
N NSPT,RC,REPORT,SFLAGS,TMP
S RC=0,RORRTN="RORX024"
K ^TMP(RORRTN,$J)
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
D
. ;--- Get and prepare the report parameters
. S RORREG=$$PARAM^RORTSK01("REGIEN") ; Registry IEN
. S RORVAC=$$RPTMODE("HEPAVAC") ; Vaccination option chosen
. S RORIMM=$$RPTMODE("HEPAIMM") ; Immunity option chosen
. S RC=$$PARAMS(REPORT,.RORVSDT,.RORVEDT,.SFLAGS) Q:RC<0
. ;--- Report header
. S RC=$$HEADER(REPORT) Q:RC<0
. ;--- Query the registry
. D TPPSETUP^RORTSK01(80)
. S RC=$$QUERY^RORX024A(SFLAGS,.NSPT,RORRTN)
. I RC Q:RC<0
. ;--- Store the results
. D TPPSETUP^RORTSK01(20)
. S RC=$$STORE^RORX024A(REPORT,NSPT,RORRTN)
. I RC Q:RC<0
;
;--- Cleanup
K ^TMP(RORRTN,$J)
Q $S(RC<0:RC,1:0)
;
;
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the HEADER element
;
;;PATIENTS(#,NAME,LAST4,AGE,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;
N HEADER,LN,RC,CTAG,LTAG
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
;automatically build the table defintion(s) listed under the header tag above PATCH 33
;--- LOINC codes output
I $G(RORIMM) D
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOINC_CODES",,PARTAG)
. S LN=0 F S LN=$O(^TMP("RORX024",$J,"IMM","TYPE",LN)) Q:'LN D
. . S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
. . D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE",^TMP("RORX024",$J,"IMM","TYPE",LN))
S RC=$$TBLDEF^RORXU002("HEADER^RORX024",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** OUTPUTS THE PARAMETERS TO THE REPORT
;
; PARTAG Reference (IEN) to the parent tag
;
; [.STDT] Start and end dates of the report
; [.ENDT] are returned via these parameters
;
; [.FLAGS] Flags for the $$SKIP^RORXU005 are
; returned via this parameter
;
; Return Values:
; <0 Error code
; >0 IEN of the PARAMETERS element
;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
N PARAMS,TMP
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,,,.FLAGS)
Q:PARAMS<0 PARAMS
;--- Process the list of Lab tests/LOINC codes
I $G(RORIMM) D
. D GETIMM("RORX024") ;extract the immunity criteria for HEP A
;--- Process the list of vaccinations
I $G(RORVAC) D
. D GETVAC("RORX024") ;extract the vaccine criteria for HEP A
;---
Q PARAMS
;
;
; -- Extract immunity (lab) data for a patient
;
; PATIEN IEN of the patient (DFN)
;
; RORLOINC Closed root of a variable, which contains a list
; of LOINC codes for HEP A or HEPB in the format
; @RORLOINC@("VALID",i,
; ^01: LOINC code
; @("PRIORITY",LOINC code,priority)=""
;
; HEPA priority [0 for Ab Total or 1 for IgG]
; HEPB priority [0 for Surface AB or 1 for Core AB]
;
; RORLRES Closed root of an array where the data will be
; returned.
; The data will be stored into the destination
; array in following format:
;
; @RORLRES
; ^01: Local lab test name
; ^02: Collected date (FM)
; ^03: Lab test result
;
; LTSDT Lab test start date (FileMan)
; LTEDT Lab test end date (FileMan)
;
; The function should return the following values:
;
; <0 Error code (the search will be aborted)
; 0 No immunity found
; 1 At least 1 immunity found
;
LAB(PATIEN,RORLOINC,RORLRES,LTSDT,LTEDT) ;
N RC1,DFN,RORID,RORENDT,RORSTDT,ROR1,RESDT,RESULT,RORLRC,RORLAB,RORMSG,Z,Z0
;
S DFN=PATIEN
;
; Search for specific LOINC codes and positive results
S RORLAB=$NA(^TMP("ROROUT",$J)) ;lab API output global
K RORMSG,@RORLAB ;initialize prior to call
;---CALL LAB API---
M RORLRC=@RORLOINC@("VALID")
S RORLRC="CH,MI",RORLRES="",RORID=$$PTID^RORUTL02(DFN)
S RC1=$$GCPR^LA7QRY(RORID,LTSDT,LTEDT,.RORLRC,"*",.RORMSG,RORLAB)
I RC1<0 Q -1
Q:$D(@RORLAB)<10 0
;Note: the Lab API returns data in the form of HL7 segments
N FS,TMP,LOINC,RESULT,RORLTN,RORVAL,RORNODE,RORSEG,SEGTYPE,RORDATE,RORX,RORX1
S FS="|" ;HL7 field separator for lab data
S (RORNODE,RESULT)=0
F S RORNODE=$O(^TMP("ROROUT",$J,RORNODE)) Q:RORNODE="" D
. S RORSEG=$G(^TMP("ROROUT",$J,RORNODE)) ;get entire HL7 segment
. S SEGTYPE=$P(RORSEG,FS,1) ;get segment type (PID,OBR,OBX,etc.)
. Q:SEGTYPE'="OBX" ;we want OBX segments only
. S LOINC=$P($P(RORSEG,FS,4),U,1) ;get LOINC code for test
. Q:$S(LOINC="":1,1:'$D(@RORLOINC@("PRIORITY",LOINC))) ; Call to lab does not filter out unwanted LOINCs
. S RORLTN=$P($P($P(RORSEG,FS,4),U,9),FS) ;local test name
. S RORVAL=$P(RORSEG,FS,6) ;test result value
. S RORVAL=$TR(RORVAL,"""","") ;get rid of double quotes around values
. Q:RORVAL="" ;quit if no value
. ;Check if value meets the positive result criteria selected for immunity
. Q:'$$POS^RORX024A(RORVAL)
. S RORDATE=$$HL7TFM^XLFDT($E($P(RORSEG,FS,15),1,8)) ;get date collected
. ;S RORDATE=RORDATE\1
. ;Output the record into RORX by priority, date, LOINC Code if positive result
. S RORX(+$O(@RORLOINC@("PRIORITY",LOINC,0)),(9999999-RORDATE),LOINC)=RORVAL_U_RORLTN
; Find the result as the earliest date in priority 0 tests and if none, earliest in priority 1
F Z=1,2 S Z0=$O(RORX(Z,0)) I Z0 D Q:RESULT
. S RORX1=$O(RORX(Z,Z0,0))
. Q:RORX1=""
. S RESULT=1,RORLRES=$P(RORX(Z,Z0,RORX1),U,2)_U_(9999999-Z0)_U_$P(RORX(Z,Z0,RORX1),U)
K @RORLAB
Q RESULT
;
;***** DETERMINES THE REPORT MODE FOR IMMUNITY OR VACCINATION
;
; NAME Base name of the attribute ("HEPAIMM" or "HEPAVAC")
; OR ("HEPBIMM" or "HEPBVAC")
; Return Values:
; <0 "No"
; 0 Not selected
; >0 "Yes"
;
RPTMODE(NAME) ;
Q:$$PARAM^RORTSK01("PATIENTS",NAME) 1 ; "Yes"
Q:$$PARAM^RORTSK01("PATIENTS","NO"_NAME) -1 ; "No"
Q 0
;
; ******* EXTRACT LOINC CODES FOR IMMUNITY ********
; RORRTN = the name of the report routine where the IMMUNITY data should be extracted from
;
; Returns ^TMP(RORRTN,$J,"IMM","VALID",n)=LOINC code^LN and
; ^TMP(RORRTN,$J,"IMM","PRIORITY",LOINC code,[0 for Total Ab or 1 for IgG])=""
; ^TMP(RORRTN,$J,"IMM","TYPE",n)=Type of LOINC: list of LOINC codes for type (used for header output)
;
;
GETIMM(RORRTN) ;
N RORDATA,RORI,RORI1,COM,CT,Z
K ^TMP(RORRTN,$J,"IMM")
;
I $E(RORRTN)=U S RORRTN=$P(RORRTN,U,2)
S CT=0
F RORI=1:1 S RORDATA=$P($T(@("IMMUNITY+"_RORI_U_RORRTN)),";;",2) Q:RORDATA="" D
. S ^TMP(RORRTN,$J,"IMM","TYPE",RORI)=$P(RORDATA,U)_": ",COM=0
. F RORI1=2:1 S Z=$P(RORDATA,U,RORI1) Q:Z="" D
. . S CT=CT+1,^TMP(RORRTN,$J,"IMM","VALID",CT)=Z_"^LN"
. . S ^TMP(RORRTN,$J,"IMM","PRIORITY",Z,RORI)=""
. . S ^TMP(RORRTN,$J,"IMM","TYPE",RORI)=^TMP(RORRTN,$J,"IMM","TYPE",RORI)_$S('COM:"",1:";")_Z,COM=1
;
Q
;
; -- LOINC codes to check for HEP A immunity
IMMUNITY ; List of LOINC codes indicating HEP A immunity results by type Line +1 = Total AB (priority), Line +2 = IgG
;;Hepatitis A Ab Total^20575-7^13951-9^22312-3^5183-9^5184-7
;;Hepatitis A IgG^32018-4^22313-1^5179-7
;;
Q
; ******* EXTRACT VACCINE NAMES ********
; RORRTN = the name of the report routine where the IMMUNITY data should be extracted from
;
; Returns ^TMP(RORRTN,$J,"VAC",seq #)=pattern to match
;
GETVAC(RORRTN) ; Extract pertinent vaccine names to match
N CT,CHAR,QUOTE,POS,RORDATA,RORI,RORI1,RESULT,VACNM,Z
;
I $E(RORRTN="^") S RORRTN=$P(RORRTN,U,2)
S CT=0
F RORI=1:1 S RORDATA=$P($T(@("VACCINE+"_RORI_U_RORRTN)),";;",2) Q:RORDATA="" D
. F RORI1=1:1 S VACNM=$P(RORDATA,U,RORI1) Q:VACNM="" D
.. S RESULT=""
.. ; determine pattern
.. S QUOTE=0
.. F POS=1:1:$L(VACNM) S CHAR=$E(VACNM,POS) D
... I POS=1,CHAR="%" S RESULT=".E" Q
... I CHAR'="%" S RESULT=RESULT_$S('QUOTE:"1""",1:"")_CHAR,QUOTE=1 Q
... I CHAR="%" D
.... I QUOTE S RESULT=RESULT_""""
.... S RESULT=RESULT_".E",QUOTE=0
.. I RESULT'="",QUOTE S RESULT=RESULT_""""
.. S CT=CT+1,^TMP(RORRTN,$J,"VAC",CT)=RESULT
;
Q
;
; -- List of vaccines to include
; Business owner also requested (HEPATITIS A&B%, HEPATITIS A/B, HEPATITIS AB) that are the same as %HEPATITIS A%
; (HEP A/HEP B%, HEP A&B, HEP A/HEP B) that are the same as HEP A%
VACCINE ; Hepatitis A vaccine names (% = wild card)
;;HEP A%^%HEPATITIS A%^HEPATITIS-A%^HEPAADULT^HEPAADLT1^HEPA,%^HEPA/HEPB%^%HEP A/B%^HEPAB%^TWINRIX%
;;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX024 12336 printed Sep 23, 2025@19:21:01 Page 2
RORX024 ;ALB/TK,MAF - HEP A VACCINE OR IMMUNITY REPORT ; 27 Jul 2016 3:03 PM
+1 ;;1.5;CLINICAL CASE REGISTRIES;**29,31,32,33,34**;Feb 17, 2006;Build 45
+2 ;
+3 ;******************************************************************************
+4 ; This routine uses the following IAs:
+5 ;
+6 ; #10103 HL7TFM^XLFDT
+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 'Hep A vaccine or immunity report'
+15 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+16 ; identifiers.
+17 ;ROR*1.5*32 11/01/17 S ALSAHHAR Print the most recent Immunity result
+18 ;ROR*1.5*33 MAR 2018 M FERRARESE Adding FUTURE APPOINTMENT as additional identifiers.
+19 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name ; Fix LOINC code table for HEP A/B
+20 ;******************************************************************************
+21 ;******************************************************************************
+22 ;
+23 QUIT
+24 ;
+25 ;***** COMPILES THE "HEP A VACCINE OR IMMUNITY" REPORT
+26 ; REPORT CODE: 024
+27 ;
+28 ; .RORTSK Task number and task parameters
+29 ;
+30 ; The ^TMP("RORX024",$J) global node is used by this function.
+31 ;
+32 ; ^TMP("RORX024",$J,
+33 ; "PAT",
+34 ; DFN, Patient descriptor
+35 ; ^01: Last 4 digits of SSN
+36 ; ^02: Patient name
+37 ; ^03: Date of Death
+38 ; ^04: ICN
+39 ; ^05: Patient Care Team
+40 ; ^06: Priamary Care Provider
+41 ; ^07: Age/DOB
+42 ; "IMM") Result if positive test found or "" if no positive test found
+43 ; ^01: Local lab test name
+44 ; ^02: Collected date (FM)
+45 ; ^03: Lab test result
+46 ;
+47 ; "VAC", Number of results
+48 ; ^01: #
+49 ; VaccineName,
+50 ; VaccineDate) Always null if node exists
+51 ; ^01: Null
+52 ;
+53 ; Return Values:
+54 ; <0 Error code
+55 ; 0 Ok
+56 ;
HEPARPT(RORTSK) ;
+1 ; Immunity wanted mode (-1|0|1) no|not selected|yes (verified by lab test)
NEW RORIMM
+2 ; Vaccination (-1|0|1) not received|not selected|received (verified by immunization record)
NEW RORVAC
+3 ; Registry IEN
NEW RORREG
+4 ; Vaccination end date
NEW RORVEDT
+5 ; Vaccination start date
NEW RORVSDT
+6 ; Lab test/LOINC end date
NEW RORLEDT
+7 ; Lab test/LOINC start date
NEW RORLSDT
+8 ; Routine to invoke for hep A processing
NEW RORRTN
+9 ; Future Days patch 33
NEW RORDAYS
+10 ; Future Appointment patch 33
NEW RORFUT
+11 ;
+12 NEW NSPT,RC,REPORT,SFLAGS,TMP
+13 SET RC=0
SET RORRTN="RORX024"
+14 KILL ^TMP(RORRTN,$JOB)
+15 ;--- Root node of the report
+16 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+17 if REPORT<0
QUIT REPORT
+18 ;
+19 Begin DoDot:1
+20 ;--- Get and prepare the report parameters
+21 ; Registry IEN
SET RORREG=$$PARAM^RORTSK01("REGIEN")
+22 ; Vaccination option chosen
SET RORVAC=$$RPTMODE("HEPAVAC")
+23 ; Immunity option chosen
SET RORIMM=$$RPTMODE("HEPAIMM")
+24 SET RC=$$PARAMS(REPORT,.RORVSDT,.RORVEDT,.SFLAGS)
if RC<0
QUIT
+25 ;--- Report header
+26 SET RC=$$HEADER(REPORT)
if RC<0
QUIT
+27 ;--- Query the registry
+28 DO TPPSETUP^RORTSK01(80)
+29 SET RC=$$QUERY^RORX024A(SFLAGS,.NSPT,RORRTN)
+30 IF RC
if RC<0
QUIT
+31 ;--- Store the results
+32 DO TPPSETUP^RORTSK01(20)
+33 SET RC=$$STORE^RORX024A(REPORT,NSPT,RORRTN)
+34 IF RC
if RC<0
QUIT
End DoDot:1
+35 ;
+36 ;--- Cleanup
+37 KILL ^TMP(RORRTN,$JOB)
+38 QUIT $SELECT(RC<0:RC,1:0)
+39 ;
+40 ;
+41 ;
+42 ;***** OUTPUTS THE REPORT HEADER
+43 ;
+44 ; PARTAG Reference (IEN) to the parent tag
+45 ;
+46 ; Return Values:
+47 ; <0 Error code
+48 ; >0 IEN of the HEADER element
+49 ;
+1 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+2 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+3 ;;PATIENTS(#,NAME,LAST4,DOD,VAC_NAME,VAC_DATE,LTNAME,DATE,RESULT,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+4 ;
+5 NEW HEADER,LN,RC,CTAG,LTAG
+6 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+7 if HEADER<0
QUIT HEADER
+8 ;automatically build the table defintion(s) listed under the header tag above PATCH 33
+9 ;--- LOINC codes output
+10 IF $GET(RORIMM)
Begin DoDot:1
+11 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOINC_CODES",,PARTAG)
+12 SET LN=0
FOR
SET LN=$ORDER(^TMP("RORX024",$JOB,"IMM","TYPE",LN))
if 'LN
QUIT
Begin DoDot:2
+13 SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+14 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE",^TMP("RORX024",$JOB,"IMM","TYPE",LN))
End DoDot:2
End DoDot:1
+15 SET RC=$$TBLDEF^RORXU002("HEADER^RORX024",HEADER)
+16 QUIT $SELECT(RC<0:RC,1:HEADER)
+17 ;
+18 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
+19 ;
+20 ; PARTAG Reference (IEN) to the parent tag
+21 ;
+22 ; [.STDT] Start and end dates of the report
+23 ; [.ENDT] are returned via these parameters
+24 ;
+25 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
+26 ; returned via this parameter
+27 ;
+28 ; Return Values:
+29 ; <0 Error code
+30 ; >0 IEN of the PARAMETERS element
+31 ;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
+1 NEW PARAMS,TMP
+2 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,,,.FLAGS)
+3 if PARAMS<0
QUIT PARAMS
+4 ;--- Process the list of Lab tests/LOINC codes
+5 IF $GET(RORIMM)
Begin DoDot:1
+6 ;extract the immunity criteria for HEP A
DO GETIMM("RORX024")
End DoDot:1
+7 ;--- Process the list of vaccinations
+8 IF $GET(RORVAC)
Begin DoDot:1
+9 ;extract the vaccine criteria for HEP A
DO GETVAC("RORX024")
End DoDot:1
+10 ;---
+11 QUIT PARAMS
+12 ;
+13 ;
+14 ; -- Extract immunity (lab) data for a patient
+15 ;
+16 ; PATIEN IEN of the patient (DFN)
+17 ;
+18 ; RORLOINC Closed root of a variable, which contains a list
+19 ; of LOINC codes for HEP A or HEPB in the format
+20 ; @RORLOINC@("VALID",i,
+21 ; ^01: LOINC code
+22 ; @("PRIORITY",LOINC code,priority)=""
+23 ;
+24 ; HEPA priority [0 for Ab Total or 1 for IgG]
+25 ; HEPB priority [0 for Surface AB or 1 for Core AB]
+26 ;
+27 ; RORLRES Closed root of an array where the data will be
+28 ; returned.
+29 ; The data will be stored into the destination
+30 ; array in following format:
+31 ;
+32 ; @RORLRES
+33 ; ^01: Local lab test name
+34 ; ^02: Collected date (FM)
+35 ; ^03: Lab test result
+36 ;
+37 ; LTSDT Lab test start date (FileMan)
+38 ; LTEDT Lab test end date (FileMan)
+39 ;
+40 ; The function should return the following values:
+41 ;
+42 ; <0 Error code (the search will be aborted)
+43 ; 0 No immunity found
+44 ; 1 At least 1 immunity found
+45 ;
LAB(PATIEN,RORLOINC,RORLRES,LTSDT,LTEDT) ;
+1 NEW RC1,DFN,RORID,RORENDT,RORSTDT,ROR1,RESDT,RESULT,RORLRC,RORLAB,RORMSG,Z,Z0
+2 ;
+3 SET DFN=PATIEN
+4 ;
+5 ; Search for specific LOINC codes and positive results
+6 ;lab API output global
SET RORLAB=$NAME(^TMP("ROROUT",$JOB))
+7 ;initialize prior to call
KILL RORMSG,@RORLAB
+8 ;---CALL LAB API---
+9 MERGE RORLRC=@RORLOINC@("VALID")
+10 SET RORLRC="CH,MI"
SET RORLRES=""
SET RORID=$$PTID^RORUTL02(DFN)
+11 SET RC1=$$GCPR^LA7QRY(RORID,LTSDT,LTEDT,.RORLRC,"*",.RORMSG,RORLAB)
+12 IF RC1<0
QUIT -1
+13 if $DATA(@RORLAB)<10
QUIT 0
+14 ;Note: the Lab API returns data in the form of HL7 segments
+15 NEW FS,TMP,LOINC,RESULT,RORLTN,RORVAL,RORNODE,RORSEG,SEGTYPE,RORDATE,RORX,RORX1
+16 ;HL7 field separator for lab data
SET FS="|"
+17 SET (RORNODE,RESULT)=0
+18 FOR
SET RORNODE=$ORDER(^TMP("ROROUT",$JOB,RORNODE))
if RORNODE=""
QUIT
Begin DoDot:1
+19 ;get entire HL7 segment
SET RORSEG=$GET(^TMP("ROROUT",$JOB,RORNODE))
+20 ;get segment type (PID,OBR,OBX,etc.)
SET SEGTYPE=$PIECE(RORSEG,FS,1)
+21 ;we want OBX segments only
if SEGTYPE'="OBX"
QUIT
+22 ;get LOINC code for test
SET LOINC=$PIECE($PIECE(RORSEG,FS,4),U,1)
+23 ; Call to lab does not filter out unwanted LOINCs
if $SELECT(LOINC=""
QUIT
+24 ;local test name
SET RORLTN=$PIECE($PIECE($PIECE(RORSEG,FS,4),U,9),FS)
+25 ;test result value
SET RORVAL=$PIECE(RORSEG,FS,6)
+26 ;get rid of double quotes around values
SET RORVAL=$TRANSLATE(RORVAL,"""","")
+27 ;quit if no value
if RORVAL=""
QUIT
+28 ;Check if value meets the positive result criteria selected for immunity
+29 if '$$POS^RORX024A(RORVAL)
QUIT
+30 ;get date collected
SET RORDATE=$$HL7TFM^XLFDT($EXTRACT($PIECE(RORSEG,FS,15),1,8))
+31 ;S RORDATE=RORDATE\1
+32 ;Output the record into RORX by priority, date, LOINC Code if positive result
+33 SET RORX(+$ORDER(@RORLOINC@("PRIORITY",LOINC,0)),(9999999-RORDATE),LOINC)=RORVAL_U_RORLTN
End DoDot:1
+34 ; Find the result as the earliest date in priority 0 tests and if none, earliest in priority 1
+35 FOR Z=1,2
SET Z0=$ORDER(RORX(Z,0))
IF Z0
Begin DoDot:1
+36 SET RORX1=$ORDER(RORX(Z,Z0,0))
+37 if RORX1=""
QUIT
+38 SET RESULT=1
SET RORLRES=$PIECE(RORX(Z,Z0,RORX1),U,2)_U_(9999999-Z0)_U_$PIECE(RORX(Z,Z0,RORX1),U)
End DoDot:1
if RESULT
QUIT
+39 KILL @RORLAB
+40 QUIT RESULT
+41 ;
+42 ;***** DETERMINES THE REPORT MODE FOR IMMUNITY OR VACCINATION
+43 ;
+44 ; NAME Base name of the attribute ("HEPAIMM" or "HEPAVAC")
+45 ; OR ("HEPBIMM" or "HEPBVAC")
+46 ; Return Values:
+47 ; <0 "No"
+48 ; 0 Not selected
+49 ; >0 "Yes"
+50 ;
RPTMODE(NAME) ;
+1 ; "Yes"
if $$PARAM^RORTSK01("PATIENTS",NAME)
QUIT 1
+2 ; "No"
if $$PARAM^RORTSK01("PATIENTS","NO"_NAME)
QUIT -1
+3 QUIT 0
+4 ;
+5 ; ******* EXTRACT LOINC CODES FOR IMMUNITY ********
+6 ; RORRTN = the name of the report routine where the IMMUNITY data should be extracted from
+7 ;
+8 ; Returns ^TMP(RORRTN,$J,"IMM","VALID",n)=LOINC code^LN and
+9 ; ^TMP(RORRTN,$J,"IMM","PRIORITY",LOINC code,[0 for Total Ab or 1 for IgG])=""
+10 ; ^TMP(RORRTN,$J,"IMM","TYPE",n)=Type of LOINC: list of LOINC codes for type (used for header output)
+11 ;
+12 ;
GETIMM(RORRTN) ;
+1 NEW RORDATA,RORI,RORI1,COM,CT,Z
+2 KILL ^TMP(RORRTN,$JOB,"IMM")
+3 ;
+4 IF $EXTRACT(RORRTN)=U
SET RORRTN=$PIECE(RORRTN,U,2)
+5 SET CT=0
+6 FOR RORI=1:1
SET RORDATA=$PIECE($TEXT(@("IMMUNITY+"_RORI_U_RORRTN)),";;",2)
if RORDATA=""
QUIT
Begin DoDot:1
+7 SET ^TMP(RORRTN,$JOB,"IMM","TYPE",RORI)=$PIECE(RORDATA,U)_": "
SET COM=0
+8 FOR RORI1=2:1
SET Z=$PIECE(RORDATA,U,RORI1)
if Z=""
QUIT
Begin DoDot:2
+9 SET CT=CT+1
SET ^TMP(RORRTN,$JOB,"IMM","VALID",CT)=Z_"^LN"
+10 SET ^TMP(RORRTN,$JOB,"IMM","PRIORITY",Z,RORI)=""
+11 SET ^TMP(RORRTN,$JOB,"IMM","TYPE",RORI)=^TMP(RORRTN,$JOB,"IMM","TYPE",RORI)_$SELECT('COM:"",1:";")_Z
SET COM=1
End DoDot:2
End DoDot:1
+12 ;
+13 QUIT
+14 ;
+15 ; -- LOINC codes to check for HEP A immunity
IMMUNITY ; List of LOINC codes indicating HEP A immunity results by type Line +1 = Total AB (priority), Line +2 = IgG
+1 ;;Hepatitis A Ab Total^20575-7^13951-9^22312-3^5183-9^5184-7
+2 ;;Hepatitis A IgG^32018-4^22313-1^5179-7
+3 ;;
+4 QUIT
+5 ; ******* EXTRACT VACCINE NAMES ********
+6 ; RORRTN = the name of the report routine where the IMMUNITY data should be extracted from
+7 ;
+8 ; Returns ^TMP(RORRTN,$J,"VAC",seq #)=pattern to match
+9 ;
GETVAC(RORRTN) ; Extract pertinent vaccine names to match
+1 NEW CT,CHAR,QUOTE,POS,RORDATA,RORI,RORI1,RESULT,VACNM,Z
+2 ;
+3 IF $EXTRACT(RORRTN="^")
SET RORRTN=$PIECE(RORRTN,U,2)
+4 SET CT=0
+5 FOR RORI=1:1
SET RORDATA=$PIECE($TEXT(@("VACCINE+"_RORI_U_RORRTN)),";;",2)
if RORDATA=""
QUIT
Begin DoDot:1
+6 FOR RORI1=1:1
SET VACNM=$PIECE(RORDATA,U,RORI1)
if VACNM=""
QUIT
Begin DoDot:2
+7 SET RESULT=""
+8 ; determine pattern
+9 SET QUOTE=0
+10 FOR POS=1:1:$LENGTH(VACNM)
SET CHAR=$EXTRACT(VACNM,POS)
Begin DoDot:3
+11 IF POS=1
IF CHAR="%"
SET RESULT=".E"
QUIT
+12 IF CHAR'="%"
SET RESULT=RESULT_$SELECT('QUOTE:"1""",1:"")_CHAR
SET QUOTE=1
QUIT
+13 IF CHAR="%"
Begin DoDot:4
+14 IF QUOTE
SET RESULT=RESULT_""""
+15 SET RESULT=RESULT_".E"
SET QUOTE=0
End DoDot:4
End DoDot:3
+16 IF RESULT'=""
IF QUOTE
SET RESULT=RESULT_""""
+17 SET CT=CT+1
SET ^TMP(RORRTN,$JOB,"VAC",CT)=RESULT
End DoDot:2
End DoDot:1
+18 ;
+19 QUIT
+20 ;
+21 ; -- List of vaccines to include
+22 ; Business owner also requested (HEPATITIS A&B%, HEPATITIS A/B, HEPATITIS AB) that are the same as %HEPATITIS A%
+23 ; (HEP A/HEP B%, HEP A&B, HEP A/HEP B) that are the same as HEP A%
VACCINE ; Hepatitis A vaccine names (% = wild card)
+1 ;;HEP A%^%HEPATITIS A%^HEPATITIS-A%^HEPAADULT^HEPAADLT1^HEPA,%^HEPA/HEPB%^%HEP A/B%^HEPAB%^TWINRIX%
+2 ;;
+3 QUIT
+4 ;
