PXRMXDT1 ;SLC/PJH - Build Patient list SUBROUTINES ;23-Mar-2015 10:41;DU
;;2.0;CLINICAL REMINDERS;**4,6,1001,12,17,18,1005**;Feb 04, 2005;Build 23
;;IHS/MSC/MGH Patch 1001 Use HRCN
; Called by label from PXRMXSEO,PXRMXSE
;
;Combined report duplicate check (Summary report)
NEW(SUB,SUB1,SUB2) ;
;Existing entry
I $D(^TMP("PXRMCMB",$J,SUB,SUB1,SUB2)) Q 0
;New entry
S ^TMP("PXRMCMB",$J,SUB,SUB1,SUB2)=""
Q 1
;
;Individual patient report duplicate patient check
NEWIP(DFN) ;
;Existing entry
I $D(^TMP("PXRMCMB3",$J,DFN)) Q 0
;New entry
S ^TMP("PXRMCMB3",$J,DFN)=""
Q 1
;Combined report duplicate check (Detail report)
NEWP(SUB,DFN) ;
;Existing entry
I $D(^TMP("PXRMCMB1",$J,SUB,DFN)) Q 0
;New entry
S ^TMP("PXRMCMB1",$J,SUB,DFN)=""
Q 1
;
;Combined report duplicate check (Patient totals)
NEWT(FACILITY,DFN) ;
;Existing entry
I $D(^TMP("PXRMCMB2",$J,FACILITY,DFN)) Q 0
;New entry
S ^TMP("PXRMCMB2",$J,FACILITY,DFN)=""
Q 1
;
NEWCS(FACILITY,NAM,DFN,REM) ;
I $D(^TMP("PXRMCMB4",$J,FACILITY,NAM,DFN,REM)) Q 0
S ^TMP("PXRMCMB4",$J,FACILITY,NAM,DFN,REM)=""
Q 1
;
;Detailed report
SDET(DFN,STATUS,NAM,FACILITY,INP) ;
I $G(^XTMP(PXRMXTMP,PX,FACILITY,NAM))="" D
.S ^XTMP(PXRMXTMP,PX,FACILITY,NAM)=NAM
;Applicable
S DDAT="N/A"
N APPL,FAPPTDT,DEFARR,DLAST,DNEXT,DNEXT1,FIEV,PNAM,PXRMDATE,BID,TMPSUB
S APPL=0,FAPPTDT=0
;Add any that aren't N/A, Ignore on N/A or NEVER to applicable total
I ($P(STATUS,U)'="")&(STATUS'["NEVER")&(STATUS'["N/A")&(STATUS'["ERROR")&(STATUS'["CNBD") S APPL=1
;If DUE NOW save details
I $G(STATUS)'["DUE NOW" S PNAM=" "
I $G(STATUS)["DUE NOW" D
.N BED
.S DDUE=$P($G(STATUS),U,2)
.S DLAST=$P($G(STATUS),U,3)
.;Demographics
.;IHS/MSC/MGH Patch 1001 Use HRCN
.;S PNAM=$P($G(^DPT(DFN,0)),U),BID=$P($G(^DPT(DFN,0)),U,9)
.S PNAM=$P($G(^DPT(DFN,0)),U),BID=$$HRCN^PXRMXXT(DFN,+$G(DUZ(2)))
.I PNAM="" S PNAM=" "
.E S PNAM=PNAM_U_BID
.;Next appointment for location or clinic
.;For detailed provider report get next appoint. for assoc. clinic
.S DNEXT=""
.I PXRMSEL="L"!(PXRMSEL="P") S TMPSUB="PXRM FUTURE APPT"
.E S TMPSUB="SDAMA301"
.I PXRMFCMB="Y",PXRMLCMB="Y",$D(^TMP($J,TMPSUB,DFN))>0 D
..N APPTCNT,LOC
..S LOC=0,APPTCNT=0
..F S LOC=$O(^TMP($J,TMPSUB,DFN,LOC)) Q:(LOC'>0)!(APPTCNT=1) D
...S DNEXT=$O(^TMP($J,TMPSUB,DFN,LOC,"")) I +DNEXT>0 S APPTCNT=1 Q
.S DNEXT=$O(^TMP($J,TMPSUB,DFN,$G(INP),""))
.I PXRMFCMB="N",PXRMLCMB="Y" D
..S DNEXT1=$O(^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,"")) Q:DNEXT1'>0
..I +DNEXT=0!(DNEXT>DNEXT1) S DNEXT=DNEXT1
.S BED=$G(^DPT(DFN,.101)) S:BED="" BED="NONE"
.;Sort by next appointment date
.I PXRMSRT="Y" S DDAT=$P(DNEXT,".") S:DDAT="" DDAT="NONE"
.;Patient ward/bed used only for inpatient reports
.I PXRMFUT="Y" S DNEXT=""
.N TXT
.S TXT=DFN_U_DDUE_U_DLAST_U_$G(DNEXT)_$S($G(BED)'="":U_BED,1:"")
.I $G(BED)'="",BED'="NONE" S DDAT=BED
.N BED
.S BED=""
.I $G(PXRMINP) D
..S BED=$G(^DPT(DFN,.101)) S:BED="" BED="NONE"
..S TXT=TXT_U_BED
..;Sort by bed
..I PXRMSRT="B" S DDAT=BED
.;Duplicate check for combined report
.I PXRMFCMB="Y",'$$NEW(NAM,DDAT,PNAM) Q
.;Save entry in ^XTMP
.S ^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM)=TXT
.;Total of reminders overdue
.N CNT
.S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)=CNT+1
;Total of patients checked/applicable
N CNT,NEW
S NEW=1 I PXRMFCMB="Y" S NEW=$$NEWP(NAM,DFN)
I NEW=1 D
.S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)=CNT+1
.S CNT=$P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)=CNT+APPL
I PXRMFUT="Y"&($G(STATUS)["DUE NOW") D
.N APPTARY,APPTDT,CIEN,CNT,NODE,SUB
.S SUB="" I $D(^TMP($J,"PXRM FUTURE APPT",DFN))>0 S SUB="PXRM FUTURE APPT"
.I SUB="",$D(^TMP($J,"SDAMA301",DFN))>0 S SUB="SDAMA301"
.I SUB="" Q
.S CNT=0
.S CIEN=0 F S CIEN=$O(^TMP($J,SUB,DFN,CIEN)) Q:CIEN'>0 D
..S APPTDT=0
..F S APPTDT=$O(^TMP($J,SUB,DFN,CIEN,APPTDT)) Q:APPTDT'>0 D
...S NODE=$G(^TMP($J,SUB,DFN,CIEN,APPTDT))
...S APPTARY(APPTDT)=APPTDT_U_$P($P(NODE,U,2),";",2)_U_$P($P(NODE,U,22),";",2)
.S APPTDT=0 F S APPTDT=$O(APPTARY(APPTDT)) Q:APPTDT'>0 S CNT=CNT+1,^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM,CNT,0)=APPTARY(APPTDT)
Q
;
SUM(DFN,STATUS,FACILITY,NAM,LOC) ;
N ADDCNT,DUE,EVAL
S (DUE,EVAL)=0
;Add dues to totals of reminders due and reminders applicable
I STATUS["DUE NOW" D
.S DUE=1,EVAL=1
;Add any that aren't N/A, Ignore on N/A,ERROR or NEVER to applicable total
S STATUS=$P(STATUS,U)
I (STATUS'=" ")&(STATUS'["NEVER")&(STATUS'="N/A")&(STATUS'["ERROR")&(STATUS'["CNBD") S EVAL=1
;Update XTMP - Total of reminders due
I "IR"[PXRMTOT D
.S ADDCNT=0
.;Combined facility duplicate check
.I PXRMCCS'="B" S ADDCNT=1
.I ADDCNT=0,PXRMCCS="B",$$NEWCS(FACILITY,NAM,DFN,ITEM)=1 S ADDCNT=1
.I PXRMFCMB="Y",'$$NEW(NAM,DFN,ITEM) S ADDCNT=0
.I ADDCNT=1 D
..N CNT
..S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,1)
..S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,1)=CNT+EVAL
..;Total of reminders evaluated
..S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,2)
..S $P(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,2)=CNT+DUE
.I PXRMCCS="B" D
..N CNT
..S CNT=$P($G(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM)),U,1)
..S $P(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM),U,1)=CNT+EVAL
..;Total of reminders evaluated
..S CNT=$P($G(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM)),U,2)
..S $P(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM),U,2)=CNT+DUE
;
;Totals
I "RT"[PXRMTOT D
.;Check for duplicate patient at FACILITY level
.I $D(^TMP("PXRMDUP",$J,FACILITY,DFN,ITEM)) Q
.;Set duplicate check
.S ^TMP("PXRMDUP",$J,FACILITY,DFN,ITEM)=""
.I $G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))="" D
..S ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")="TOTAL"
.N CNT
.S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,1)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,1)=CNT+EVAL
.S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,2)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,2)=CNT+DUE
;
;Total of patients
I "IR"[PXRMTOT D
.S ADDCNT=1
.I PXRMSEL="I",$$NEWIP(DFN)<1 S ADDCNT=0
.I PXRMLCMB="Y",ADDCNT=1,$$NEWP(@SUB,DFN)=0 S ADDCNT=0
.I ADDCNT=1,$$NEW(FACILITY,@SUB,DFN)=0 S ADDCNT=0
.I ADDCNT=1 D
..N CNT
..I $G(^XTMP(PXRMXTMP,PX,FACILITY,@SUB))="" S ^XTMP(PXRMXTMP,PX,FACILITY,@SUB)=NAM
..S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,@SUB)),U,3)
..S $P(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,3)=CNT+1
.I PXRMCCS="B" D
..N CNT
..I $G(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC))="" S ^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC)=LOC
..S CNT=$P($G(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC)),U,3)
..S $P(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC),U,3)=CNT+1
;
;Total reports
I "TR"[PXRMTOT D
.I '$$NEWT(FACILITY,DFN) Q
.I $G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))="" D
..S ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")=NAM
.N CNT
.S CNT=$P($G(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")),U,3)
.S $P(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"),U,3)=CNT+1
Q
;
ERRMSG(TYPE) ;
N CNT,CNT1,STR,SUBJECT,NLINES,OUTPUT,TO
K ^TMP("PXRMXMZ",$J)
S NLINES=0,CNT=0,CNT1=2
I TYPE="C" D Q
.M ^TMP("PXRMXMZ",$J)=^TMP($J,"PXRM CNBD")
.S SUBJECT="REMINDER REPORTS CNBD PATIENT LIST ("_$$FMTE^XLFDT($$NOW^XLFDT)_")"
.S TO(DUZ)=""
.D SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
;Build the error message
I $G(TITLE)'="" S STR(1)="The Reminders Due Report "_$G(TITLE)_" requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($G(PXRMXST))_" was cancelled for the following reason(s):"
I $G(TITLE)="" S STR(1)="The Reminders Due Report requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($G(PXRMXST))_" was cancelled for the following reason(s):"
F S CNT=$O(DBERR(CNT)) Q:CNT'>0 S STR(CNT1)="\\"_DBERR(CNT),CNT1=CNT1+1
I 'PXRMQUE D
.D FORMAT^PXRMTEXT(1,80,2,.STR,.NLINES,.OUTPUT)
.F CNT=1:1:NLINES W !,OUTPUT(CNT)
I PXRMQUE D
.S CNT=0
.F S CNT=$O(STR(CNT)) Q:CNT="" S ^TMP("PXRMXMZ",$J,CNT,0)=STR(CNT)
.S SUBJECT="Cancelled Reminders Due Report ("_$$FMTE^XLFDT($$NOW^XLFDT)_")"
.S TO(DUZ)=""
.D SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
.S ZTSTOP=1
Q
PXRMXDT1 ;SLC/PJH - Build Patient list SUBROUTINES ;23-Mar-2015 10:41;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,12,17,18,1005**;Feb 04, 2005;Build 23
+2 ;;IHS/MSC/MGH Patch 1001 Use HRCN
+3 ; Called by label from PXRMXSEO,PXRMXSE
+4 ;
+5 ;Combined report duplicate check (Summary report)
NEW(SUB,SUB1,SUB2) ;
+1 ;Existing entry
+2 IF $DATA(^TMP("PXRMCMB",$JOB,SUB,SUB1,SUB2))
QUIT 0
+3 ;New entry
+4 SET ^TMP("PXRMCMB",$JOB,SUB,SUB1,SUB2)=""
+5 QUIT 1
+6 ;
+7 ;Individual patient report duplicate patient check
NEWIP(DFN) ;
+1 ;Existing entry
+2 IF $DATA(^TMP("PXRMCMB3",$JOB,DFN))
QUIT 0
+3 ;New entry
+4 SET ^TMP("PXRMCMB3",$JOB,DFN)=""
+5 QUIT 1
+6 ;Combined report duplicate check (Detail report)
NEWP(SUB,DFN) ;
+1 ;Existing entry
+2 IF $DATA(^TMP("PXRMCMB1",$JOB,SUB,DFN))
QUIT 0
+3 ;New entry
+4 SET ^TMP("PXRMCMB1",$JOB,SUB,DFN)=""
+5 QUIT 1
+6 ;
+7 ;Combined report duplicate check (Patient totals)
NEWT(FACILITY,DFN) ;
+1 ;Existing entry
+2 IF $DATA(^TMP("PXRMCMB2",$JOB,FACILITY,DFN))
QUIT 0
+3 ;New entry
+4 SET ^TMP("PXRMCMB2",$JOB,FACILITY,DFN)=""
+5 QUIT 1
+6 ;
NEWCS(FACILITY,NAM,DFN,REM) ;
+1 IF $DATA(^TMP("PXRMCMB4",$JOB,FACILITY,NAM,DFN,REM))
QUIT 0
+2 SET ^TMP("PXRMCMB4",$JOB,FACILITY,NAM,DFN,REM)=""
+3 QUIT 1
+4 ;
+5 ;Detailed report
SDET(DFN,STATUS,NAM,FACILITY,INP) ;
+1 IF $GET(^XTMP(PXRMXTMP,PX,FACILITY,NAM))=""
Begin DoDot:1
+2 SET ^XTMP(PXRMXTMP,PX,FACILITY,NAM)=NAM
End DoDot:1
+3 ;Applicable
+4 SET DDAT="N/A"
+5 NEW APPL,FAPPTDT,DEFARR,DLAST,DNEXT,DNEXT1,FIEV,PNAM,PXRMDATE,BID,TMPSUB
+6 SET APPL=0
SET FAPPTDT=0
+7 ;Add any that aren't N/A, Ignore on N/A or NEVER to applicable total
+8 IF ($PIECE(STATUS,U)'="")&(STATUS'["NEVER")&(STATUS'["N/A")&(STATUS'["ERROR")&(STATUS'["CNBD")
SET APPL=1
+9 ;If DUE NOW save details
+10 IF $GET(STATUS)'["DUE NOW"
SET PNAM=" "
+11 IF $GET(STATUS)["DUE NOW"
Begin DoDot:1
+12 NEW BED
+13 SET DDUE=$PIECE($GET(STATUS),U,2)
+14 SET DLAST=$PIECE($GET(STATUS),U,3)
+15 ;Demographics
+16 ;IHS/MSC/MGH Patch 1001 Use HRCN
+17 ;S PNAM=$P($G(^DPT(DFN,0)),U),BID=$P($G(^DPT(DFN,0)),U,9)
+18 SET PNAM=$PIECE($GET(^DPT(DFN,0)),U)
SET BID=$$HRCN^PXRMXXT(DFN,+$GET(DUZ(2)))
+19 IF PNAM=""
SET PNAM=" "
+20 IF '$TEST
SET PNAM=PNAM_U_BID
+21 ;Next appointment for location or clinic
+22 ;For detailed provider report get next appoint. for assoc. clinic
+23 SET DNEXT=""
+24 IF PXRMSEL="L"!(PXRMSEL="P")
SET TMPSUB="PXRM FUTURE APPT"
+25 IF '$TEST
SET TMPSUB="SDAMA301"
+26 IF PXRMFCMB="Y"
IF PXRMLCMB="Y"
IF $DATA(^TMP($JOB,TMPSUB,DFN))>0
Begin DoDot:2
+27 NEW APPTCNT,LOC
+28 SET LOC=0
SET APPTCNT=0
+29 FOR
SET LOC=$ORDER(^TMP($JOB,TMPSUB,DFN,LOC))
IF (LOC'>0)!(APPTCNT=1)
QUIT
Begin DoDot:3
+30 SET DNEXT=$ORDER(^TMP($JOB,TMPSUB,DFN,LOC,""))
IF +DNEXT>0
SET APPTCNT=1
QUIT
End DoDot:3
End DoDot:2
+31 SET DNEXT=$ORDER(^TMP($JOB,TMPSUB,DFN,$GET(INP),""))
+32 IF PXRMFCMB="N"
IF PXRMLCMB="Y"
Begin DoDot:2
+33 SET DNEXT1=$ORDER(^TMP($JOB,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,""))
IF DNEXT1'>0
QUIT
+34 IF +DNEXT=0!(DNEXT>DNEXT1)
SET DNEXT=DNEXT1
End DoDot:2
+35 SET BED=$GET(^DPT(DFN,.101))
IF BED=""
SET BED="NONE"
+36 ;Sort by next appointment date
+37 IF PXRMSRT="Y"
SET DDAT=$PIECE(DNEXT,".")
IF DDAT=""
SET DDAT="NONE"
+38 ;Patient ward/bed used only for inpatient reports
+39 IF PXRMFUT="Y"
SET DNEXT=""
+40 NEW TXT
+41 SET TXT=DFN_U_DDUE_U_DLAST_U_$GET(DNEXT)_$SELECT($GET(BED)'="":U_BED,1:"")
+42 IF $GET(BED)'=""
IF BED'="NONE"
SET DDAT=BED
+43 NEW BED
+44 SET BED=""
+45 IF $GET(PXRMINP)
Begin DoDot:2
+46 SET BED=$GET(^DPT(DFN,.101))
IF BED=""
SET BED="NONE"
+47 SET TXT=TXT_U_BED
+48 ;Sort by bed
+49 IF PXRMSRT="B"
SET DDAT=BED
End DoDot:2
+50 ;Duplicate check for combined report
+51 IF PXRMFCMB="Y"
IF '$$NEW(NAM,DDAT,PNAM)
QUIT
+52 ;Save entry in ^XTMP
+53 SET ^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM)=TXT
+54 ;Total of reminders overdue
+55 NEW CNT
+56 SET CNT=$PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)
+57 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,2)=CNT+1
End DoDot:1
+58 ;Total of patients checked/applicable
+59 NEW CNT,NEW
+60 SET NEW=1
IF PXRMFCMB="Y"
SET NEW=$$NEWP(NAM,DFN)
+61 IF NEW=1
Begin DoDot:1
+62 SET CNT=$PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)
+63 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,3)=CNT+1
+64 SET CNT=$PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)
+65 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM),U,4)=CNT+APPL
End DoDot:1
+66 IF PXRMFUT="Y"&($GET(STATUS)["DUE NOW")
Begin DoDot:1
+67 NEW APPTARY,APPTDT,CIEN,CNT,NODE,SUB
+68 SET SUB=""
IF $DATA(^TMP($JOB,"PXRM FUTURE APPT",DFN))>0
SET SUB="PXRM FUTURE APPT"
+69 IF SUB=""
IF $DATA(^TMP($JOB,"SDAMA301",DFN))>0
SET SUB="SDAMA301"
+70 IF SUB=""
QUIT
+71 SET CNT=0
+72 SET CIEN=0
FOR
SET CIEN=$ORDER(^TMP($JOB,SUB,DFN,CIEN))
IF CIEN'>0
QUIT
Begin DoDot:2
+73 SET APPTDT=0
+74 FOR
SET APPTDT=$ORDER(^TMP($JOB,SUB,DFN,CIEN,APPTDT))
IF APPTDT'>0
QUIT
Begin DoDot:3
+75 SET NODE=$GET(^TMP($JOB,SUB,DFN,CIEN,APPTDT))
+76 SET APPTARY(APPTDT)=APPTDT_U_$PIECE($PIECE(NODE,U,2),";",2)_U_$PIECE($PIECE(NODE,U,22),";",2)
End DoDot:3
End DoDot:2
+77 SET APPTDT=0
FOR
SET APPTDT=$ORDER(APPTARY(APPTDT))
IF APPTDT'>0
QUIT
SET CNT=CNT+1
SET ^XTMP(PXRMXTMP,PX,FACILITY,NAM,DDAT,PNAM,CNT,0)=APPTARY(APPTDT)
End DoDot:1
+78 QUIT
+79 ;
SUM(DFN,STATUS,FACILITY,NAM,LOC) ;
+1 NEW ADDCNT,DUE,EVAL
+2 SET (DUE,EVAL)=0
+3 ;Add dues to totals of reminders due and reminders applicable
+4 IF STATUS["DUE NOW"
Begin DoDot:1
+5 SET DUE=1
SET EVAL=1
End DoDot:1
+6 ;Add any that aren't N/A, Ignore on N/A,ERROR or NEVER to applicable total
+7 SET STATUS=$PIECE(STATUS,U)
+8 IF (STATUS'=" ")&(STATUS'["NEVER")&(STATUS'="N/A")&(STATUS'["ERROR")&(STATUS'["CNBD")
SET EVAL=1
+9 ;Update XTMP - Total of reminders due
+10 IF "IR"[PXRMTOT
Begin DoDot:1
+11 SET ADDCNT=0
+12 ;Combined facility duplicate check
+13 IF PXRMCCS'="B"
SET ADDCNT=1
+14 IF ADDCNT=0
IF PXRMCCS="B"
IF $$NEWCS(FACILITY,NAM,DFN,ITEM)=1
SET ADDCNT=1
+15 IF PXRMFCMB="Y"
IF '$$NEW(NAM,DFN,ITEM)
SET ADDCNT=0
+16 IF ADDCNT=1
Begin DoDot:2
+17 NEW CNT
+18 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,1)
+19 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,1)=CNT+EVAL
+20 ;Total of reminders evaluated
+21 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM)),U,2)
+22 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,NAM,ITEM),U,2)=CNT+DUE
End DoDot:2
+23 IF PXRMCCS="B"
Begin DoDot:2
+24 NEW CNT
+25 SET CNT=$PIECE($GET(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM)),U,1)
+26 SET $PIECE(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM),U,1)=CNT+EVAL
+27 ;Total of reminders evaluated
+28 SET CNT=$PIECE($GET(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM)),U,2)
+29 SET $PIECE(^XTMP(PXRMXCCS,PX,FACILITY,NAM,LOC,ITEM),U,2)=CNT+DUE
End DoDot:2
End DoDot:1
+30 ;
+31 ;Totals
+32 IF "RT"[PXRMTOT
Begin DoDot:1
+33 ;Check for duplicate patient at FACILITY level
+34 IF $DATA(^TMP("PXRMDUP",$JOB,FACILITY,DFN,ITEM))
QUIT
+35 ;Set duplicate check
+36 SET ^TMP("PXRMDUP",$JOB,FACILITY,DFN,ITEM)=""
+37 IF $GET(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))=""
Begin DoDot:2
+38 SET ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")="TOTAL"
End DoDot:2
+39 NEW CNT
+40 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,1)
+41 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,1)=CNT+EVAL
+42 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM)),U,2)
+43 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL",ITEM),U,2)=CNT+DUE
End DoDot:1
+44 ;
+45 ;Total of patients
+46 IF "IR"[PXRMTOT
Begin DoDot:1
+47 SET ADDCNT=1
+48 IF PXRMSEL="I"
IF $$NEWIP(DFN)<1
SET ADDCNT=0
+49 IF PXRMLCMB="Y"
IF ADDCNT=1
IF $$NEWP(@SUB,DFN)=0
SET ADDCNT=0
+50 IF ADDCNT=1
IF $$NEW(FACILITY,@SUB,DFN)=0
SET ADDCNT=0
+51 IF ADDCNT=1
Begin DoDot:2
+52 NEW CNT
+53 IF $GET(^XTMP(PXRMXTMP,PX,FACILITY,@SUB))=""
SET ^XTMP(PXRMXTMP,PX,FACILITY,@SUB)=NAM
+54 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,@SUB)),U,3)
+55 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,@SUB),U,3)=CNT+1
End DoDot:2
+56 IF PXRMCCS="B"
Begin DoDot:2
+57 NEW CNT
+58 IF $GET(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC))=""
SET ^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC)=LOC
+59 SET CNT=$PIECE($GET(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC)),U,3)
+60 SET $PIECE(^XTMP(PXRMXCCS,PX,FACILITY,@SUB,LOC),U,3)=CNT+1
End DoDot:2
End DoDot:1
+61 ;
+62 ;Total reports
+63 IF "TR"[PXRMTOT
Begin DoDot:1
+64 IF '$$NEWT(FACILITY,DFN)
QUIT
+65 IF $GET(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"))=""
Begin DoDot:2
+66 SET ^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")=NAM
End DoDot:2
+67 NEW CNT
+68 SET CNT=$PIECE($GET(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL")),U,3)
+69 SET $PIECE(^XTMP(PXRMXTMP,PX,FACILITY,"TOTAL"),U,3)=CNT+1
End DoDot:1
+70 QUIT
+71 ;
ERRMSG(TYPE) ;
+1 NEW CNT,CNT1,STR,SUBJECT,NLINES,OUTPUT,TO
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET NLINES=0
SET CNT=0
SET CNT1=2
+4 IF TYPE="C"
Begin DoDot:1
+5 MERGE ^TMP("PXRMXMZ",$JOB)=^TMP($JOB,"PXRM CNBD")
+6 SET SUBJECT="REMINDER REPORTS CNBD PATIENT LIST ("_$$FMTE^XLFDT($$NOW^XLFDT)_")"
+7 SET TO(DUZ)=""
+8 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
End DoDot:1
QUIT
+9 ;Build the error message
+10 IF $GET(TITLE)'=""
SET STR(1)="The Reminders Due Report "_$GET(TITLE)_" requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($GET(PXRMXST))_" was cancelled for the following reason(s):"
+11 IF $GET(TITLE)=""
SET STR(1)="The Reminders Due Report requested by "_$$GET1^DIQ(200,DUZ,.01)_" on "_$$FMTE^XLFDT($GET(PXRMXST))_" was cancelled for the following reason(s):"
+12 FOR
SET CNT=$ORDER(DBERR(CNT))
IF CNT'>0
QUIT
SET STR(CNT1)="\\"_DBERR(CNT)
SET CNT1=CNT1+1
+13 IF 'PXRMQUE
Begin DoDot:1
+14 DO FORMAT^PXRMTEXT(1,80,2,.STR,.NLINES,.OUTPUT)
+15 FOR CNT=1:1:NLINES
WRITE !,OUTPUT(CNT)
End DoDot:1
+16 IF PXRMQUE
Begin DoDot:1
+17 SET CNT=0
+18 FOR
SET CNT=$ORDER(STR(CNT))
IF CNT=""
QUIT
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=STR(CNT)
+19 SET SUBJECT="Cancelled Reminders Due Report ("_$$FMTE^XLFDT($$NOW^XLFDT)_")"
+20 SET TO(DUZ)=""
+21 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,.TO,DUZ)
+22 SET ZTSTOP=1
End DoDot:1
+23 QUIT
