Routine: RORX024

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

 ;******************************************************************************

 ;******************************************************************************

 ;***** 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

 . ;--- 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

HEADER(PARTAG) ;

 ;;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

 ; --  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

;;

 ; ******* 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

 ; -- 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%

;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX024   12336     printed  Mar 13, 2025@20:49:41                                                                                                                                                                                                    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      ;

HEADER(PARTAG) ;

 +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       ;

RORX024.m