PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report;23-Mar-2015 10:42;DU
;;2.0;CLINICAL REMINDERS;**4,6,1001,12,26,1005**;Feb 04, 2005;Build 23
;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
;
; Called/jobbed from PXRMXD
;
; Input - PXRMSEL,PXRMXTMP
; PXRM*
; Output- ^XTMP(PXRMXTMP
;
;
START ;
N LIT,TOTAL,TODAY,ZTSTOP,BUSY,PXRMDEFS
S DBDOWN=0
S TOTAL=0,ZTSTOP="",TODAY=$$DT^XLFDT-.0001
;
K ^TMP($J,"PXRM PATIENT LIST"),^TMP($J,"PXRM PATIENT EVAL")
K ^TMP($J,"PXRM FUTURE APPT"),^TMP($J,"SDAMA301")
K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J)
K ^TMP("PXRMCMB3",$J),^TMP("PXRMCMB4",$J)
N PXRMRERR
;
;Initialize the busy counter.
S BUSY=0
;
;OE/RR team selected (PXRMOTM)
I PXRMSEL="O" D OERR^PXRMXSL1
;
;PCMM team selected (PXRMPCM)
I PXRMSEL="T" D PCMMT^PXRMXSL1
;
N HLIEN,FACILITY
;Location selected (PXRMLCHL,PXRMCGRP)
I PXRMSEL="L" D G:ZTSTOP=1 EXIT
.;Build Clinic List
.D BHLOC^PXRMXSL1
.;Prior Visits - build patient list in ^TMP
.I PXRMFD="P" D VISITS^PXRMXSL2 I DBDOWN=1 Q
.;Inpatient Admissions and current inpatient locations
.I PXRMFD="A"!(PXRMFD="C") D INPADM^PXRMXSL1
.;Future Appointments - build patient list in ^TMP
.I PXRMFD="F" D APPTS^PXRMXSL2 I DBDOWN=1 Q
.;End task requested
.Q:ZTSTOP=1
;Update ^XTMP from ^TMP
;Initialize the busy counter.
S BUSY=0
;
;PCMM provider selected (PXRMPRV)
I PXRMSEL="P" D PCMMP^PXRMXSL1
;
;IHS/MSC/MGH Patch 1001 designated provider selected
I PXRMSEL="D" D IHS^BPXRMSEO
;
;Individual Patients selected (PXRMPAT)
I PXRMSEL="I" D IND^PXRMXSL1
;
;Patient List selected (PXRMLIST)
I PXRMSEL="R" D LIST^PXRMXSL1
;
I DBDOWN=1 G EXIT
S START=$H
D EVAL^PXRMXEVL("PXRM PATIENT EVAL",.REMINDER)
D XTMP(START)
;
;Update patient list
I PXRMSEL'="I"&(PXRMUSER'="Y")&($G(PXRMLIS1)'="") D
.;If no patients due delete patient list
.I +$O(^TMP($J,"PXRMXPAT",""))=0 D Q
..N DA,DIK S DA=PXRMLIS1,DIK="^PXRMXP(810.5," D ^DIK
.;Otherwise create patient list
.D UPDLST^PXRMRULE("PXRMXPAT",PXRMLIS1,"","","",PXRMDPAT,PXRMTPAT)
.S $P(^PXRMXP(810.5,PXRMLIS1,0),U,9)=1
K ^TMP($J,"PXRMXPAT")
K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J)
K ^TMP("PXRMCMB3",$J),^TMP("PXRMCMB4",$J)
K DBDOWN
;Sorting is done, produce the output.
D START^PXRMXPR
Q
;
ERROR(STATUS,ITEM) ;
;Create XTMP entry for Reminders that error out or could not be
;determing on evaluation
N ERRNAME
S STATUS=$P(STATUS,U)
S ERRNAME=$P(^PXD(811.9,ITEM,0),U)
I $D(^XTMP(PXRMXTMP,STATUS,ERRNAME))>0,^XTMP(PXRMXTMP,STATUS,ERRNAME)>0 D
.S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=^XTMP(PXRMXTMP,STATUS,ERRNAME)+1
E S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=1
Q
;
;End Task requested
EXIT ;
S ZTSK=$G(^XTMP(PXRMXTMP,"PRZTSK"))
I ZTSK>0 D KILL^%ZTLOAD
D EXIT^PXRMXGUT
K DBDOWN
Q
;
XTMP(START) ;
N CNT,CCNT,DDAT,II,INP,ITEM,LIT,LOC,LSSN,MCNBD,MCNBDR,NAME
N SUB,STATUS,TEMP,TEXT
K ^TMP($J,"PXRM CNBD")
S CCNT=0,MCNBD=$G(^PXRM(800,1,"MIERR")),MCNBDR=0
S BUSY=0,SUB="NAM",TEMP=0,PX="PXRM"
N DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM
S FACILITY="",DDAT="N/A"
F S FACILITY=$O(^TMP(PXRMRT,$J,FACILITY)) Q:FACILITY="" D
.S NAM=""
.F S NAM=$O(^TMP(PXRMRT,$J,FACILITY,NAM)) Q:NAM="" D
..S LOC=""
..F S LOC=$O(^TMP(PXRMRT,$J,FACILITY,NAM,LOC)) Q:LOC="" D
...S DFN=""
...F S DFN=$O(^TMP(PXRMRT,$J,FACILITY,NAM,LOC,DFN)) Q:DFN="" D
....D NOTIFY^PXRMXBSY("Evaluating reminders",.BUSY)
....S INP=$G(^TMP(PXRMRT,$J,FACILITY,NAM,LOC,DFN))
....S CNT=0 F S CNT=$O(REMINDER(CNT)) Q:CNT'>0 D
.....S ITEM=$P(REMINDER(CNT),U,1),LIT=$P(REMINDER(CNT),U,4)
.....I LIT="" S LIT=$P(REMINDER(CNT),U,2)
.....S STATUS=$G(^TMP($J,"PXRM PATIENT EVAL",DFN,ITEM))
.....I STATUS="" Q
.....I STATUS["ERROR"!(STATUS["CNBD") D
......D ERROR(STATUS,ITEM) I STATUS["ERROR"!(MCNBDR=1) Q
......I CCNT=0 D
.......S ^TMP($J,"PXRM CNBD",1,0)=" "_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",8)_" REMINDER"
.......S TEMP=" "
.......F II=1:1:30 S TEMP=TEMP_"-"
.......S TEMP=TEMP_" "
.......F II=1:1:6 S TEMP=TEMP_"-"
.......S TEMP=TEMP_" "
.......F II=1:1:30 S TEMP=TEMP_"-"
.......S ^TMP($J,"PXRM CNBD",2,0)=TEMP
.......S CCNT=2
......S CCNT=CCNT+1
......I CCNT>MCNBD S MCNBDR=1 Q
......S NAME=$P(^DPT(DFN,0),U)
......S LSSN=$E($P(^DPT(DFN,0),U,9),6,9)
......S ^TMP($J,"PXRM CNBD",CCNT,0)=" "_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,8)_" "_$$LJ^XLFSTR(LIT,30)
.....;Add reminder status to patient list TMP Global
.....I STATUS["DUE NOW" S ^TMP($J,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS
.....I PXRMREP="D" D SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP)
.....I PXRMREP="S" D SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM,LOC)
I $D(^TMP($J,"PXRM CNBD"))>0 D ERRMSG^PXRMXDT1("C")
K ^TMP($J,"PXRM CNBD")
S TEXT="Elapsed time for reminder evaluation: "_$$DETIME^PXRMXSL1(START,$H)
S ^XTMP(PXRMXTMP,"TIMING","REMINDER EVALUATION")=TEXT
I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
K ^TMP($J,"PXRM PATIENT EVAL")
Q
;
PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report;23-Mar-2015 10:42;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,12,26,1005**;Feb 04, 2005;Build 23
+2 ;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
+3 ;
+4 ; Called/jobbed from PXRMXD
+5 ;
+6 ; Input - PXRMSEL,PXRMXTMP
+7 ; PXRM*
+8 ; Output- ^XTMP(PXRMXTMP
+9 ;
+10 ;
START ;
+1 NEW LIT,TOTAL,TODAY,ZTSTOP,BUSY,PXRMDEFS
+2 SET DBDOWN=0
+3 SET TOTAL=0
SET ZTSTOP=""
SET TODAY=$$DT^XLFDT-.0001
+4 ;
+5 KILL ^TMP($JOB,"PXRM PATIENT LIST"),^TMP($JOB,"PXRM PATIENT EVAL")
+6 KILL ^TMP($JOB,"PXRM FUTURE APPT"),^TMP($JOB,"SDAMA301")
+7 KILL ^TMP($JOB),^TMP(PXRMRT,$JOB),^TMP("PXRMDUP",$JOB)
+8 KILL ^TMP("PXRMCMB",$JOB),^TMP("PXRMCMB1",$JOB),^TMP("PXRMCMB2",$JOB)
+9 KILL ^TMP("PXRMCMB3",$JOB),^TMP("PXRMCMB4",$JOB)
+10 NEW PXRMRERR
+11 ;
+12 ;Initialize the busy counter.
+13 SET BUSY=0
+14 ;
+15 ;OE/RR team selected (PXRMOTM)
+16 IF PXRMSEL="O"
DO OERR^PXRMXSL1
+17 ;
+18 ;PCMM team selected (PXRMPCM)
+19 IF PXRMSEL="T"
DO PCMMT^PXRMXSL1
+20 ;
+21 NEW HLIEN,FACILITY
+22 ;Location selected (PXRMLCHL,PXRMCGRP)
+23 IF PXRMSEL="L"
Begin DoDot:1
+24 ;Build Clinic List
+25 DO BHLOC^PXRMXSL1
+26 ;Prior Visits - build patient list in ^TMP
+27 IF PXRMFD="P"
DO VISITS^PXRMXSL2
IF DBDOWN=1
QUIT
+28 ;Inpatient Admissions and current inpatient locations
+29 IF PXRMFD="A"!(PXRMFD="C")
DO INPADM^PXRMXSL1
+30 ;Future Appointments - build patient list in ^TMP
+31 IF PXRMFD="F"
DO APPTS^PXRMXSL2
IF DBDOWN=1
QUIT
+32 ;End task requested
+33 IF ZTSTOP=1
QUIT
End DoDot:1
IF ZTSTOP=1
GOTO EXIT
+34 ;Update ^XTMP from ^TMP
+35 ;Initialize the busy counter.
+36 SET BUSY=0
+37 ;
+38 ;PCMM provider selected (PXRMPRV)
+39 IF PXRMSEL="P"
DO PCMMP^PXRMXSL1
+40 ;
+41 ;IHS/MSC/MGH Patch 1001 designated provider selected
+42 IF PXRMSEL="D"
DO IHS^BPXRMSEO
+43 ;
+44 ;Individual Patients selected (PXRMPAT)
+45 IF PXRMSEL="I"
DO IND^PXRMXSL1
+46 ;
+47 ;Patient List selected (PXRMLIST)
+48 IF PXRMSEL="R"
DO LIST^PXRMXSL1
+49 ;
+50 IF DBDOWN=1
GOTO EXIT
+51 SET START=$HOROLOG
+52 DO EVAL^PXRMXEVL("PXRM PATIENT EVAL",.REMINDER)
+53 DO XTMP(START)
+54 ;
+55 ;Update patient list
+56 IF PXRMSEL'="I"&(PXRMUSER'="Y")&($GET(PXRMLIS1)'="")
Begin DoDot:1
+57 ;If no patients due delete patient list
+58 IF +$ORDER(^TMP($JOB,"PXRMXPAT",""))=0
Begin DoDot:2
+59 NEW DA,DIK
SET DA=PXRMLIS1
SET DIK="^PXRMXP(810.5,"
DO ^DIK
End DoDot:2
QUIT
+60 ;Otherwise create patient list
+61 DO UPDLST^PXRMRULE("PXRMXPAT",PXRMLIS1,"","","",PXRMDPAT,PXRMTPAT)
+62 SET $PIECE(^PXRMXP(810.5,PXRMLIS1,0),U,9)=1
End DoDot:1
+63 KILL ^TMP($JOB,"PXRMXPAT")
+64 KILL ^TMP($JOB),^TMP(PXRMRT,$JOB),^TMP("PXRMDUP",$JOB)
+65 KILL ^TMP("PXRMCMB",$JOB),^TMP("PXRMCMB1",$JOB),^TMP("PXRMCMB2",$JOB)
+66 KILL ^TMP("PXRMCMB3",$JOB),^TMP("PXRMCMB4",$JOB)
+67 KILL DBDOWN
+68 ;Sorting is done, produce the output.
+69 DO START^PXRMXPR
+70 QUIT
+71 ;
ERROR(STATUS,ITEM) ;
+1 ;Create XTMP entry for Reminders that error out or could not be
+2 ;determing on evaluation
+3 NEW ERRNAME
+4 SET STATUS=$PIECE(STATUS,U)
+5 SET ERRNAME=$PIECE(^PXD(811.9,ITEM,0),U)
+6 IF $DATA(^XTMP(PXRMXTMP,STATUS,ERRNAME))>0
IF ^XTMP(PXRMXTMP,STATUS,ERRNAME)>0
Begin DoDot:1
+7 SET ^XTMP(PXRMXTMP,STATUS,ERRNAME)=^XTMP(PXRMXTMP,STATUS,ERRNAME)+1
End DoDot:1
+8 IF '$TEST
SET ^XTMP(PXRMXTMP,STATUS,ERRNAME)=1
+9 QUIT
+10 ;
+11 ;End Task requested
EXIT ;
+1 SET ZTSK=$GET(^XTMP(PXRMXTMP,"PRZTSK"))
+2 IF ZTSK>0
DO KILL^%ZTLOAD
+3 DO EXIT^PXRMXGUT
+4 KILL DBDOWN
+5 QUIT
+6 ;
XTMP(START) ;
+1 NEW CNT,CCNT,DDAT,II,INP,ITEM,LIT,LOC,LSSN,MCNBD,MCNBDR,NAME
+2 NEW SUB,STATUS,TEMP,TEXT
+3 KILL ^TMP($JOB,"PXRM CNBD")
+4 SET CCNT=0
SET MCNBD=$GET(^PXRM(800,1,"MIERR"))
SET MCNBDR=0
+5 SET BUSY=0
SET SUB="NAM"
SET TEMP=0
SET PX="PXRM"
+6 NEW DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM
+7 SET FACILITY=""
SET DDAT="N/A"
+8 FOR
SET FACILITY=$ORDER(^TMP(PXRMRT,$JOB,FACILITY))
IF FACILITY=""
QUIT
Begin DoDot:1
+9 SET NAM=""
+10 FOR
SET NAM=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM))
IF NAM=""
QUIT
Begin DoDot:2
+11 SET LOC=""
+12 FOR
SET LOC=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC))
IF LOC=""
QUIT
Begin DoDot:3
+13 SET DFN=""
+14 FOR
SET DFN=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC,DFN))
IF DFN=""
QUIT
Begin DoDot:4
+15 DO NOTIFY^PXRMXBSY("Evaluating reminders",.BUSY)
+16 SET INP=$GET(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC,DFN))
+17 SET CNT=0
FOR
SET CNT=$ORDER(REMINDER(CNT))
IF CNT'>0
QUIT
Begin DoDot:5
+18 SET ITEM=$PIECE(REMINDER(CNT),U,1)
SET LIT=$PIECE(REMINDER(CNT),U,4)
+19 IF LIT=""
SET LIT=$PIECE(REMINDER(CNT),U,2)
+20 SET STATUS=$GET(^TMP($JOB,"PXRM PATIENT EVAL",DFN,ITEM))
+21 IF STATUS=""
QUIT
+22 IF STATUS["ERROR"!(STATUS["CNBD")
Begin DoDot:6
+23 DO ERROR(STATUS,ITEM)
IF STATUS["ERROR"!(MCNBDR=1)
QUIT
+24 IF CCNT=0
Begin DoDot:7
+25 SET ^TMP($JOB,"PXRM CNBD",1,0)=" "_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",8)_" REMINDER"
+26 SET TEMP=" "
+27 FOR II=1:1:30
SET TEMP=TEMP_"-"
+28 SET TEMP=TEMP_" "
+29 FOR II=1:1:6
SET TEMP=TEMP_"-"
+30 SET TEMP=TEMP_" "
+31 FOR II=1:1:30
SET TEMP=TEMP_"-"
+32 SET ^TMP($JOB,"PXRM CNBD",2,0)=TEMP
+33 SET CCNT=2
End DoDot:7
+34 SET CCNT=CCNT+1
+35 IF CCNT>MCNBD
SET MCNBDR=1
QUIT
+36 SET NAME=$PIECE(^DPT(DFN,0),U)
+37 SET LSSN=$EXTRACT($PIECE(^DPT(DFN,0),U,9),6,9)
+38 SET ^TMP($JOB,"PXRM CNBD",CCNT,0)=" "_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,8)_" "_$$LJ^XLFSTR(LIT,30)
End DoDot:6
+39 ;Add reminder status to patient list TMP Global
+40 IF STATUS["DUE NOW"
SET ^TMP($JOB,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS
+41 IF PXRMREP="D"
DO SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP)
+42 IF PXRMREP="S"
DO SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM,LOC)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 IF $DATA(^TMP($JOB,"PXRM CNBD"))>0
DO ERRMSG^PXRMXDT1("C")
+44 KILL ^TMP($JOB,"PXRM CNBD")
+45 SET TEXT="Elapsed time for reminder evaluation: "_$$DETIME^PXRMXSL1(START,$HOROLOG)
+46 SET ^XTMP(PXRMXTMP,"TIMING","REMINDER EVALUATION")=TEXT
+47 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+48 KILL ^TMP($JOB,"PXRM PATIENT EVAL")
+49 QUIT
+50 ;
