PXRMXX.m

PXRMXX ; SLC/PJH - Extract Patient sample;07/29/2004

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

 ;Update ^TMP - all patients with encounters

 ;------------------------------------------

TMP S ^TMP(NODE,$J,"TEMP",DFN)="" Q

 ;

 ;Save individual encounter into FIND1

 ;------------------------------------

SAV S FCNT=FCNT+1,FOUND=1 M FIND1(FCNT)=FIND(ENC) Q

 ;

 ;Check if finding is in date range

 ;---------------------------------

DCHK(DNODE) ;

 N DATE,LTERM,LTRAN,TNAM,SNUM,TERMNAM,TERMNAT

 S DATE=$G(FIND(ENC,DNODE)) Q:DATE=""

 ;

 I (DATE<BD)!(DATE>ED) Q

 ;Lab transforms

 I REM(PXRMITEM)="VA-NATIONAL EPI LAB EXTRACT" D  Q:LTRAN

 .S LTRAN=0 D:$P(FIND(ENC,"FINDING"),";",2)="LAB(60," LTRAN

 ;National DB term mapping

 S TERMNAM=$P($G(FIND(ENC,"TERM")),U)

 ;If term exists check if it needs re-mapping for this reminder

 I TERMNAM]"" D

 .;Get the alternate name from the REM array

 .S TERMNAT=$G(REM(PXRMITEM,TERMNAM)) Q:TERMNAT=""

 .;National database code

 .S FIND(ENC,"ALTTRM")=TERMNAT

 ;Set source number code

 S SNUM=""

 I $G(FIND(ENC,"FILE NUMBER"))=9000011 S SNUM=1

 I $G(FIND(ENC,"FILE NUMBER"))=9000010.07 S SNUM=2

 I $G(FIND(ENC,"FILE NUMBER"))=45 S SNUM=3

 S FIND(ENC,"S/N")=SNUM

 ;

 ;Save encounter

 D SAV

 Q

 ;

 ;Check for findings

 ;------------------

FCHEK(PXRMITEM) ;

 N ECNT,EDATE,ENC,LDONE,FOUND

 ;Get reminder name

 S PXRMNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U)

 ;Check each encounter

 S ENC=0,ECNT=0,FOUND=0,LDONE=0

 F  S ENC=$O(FIND(ENC)) Q:'ENC  D

 .;Ignore medications - these are loaded from pharmacy

 .I $D(FIND(ENC,"DRUG")) Q

 .;Check if finding is in date range

 .I $D(FIND(ENC,"FINDING")) D DCHK("DATE")

 ;

 Q

 ;

 ;Update ^TMP - all patients with findings

 ;----------------------------------------

FSAVE N CNT,FIEN,FCNT,FUNIQ,FREC

 N VDATA,VDATE,VFOUND,VLAST,VIEN,VLTYP,VOK,VSERV,VTYP

 ;Extract the visit date and type from visit record

 S CNT=0,FUNIQ=0,VLAST=0,VFOUND=0,VLTYP=""

 F  S CNT=$O(FIND1(CNT)) Q:'CNT  D

 .S VOK=0

 .I $D(FIND1(CNT,"VIEN")) D

 ..S VIEN=$G(FIND1(CNT,"VIEN")) Q:'VIEN

 ..S VDATA=$G(^AUPNVSIT(VIEN,0)) Q:VDATA=""

 ..;Get visit date and service from visit record

 ..S VDATE=$P(VDATA,U),VSERV=$P(VDATA,U,7),VFOUND=1,VOK=1,VTYP="O"

 ..;Calculate visit type from sevice

 ..I (VSERV="D")!(VSERV="H")!(VSERV="I") S VTYP="I"

 .;If no visit info default to finding date

 .I 'VOK S VDATE=$G(FIND1(CNT,"DATE")),VTYP="O" D

 ..N VAIN,VAINDT S VAINDT=VDATE D INP^VADPT

 ..I $G(VAIN(7))'="" S VTYP="I"

 .;Save encounter/finding date and type

 .S FIND1(CNT)=VDATE_U_VTYP

 .;Save count by finding for report

 .S FIEN=$G(FIND1(CNT,"FINDING")) I FIEN="" S FIEN="NO FINDING"

 .S FREC=$G(PXRMFIEN(FIEN)),FCNT=$P(FREC,U),FUNIQ=$P(FREC,U,2)

 .S FCNT=FCNT+1 I '$G(FUNIQ(FIEN)) S FUNIQ=FUNIQ+1

 .S PXRMFIEN(FIEN)=FCNT_U_FUNIQ,FUNIQ(FIEN)=1

 .;Save most recent

 .I VDATE>VLAST S VLAST=VDATE,VLTYP=VTYP

 ;

 ;Save patient

 S ^TMP(NODE,$J,DFN)=VLAST_U_VLTYP

 ;Save findings

 M ^TMP(NODE,$J,DFN,"FIND")=FIND1

 ;

 Q

 ;

 ;Check each patient for findings

 ;-------------------------------

FIND N BD,DFN,ED,LAB,LABN,PXRMITEM,PXRMNAM,OR,REM,SAVE,SEARCH

 ;

 ;Build array of reminders and terms to be re-mapped

 ;

 ;This requires that LAB(69.51) is created to include a list of IEN's

 ;

 S PXRMITEM=0

 F  S PXRMITEM=$O(^LAB(69.51,"B",PXRMITEM)) Q:'PXRMITEM  D

 .S PXRMNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U)

 .I PXRMNAM'="VA-NATIONAL EPI RX EXTRACT" S REM(PXRMITEM)=PXRMNAM

 .;Get finding list for these reminders and medication list

 .D REM^PXRMXX1(PXRMITEM,.SEARCH,.LAB)

 .;Hep A,B,C lab tests

 .S LABN("HEP C VIRUS ANTIBODY POSITIVE")=""

 .S LABN("HEP C VIRUS ANTIBODY NEGATIVE")=""

 .S LABN("HAV Ab positive")=""

 .S LABN("HAV IgM Ab positive")=""

 .S LABN("HAV IgG positive")=""

 .S LABN("HBs Ab positive")=""

 .S LABN("HBs Ag positive")=""

 .S LABN("HBc Ab IgM positive")=""

 .S LABN("HBe Ag positive")=""

 .;NDB Transformations

 .I PXRMNAM="VA-HEP C RISK ASSESSMENT" D

 ..S REM(PXRMITEM,"VA-DECLINED HEP C RISK ASSESSMENT")=1

 ..S REM(PXRMITEM,"VA-NO RISK FACTORS FOR HEP C")=2

 ..S REM(PXRMITEM,"VA-PREVIOUSLY ASSESSED HEP C RISK")=3

 ..S REM(PXRMITEM,"VA-RISK FACTOR FOR HEPATITIS C")=4

 ..S REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY POSITIVE")=5

 ..S REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY NEGATIVE")=6

 ..S REM(PXRMITEM,"VA-HEPATITIS C INFECTION")=7

 ;

 ;Build pharmacy codes list

 F FTYPE="PSNDF(50.6,","PSDRUG(","PS(50.605," D

 .S FIEN=""

 .F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 ..S OR(FIEN_";"_FTYPE)=""

 ;

 ;Search for pharmacy outpatients

 I $O(OR(""))]"" D EN^PSOORAPI(PXRMBDT,PXRMEDT,.OR,"F","PXRMPSO"_NODE)

 ;

 ;Search for pharmacy inpatients

 I $O(OR(""))]"" D EN^PSJORAPI(PXRMBDT,PXRMEDT,.OR,"","PXRMPSI"_NODE)

 ;

 ;Build Lab codes list

 S FTYPE="LAB(60,",FIEN="" K OR

 F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 .S OR(FIEN)=""

 ;

 ;Search for lab patients

 I $O(OR(""))]"" D LAB^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 ;

 ;Build Health Factors list

 S FTYPE="AUTTHF(",FIEN="" K OR

 F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 .S OR(FIEN)=""

 ;

 ;Search for HF patients

 I $O(OR(""))]"" D HF^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 ;

 ;Build Patient Education list

 S FTYPE="AUTTEDT(",FIEN="" K OR

 F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 .S OR(FIEN)=""

 ;

 ;Search for PED patients

 I $O(OR(""))]"" D PED^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 ;

 ;Build Examination list

 S FTYPE="AUTTEXAM(",FIEN="" K OR

 F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 .S OR(FIEN)=""

 ;

 ;Search for Exam patients

 I $O(OR(""))]"" D EXAM^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 ;

 ;Build POV codes list

 S FTYPE="ICD9(",FIEN="" K OR

 F  S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN  D

 .S OR(FIEN)="",^TMP("PXRMPOV"_NODE,$J,FIEN)=""

 ;

 ;Search for POV patients

 I $O(OR(""))]"" D POV^PXRMXX2(PXRMBDT,PXRMEDT,"PXRMPOV"_NODE,NODE)

 ;

 S BD=PXRMBDT-.0001,ED=PXRMEDT+.2359,DFN=""

 F  S DFN=$O(^TMP(NODE,$J,"TEMP",DFN)) Q:'DFN  Q:TSTOP=1  D

 .;Check if stop task requested

 .I $$S^%ZTLOAD S TSTOP=1 Q

 .;Update total patient count for report

 .S PXRMCNT=PXRMCNT+1

 .N FIND1,FCNT

 .;Process reminders

 .S PXRMITEM=0,FCNT=0

 .F  S PXRMITEM=$O(REM(PXRMITEM)) Q:'PXRMITEM  D

 ..;Check reminder exists

 ..Q:'$D(^PXD(811.9,PXRMITEM,0))

 ..;Evaluate reminder to obtain list of findings

 ..N FIND

 ..D FIDATA^PXRM(DFN,PXRMITEM,.FIND)

 ..;Check if findings exist for the date range

 ..D FCHEK(PXRMITEM)

 .;Save in ^TMP

 .I FCNT D FSAVE K FIND1 S PXRMFCNT=PXRMFCNT+1

 ;

 ;Merge in patients from Outpatient Pharmacy

 D PSMERG^PXRMXX1("PXRMPSO",NODE,.SEARCH)

 ;Merge in patients from Inpatient Pharmacy

 D PSMERG^PXRMXX1("PXRMPSI",NODE,.SEARCH)

 ;

 Q

 ;

 ;Complex logic to handle lab/reminder mismatches

 ;-----------------------------------------------

LTRAN S LTERM=$P($G(FIND(ENC,"TERM")),U) Q:LTERM=""

 ;Skip terms not used in cohort logic

 I $D(LAB(LTERM)) S LTRAN=1 Q

 ;If one of selected list send the latest out of cohort entries instead

 I $D(LABN(LTERM)) S LTRAN=1 Q:LDONE=1  D

 .N ENC,TERM,DATE

 .S ENC=0,LDONE=1

 .F  S ENC=$O(FIND(ENC)) Q:'ENC  D

 ..S TERM=$P($G(FIND(ENC,"TERM")),U) Q:TERM=""

 ..;Check if the term is in the out of cohort list

 ..I $D(LAB(TERM)) D

 ...;Check if lab test is within date range or prior

 ...S DATE=$G(FIND(ENC,"DATE")) Q:DATE=""  Q:DATE>ED

 ...D SAV

 ;

 Q

 ;

 ;

 ;Entry point for API

 ;-------------------

PATS(PXRMBDT,PXRMEDT,NODE) ;

 ;

 ; PXRMBDT - Start date in fileman format

 ; PXRMEDT - End date in fileman format

 ; NODE  - Target name for ^TMP(NODE,$J)

 ;

 ;Task stopped

 N TSTOP S TSTOP=0

 ;

 ;

 ;Build temporary array of all wards

 ;N PXRMLCHL,PXRMLOCN D LCHL^PXRMXAP(1,.PXRMLCHL)

 ;

 ;Patients, patients with findings, finding and term counts

 N PXRMCNT,PXRMFCNT,PXRMFIEN,PXRMTIEN S PXRMCNT=0,PXRMFCNT=0

 ;

 ;Clear ^TMP

 K ^TMP(NODE,$J)

 ;Current inpatients

 ;D INP

 ;Inpatient admissions

 ;D ADM

 ;Outpatient visits

 ;D VISITS Q:TSTOP=1

 ;

 ;Check for findings in the selected patients

 D FIND Q:TSTOP=1

 ;

 ;Save report

 D REPORT^PXRMXX1(NODE)

 ;

 ;Remove list of all patients with encounters

 K ^TMP(NODE,$J,"TEMP")

 ;Remove pharmacy outpatient list

 K ^TMP("PXRMPSO"_NODE,$J)

 ;Remove pharmacy inpatient list

 K ^TMP("PXRMPSI"_NODE,$J)

 ;Remove icd9 list

 K ^TMP("PXRMPOV"_NODE,$J)

 Q

 ;

 ;Build list of inpatients admissions

 ;-----------------------------------

ADM N HLOCIEN,IC,DFN,BD,ED

 ;Get admissions for each selected location

 F IC=1:1 Q:'$D(PXRMLCHL(IC))  D

 .S HLOCIEN=$P(PXRMLCHL(IC),U,2) Q:HLOCIEN=""

 .; Get admissions from patient movements and return DFN's in PATS

 .S BD=PXRMBDT-.0001

 .S ED=PXRMEDT+.2359

 .N PATS D ADM^PXRMXAP(HLOCIEN,.PATS,BD,ED)

 .;Build ^TMP for selected patients 

 .S DFN=""

 .F  S DFN=$O(PATS(DFN)) Q:DFN=""  D TMP

 Q

 ;

 ;Build list of Current inpatients

 ;--------------------------------

INP N HLOCIEN,IC,DFN

 ;Get Current inpatients for each location

 F IC=1:1 Q:'$D(PXRMLCHL(IC))  D

 .S HLOCIEN=$P(PXRMLCHL(IC),U,2) Q:HLOCIEN=""

 .;Get WARDIEN,WARDNAM and return DFN's in PATS

 .N PATS D WARD^PXRMXAP(HLOCIEN,.PATS)

 .;Build ^TMP for selected patients 

 .S DFN=""

 .F  S DFN=$O(PATS(DFN)) Q:DFN=""  D TMP

 Q

 ;

 ;Scan visit file to build list of patients

 ;-----------------------------------------

VISITS N BD,DFN,ED,HLOCIEN,IC,VIEN,VISIT

 ;

 S BD=PXRMBDT-.0001

 S ED=PXRMEDT+.2359

 ;Get Date ; DBIA #2028

 F  S BD=$O(^AUPNVSIT("B",BD)) Q:BD>ED  Q:BD=""  Q:TSTOP=1  D

 .S VIEN=0

 .;Get individual visit

 .F  S VIEN=$O(^AUPNVSIT("B",BD,VIEN)) Q:VIEN=""  Q:TSTOP=1  D

 ..;Check if stop task requested

 ..I $$S^%ZTLOAD S TSTOP=1 Q

 ..;Screen Individual Visit

 ..S VISIT=$G(^AUPNVSIT(VIEN,0)) Q:VISIT=""

 ..;Patient IEN

 ..S DFN=$P(VISIT,U,5) Q:'DFN

 ..;Build patient list in ^TMP

 ..D TMP

 Q

PXRMXX    ; SLC/PJH - Extract Patient sample;07/29/2004

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;Update ^TMP - all patients with encounters

 +4       ;------------------------------------------

TMP        SET ^TMP(NODE,$JOB,"TEMP",DFN)=""

           QUIT 

 +1       ;

 +2       ;Save individual encounter into FIND1

 +3       ;------------------------------------

SAV        SET FCNT=FCNT+1

           SET FOUND=1

           MERGE FIND1(FCNT)=FIND(ENC)

           QUIT 

 +1       ;

 +2       ;Check if finding is in date range

 +3       ;---------------------------------

DCHK(DNODE) ;

 +1        NEW DATE,LTERM,LTRAN,TNAM,SNUM,TERMNAM,TERMNAT

 +2        SET DATE=$GET(FIND(ENC,DNODE))

           IF DATE=""

               QUIT 

 +3       ;

 +4        IF (DATE<BD)!(DATE>ED)

               QUIT 

 +5       ;Lab transforms

 +6        IF REM(PXRMITEM)="VA-NATIONAL EPI LAB EXTRACT"

               Begin DoDot:1

 +7                SET LTRAN=0

                   IF $PIECE(FIND(ENC,"FINDING"),";",2)="LAB(60,"

                       DO LTRAN

               End DoDot:1

               IF LTRAN

                   QUIT 

 +8       ;National DB term mapping

 +9        SET TERMNAM=$PIECE($GET(FIND(ENC,"TERM")),U)

 +10      ;If term exists check if it needs re-mapping for this reminder

 +11       IF TERMNAM]""

               Begin DoDot:1

 +12      ;Get the alternate name from the REM array

 +13               SET TERMNAT=$GET(REM(PXRMITEM,TERMNAM))

                   IF TERMNAT=""

                       QUIT 

 +14      ;National database code

 +15               SET FIND(ENC,"ALTTRM")=TERMNAT

               End DoDot:1

 +16      ;Set source number code

 +17       SET SNUM=""

 +18       IF $GET(FIND(ENC,"FILE NUMBER"))=9000011

               SET SNUM=1

 +19       IF $GET(FIND(ENC,"FILE NUMBER"))=9000010.07

               SET SNUM=2

 +20       IF $GET(FIND(ENC,"FILE NUMBER"))=45

               SET SNUM=3

 +21       SET FIND(ENC,"S/N")=SNUM

 +22      ;

 +23      ;Save encounter

 +24       DO SAV

 +25       QUIT 

 +26      ;

 +27      ;Check for findings

 +28      ;------------------

FCHEK(PXRMITEM) ;

 +1        NEW ECNT,EDATE,ENC,LDONE,FOUND

 +2       ;Get reminder name

 +3        SET PXRMNAM=$PIECE($GET(^PXD(811.9,PXRMITEM,0)),U)

 +4       ;Check each encounter

 +5        SET ENC=0

           SET ECNT=0

           SET FOUND=0

           SET LDONE=0

 +6        FOR 

               SET ENC=$ORDER(FIND(ENC))

               IF 'ENC

                   QUIT 

               Begin DoDot:1

 +7       ;Ignore medications - these are loaded from pharmacy

 +8                IF $DATA(FIND(ENC,"DRUG"))

                       QUIT 

 +9       ;Check if finding is in date range

 +10               IF $DATA(FIND(ENC,"FINDING"))

                       DO DCHK("DATE")

               End DoDot:1

 +11      ;

 +12       QUIT 

 +13      ;

 +14      ;Update ^TMP - all patients with findings

 +15      ;----------------------------------------

FSAVE      NEW CNT,FIEN,FCNT,FUNIQ,FREC

 +1        NEW VDATA,VDATE,VFOUND,VLAST,VIEN,VLTYP,VOK,VSERV,VTYP

 +2       ;Extract the visit date and type from visit record

 +3        SET CNT=0

           SET FUNIQ=0

           SET VLAST=0

           SET VFOUND=0

           SET VLTYP=""

 +4        FOR 

               SET CNT=$ORDER(FIND1(CNT))

               IF 'CNT

                   QUIT 

               Begin DoDot:1

 +5                SET VOK=0

 +6                IF $DATA(FIND1(CNT,"VIEN"))

                       Begin DoDot:2

 +7                        SET VIEN=$GET(FIND1(CNT,"VIEN"))

                           IF 'VIEN

                               QUIT 

 +8                        SET VDATA=$GET(^AUPNVSIT(VIEN,0))

                           IF VDATA=""

                               QUIT 

 +9       ;Get visit date and service from visit record

 +10                       SET VDATE=$PIECE(VDATA,U)

                           SET VSERV=$PIECE(VDATA,U,7)

                           SET VFOUND=1

                           SET VOK=1

                           SET VTYP="O"

 +11      ;Calculate visit type from sevice

 +12                       IF (VSERV="D")!(VSERV="H")!(VSERV="I")

                               SET VTYP="I"

                       End DoDot:2

 +13      ;If no visit info default to finding date

 +14               IF 'VOK

                       SET VDATE=$GET(FIND1(CNT,"DATE"))

                       SET VTYP="O"

                       Begin DoDot:2

 +15                       NEW VAIN,VAINDT

                           SET VAINDT=VDATE

                           DO INP^VADPT

 +16                       IF $GET(VAIN(7))'=""

                               SET VTYP="I"

                       End DoDot:2

 +17      ;Save encounter/finding date and type

 +18               SET FIND1(CNT)=VDATE_U_VTYP

 +19      ;Save count by finding for report

 +20               SET FIEN=$GET(FIND1(CNT,"FINDING"))

                   IF FIEN=""

                       SET FIEN="NO FINDING"

 +21               SET FREC=$GET(PXRMFIEN(FIEN))

                   SET FCNT=$PIECE(FREC,U)

                   SET FUNIQ=$PIECE(FREC,U,2)

 +22               SET FCNT=FCNT+1

                   IF '$GET(FUNIQ(FIEN))

                       SET FUNIQ=FUNIQ+1

 +23               SET PXRMFIEN(FIEN)=FCNT_U_FUNIQ

                   SET FUNIQ(FIEN)=1

 +24      ;Save most recent

 +25               IF VDATE>VLAST

                       SET VLAST=VDATE

                       SET VLTYP=VTYP

               End DoDot:1

 +26      ;

 +27      ;Save patient

 +28       SET ^TMP(NODE,$JOB,DFN)=VLAST_U_VLTYP

 +29      ;Save findings

 +30       MERGE ^TMP(NODE,$JOB,DFN,"FIND")=FIND1

 +31      ;

 +32       QUIT 

 +33      ;

 +34      ;Check each patient for findings

 +35      ;-------------------------------

FIND       NEW BD,DFN,ED,LAB,LABN,PXRMITEM,PXRMNAM,OR,REM,SAVE,SEARCH

 +1       ;

 +2       ;Build array of reminders and terms to be re-mapped

 +3       ;

 +4       ;This requires that LAB(69.51) is created to include a list of IEN's

 +5       ;

 +6        SET PXRMITEM=0

 +7        FOR 

               SET PXRMITEM=$ORDER(^LAB(69.51,"B",PXRMITEM))

               IF 'PXRMITEM

                   QUIT 

               Begin DoDot:1

 +8                SET PXRMNAM=$PIECE($GET(^PXD(811.9,PXRMITEM,0)),U)

 +9                IF PXRMNAM'="VA-NATIONAL EPI RX EXTRACT"

                       SET REM(PXRMITEM)=PXRMNAM

 +10      ;Get finding list for these reminders and medication list

 +11               DO REM^PXRMXX1(PXRMITEM,.SEARCH,.LAB)

 +12      ;Hep A,B,C lab tests

 +13               SET LABN("HEP C VIRUS ANTIBODY POSITIVE")=""

 +14               SET LABN("HEP C VIRUS ANTIBODY NEGATIVE")=""

 +15               SET LABN("HAV Ab positive")=""

 +16               SET LABN("HAV IgM Ab positive")=""

 +17               SET LABN("HAV IgG positive")=""

 +18               SET LABN("HBs Ab positive")=""

 +19               SET LABN("HBs Ag positive")=""

 +20               SET LABN("HBc Ab IgM positive")=""

 +21               SET LABN("HBe Ag positive")=""

 +22      ;NDB Transformations

 +23               IF PXRMNAM="VA-HEP C RISK ASSESSMENT"

                       Begin DoDot:2

 +24                       SET REM(PXRMITEM,"VA-DECLINED HEP C RISK ASSESSMENT")=1

 +25                       SET REM(PXRMITEM,"VA-NO RISK FACTORS FOR HEP C")=2

 +26                       SET REM(PXRMITEM,"VA-PREVIOUSLY ASSESSED HEP C RISK")=3

 +27                       SET REM(PXRMITEM,"VA-RISK FACTOR FOR HEPATITIS C")=4

 +28                       SET REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY POSITIVE")=5

 +29                       SET REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY NEGATIVE")=6

 +30                       SET REM(PXRMITEM,"VA-HEPATITIS C INFECTION")=7

                       End DoDot:2

               End DoDot:1

 +31      ;

 +32      ;Build pharmacy codes list

 +33       FOR FTYPE="PSNDF(50.6,","PSDRUG(","PS(50.605,"

               Begin DoDot:1

 +34               SET FIEN=""

 +35               FOR 

                       SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

                       IF 'FIEN

                           QUIT 

                       Begin DoDot:2

 +36                       SET OR(FIEN_";"_FTYPE)=""

                       End DoDot:2

               End DoDot:1

 +37      ;

 +38      ;Search for pharmacy outpatients

 +39       IF $ORDER(OR(""))]""

               DO EN^PSOORAPI(PXRMBDT,PXRMEDT,.OR,"F","PXRMPSO"_NODE)

 +40      ;

 +41      ;Search for pharmacy inpatients

 +42       IF $ORDER(OR(""))]""

               DO EN^PSJORAPI(PXRMBDT,PXRMEDT,.OR,"","PXRMPSI"_NODE)

 +43      ;

 +44      ;Build Lab codes list

 +45       SET FTYPE="LAB(60,"

           SET FIEN=""

           KILL OR

 +46       FOR 

               SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

               IF 'FIEN

                   QUIT 

               Begin DoDot:1

 +47               SET OR(FIEN)=""

               End DoDot:1

 +48      ;

 +49      ;Search for lab patients

 +50       IF $ORDER(OR(""))]""

               DO LAB^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 +51      ;

 +52      ;Build Health Factors list

 +53       SET FTYPE="AUTTHF("

           SET FIEN=""

           KILL OR

 +54       FOR 

               SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

               IF 'FIEN

                   QUIT 

               Begin DoDot:1

 +55               SET OR(FIEN)=""

               End DoDot:1

 +56      ;

 +57      ;Search for HF patients

 +58       IF $ORDER(OR(""))]""

               DO HF^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 +59      ;

 +60      ;Build Patient Education list

 +61       SET FTYPE="AUTTEDT("

           SET FIEN=""

           KILL OR

 +62       FOR 

               SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

               IF 'FIEN

                   QUIT 

               Begin DoDot:1

 +63               SET OR(FIEN)=""

               End DoDot:1

 +64      ;

 +65      ;Search for PED patients

 +66       IF $ORDER(OR(""))]""

               DO PED^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 +67      ;

 +68      ;Build Examination list

 +69       SET FTYPE="AUTTEXAM("

           SET FIEN=""

           KILL OR

 +70       FOR 

               SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

               IF 'FIEN

                   QUIT 

               Begin DoDot:1

 +71               SET OR(FIEN)=""

               End DoDot:1

 +72      ;

 +73      ;Search for Exam patients

 +74       IF $ORDER(OR(""))]""

               DO EXAM^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)

 +75      ;

 +76      ;Build POV codes list

 +77       SET FTYPE="ICD9("

           SET FIEN=""

           KILL OR

 +78       FOR 

               SET FIEN=$ORDER(SEARCH(FTYPE,FIEN))

               IF 'FIEN

                   QUIT 

               Begin DoDot:1

 +79               SET OR(FIEN)=""

                   SET ^TMP("PXRMPOV"_NODE,$JOB,FIEN)=""

               End DoDot:1

 +80      ;

 +81      ;Search for POV patients

 +82       IF $ORDER(OR(""))]""

               DO POV^PXRMXX2(PXRMBDT,PXRMEDT,"PXRMPOV"_NODE,NODE)

 +83      ;

 +84       SET BD=PXRMBDT-.0001

           SET ED=PXRMEDT+.2359

           SET DFN=""

 +85       FOR 

               SET DFN=$ORDER(^TMP(NODE,$JOB,"TEMP",DFN))

               IF 'DFN

                   QUIT 

               IF TSTOP=1

                   QUIT 

               Begin DoDot:1

 +86      ;Check if stop task requested

 +87               IF $$S^%ZTLOAD

                       SET TSTOP=1

                       QUIT 

 +88      ;Update total patient count for report

 +89               SET PXRMCNT=PXRMCNT+1

 +90               NEW FIND1,FCNT

 +91      ;Process reminders

 +92               SET PXRMITEM=0

                   SET FCNT=0

 +93               FOR 

                       SET PXRMITEM=$ORDER(REM(PXRMITEM))

                       IF 'PXRMITEM

                           QUIT 

                       Begin DoDot:2

 +94      ;Check reminder exists

 +95                       IF '$DATA(^PXD(811.9,PXRMITEM,0))

                               QUIT 

 +96      ;Evaluate reminder to obtain list of findings

 +97                       NEW FIND

 +98                       DO FIDATA^PXRM(DFN,PXRMITEM,.FIND)

 +99      ;Check if findings exist for the date range

 +100                      DO FCHEK(PXRMITEM)

                       End DoDot:2

 +101     ;Save in ^TMP

 +102              IF FCNT

                       DO FSAVE

                       KILL FIND1

                       SET PXRMFCNT=PXRMFCNT+1

               End DoDot:1

 +103     ;

 +104     ;Merge in patients from Outpatient Pharmacy

 +105      DO PSMERG^PXRMXX1("PXRMPSO",NODE,.SEARCH)

 +106     ;Merge in patients from Inpatient Pharmacy

 +107      DO PSMERG^PXRMXX1("PXRMPSI",NODE,.SEARCH)

 +108     ;

 +109      QUIT 

 +110     ;

 +111     ;Complex logic to handle lab/reminder mismatches

 +112     ;-----------------------------------------------

LTRAN      SET LTERM=$PIECE($GET(FIND(ENC,"TERM")),U)

           IF LTERM=""

               QUIT 

 +1       ;Skip terms not used in cohort logic

 +2        IF $DATA(LAB(LTERM))

               SET LTRAN=1

               QUIT 

 +3       ;If one of selected list send the latest out of cohort entries instead

 +4        IF $DATA(LABN(LTERM))

               SET LTRAN=1

               IF LDONE=1

                   QUIT 

               Begin DoDot:1

 +5                NEW ENC,TERM,DATE

 +6                SET ENC=0

                   SET LDONE=1

 +7                FOR 

                       SET ENC=$ORDER(FIND(ENC))

                       IF 'ENC

                           QUIT 

                       Begin DoDot:2

 +8                        SET TERM=$PIECE($GET(FIND(ENC,"TERM")),U)

                           IF TERM=""

                               QUIT 

 +9       ;Check if the term is in the out of cohort list

 +10                       IF $DATA(LAB(TERM))

                               Begin DoDot:3

 +11      ;Check if lab test is within date range or prior

 +12                               SET DATE=$GET(FIND(ENC,"DATE"))

                                   IF DATE=""

                                       QUIT 

                                   IF DATE>ED

                                       QUIT 

 +13                               DO SAV

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14      ;

 +15       QUIT 

 +16      ;

 +17      ;

 +18      ;Entry point for API

 +19      ;-------------------

PATS(PXRMBDT,PXRMEDT,NODE) ;

 +1       ;

 +2       ; PXRMBDT - Start date in fileman format

 +3       ; PXRMEDT - End date in fileman format

 +4       ; NODE  - Target name for ^TMP(NODE,$J)

 +5       ;

 +6       ;Task stopped

 +7        NEW TSTOP

           SET TSTOP=0

 +8       ;

 +9       ;

 +10      ;Build temporary array of all wards

 +11      ;N PXRMLCHL,PXRMLOCN D LCHL^PXRMXAP(1,.PXRMLCHL)

 +12      ;

 +13      ;Patients, patients with findings, finding and term counts

 +14       NEW PXRMCNT,PXRMFCNT,PXRMFIEN,PXRMTIEN

           SET PXRMCNT=0

           SET PXRMFCNT=0

 +15      ;

 +16      ;Clear ^TMP

 +17       KILL ^TMP(NODE,$JOB)

 +18      ;Current inpatients

 +19      ;D INP

 +20      ;Inpatient admissions

 +21      ;D ADM

 +22      ;Outpatient visits

 +23      ;D VISITS Q:TSTOP=1

 +24      ;

 +25      ;Check for findings in the selected patients

 +26       DO FIND

           IF TSTOP=1

               QUIT 

 +27      ;

 +28      ;Save report

 +29       DO REPORT^PXRMXX1(NODE)

 +30      ;

 +31      ;Remove list of all patients with encounters

 +32       KILL ^TMP(NODE,$JOB,"TEMP")

 +33      ;Remove pharmacy outpatient list

 +34       KILL ^TMP("PXRMPSO"_NODE,$JOB)

 +35      ;Remove pharmacy inpatient list

 +36       KILL ^TMP("PXRMPSI"_NODE,$JOB)

 +37      ;Remove icd9 list

 +38       KILL ^TMP("PXRMPOV"_NODE,$JOB)

 +39       QUIT 

 +40      ;

 +41      ;Build list of inpatients admissions

 +42      ;-----------------------------------

ADM        NEW HLOCIEN,IC,DFN,BD,ED

 +1       ;Get admissions for each selected location

 +2        FOR IC=1:1

               IF '$DATA(PXRMLCHL(IC))

                   QUIT 

               Begin DoDot:1

 +3                SET HLOCIEN=$PIECE(PXRMLCHL(IC),U,2)

                   IF HLOCIEN=""

                       QUIT 

 +4       ; Get admissions from patient movements and return DFN's in PATS

 +5                SET BD=PXRMBDT-.0001

 +6                SET ED=PXRMEDT+.2359

 +7                NEW PATS

                   DO ADM^PXRMXAP(HLOCIEN,.PATS,BD,ED)

 +8       ;Build ^TMP for selected patients 

 +9                SET DFN=""

 +10               FOR 

                       SET DFN=$ORDER(PATS(DFN))

                       IF DFN=""

                           QUIT 

                       DO TMP

               End DoDot:1

 +11       QUIT 

 +12      ;

 +13      ;Build list of Current inpatients

 +14      ;--------------------------------

INP        NEW HLOCIEN,IC,DFN

 +1       ;Get Current inpatients for each location

 +2        FOR IC=1:1

               IF '$DATA(PXRMLCHL(IC))

                   QUIT 

               Begin DoDot:1

 +3                SET HLOCIEN=$PIECE(PXRMLCHL(IC),U,2)