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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXX 9894 printed Apr 09, 2024@20:54:31 Page 2
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)
if HLOCIEN=""
QUIT
+4 ;Get WARDIEN,WARDNAM and return DFN's in PATS
+5 NEW PATS
DO WARD^PXRMXAP(HLOCIEN,.PATS)
+6 ;Build ^TMP for selected patients
+7 SET DFN=""
+8 FOR
SET DFN=$ORDER(PATS(DFN))
if DFN=""
QUIT
DO TMP
End DoDot:1
+9 QUIT
+10 ;
+11 ;Scan visit file to build list of patients
+12 ;-----------------------------------------
VISITS NEW BD,DFN,ED,HLOCIEN,IC,VIEN,VISIT
+1 ;
+2 SET BD=PXRMBDT-.0001
+3 SET ED=PXRMEDT+.2359
+4 ;Get Date ; DBIA #2028
+5 FOR
SET BD=$ORDER(^AUPNVSIT("B",BD))
if BD>ED
QUIT
if BD=""
QUIT
if TSTOP=1
QUIT
Begin DoDot:1
+6 SET VIEN=0
+7 ;Get individual visit
+8 FOR
SET VIEN=$ORDER(^AUPNVSIT("B",BD,VIEN))
if VIEN=""
QUIT
if TSTOP=1
QUIT
Begin DoDot:2
+9 ;Check if stop task requested
+10 IF $$S^%ZTLOAD
SET TSTOP=1
QUIT
+11 ;Screen Individual Visit
+12 SET VISIT=$GET(^AUPNVSIT(VIEN,0))
if VISIT=""
QUIT
+13 ;Patient IEN
+14 SET DFN=$PIECE(VISIT,U,5)
if 'DFN
QUIT
+15 ;Build patient list in ^TMP
+16 DO TMP
End DoDot:2
End DoDot:1
+17 QUIT
