PXRMXPR	; SLC/PJH - Print Reminder Due report. ;11/27/2006
	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
	;
	; Called/Jobbed after PXRMXSE1
	;
START	N BMARG,CRITERIA,C1S,C2S,C3S,C1HS,C2HS,C3HS,DONE,FIRST,HEAD
	N INDENT,PAGE,MOD,DES,ADES,CDES,RDES,SDES,MISSED,SEP
	N PLSTCRIT,PXRMOPT,PXRMFLD,PXRMHDR,PXRMHDRS,PXRMT,PXRMH
	N BD,ED,EMPCHK,SD,RD
	N PXRMTX
	S PXRMTX="due"
	;
	I PXRMREP="D" D
	.S EMPCHK=$P($G(^PXRM(800,1,"TRUNCATE EMPLOYEE SSN")),U)
	.I EMPCHK="" S EMPCHK="Y"
	;
	; Format Date Range
	I PXRMSEL="L" D
	.S BD=$$FMTE^XLFDT(PXRMBDT,"5D")
	.S ED=$$FMTE^XLFDT(PXRMEDT,"5D")
	; Format due effective date
	S SD=$$FMTE^XLFDT(PXRMSDT,"5P")
	; Format run date
	S RD=$$FMTE^XLFDT(PXRMXST,"5P")
	;
	U IO
	S DONE=0
	;
	;Delimited report.
	S SEP=$S(PXRMTABS="Y":PXRMTABC,1:"")
	;
	;Setup initial formatting parameters.
	S INDENT=3
	S BMARG=2,PAGE=0,HEAD=1
	;
	I +$G(XQY)>0 N XQOPT D OP^XQCHK
	S PXRMOPT=$P($G(XQOPT),U,2)
	I ($L(PXRMOPT)>0)&(PXRMOPT'["Clinical") S PXRMOPT="Clinical "_PXRMOPT
	I PXRMREP="D" D
	.S RDES=$P(REMINDER(1),U,2)
	.S PXRMOPT=PXRMOPT_" - Detailed Report"
	.N IC F IC=0,3,4 S PXRMH(IC)="",PXRMT(IC)=0
	.S PXRMH(1)="Date Due    Last Done   Next Appt"
	.S PXRMH(2)="--------    ---------   ---------"
	.I $G(PXRMINP) D
	..S PXRMH(1)="Date Due    Last Done   Ward/Bed"
	..S PXRMH(2)="--------    ---------   --------"
	.F IC=1,2 S PXRMT(IC)=40
	.S ADES="Next Appointment only"
	.I PXRMFUT="Y" S ADES="All Future Appointments"
	.S SDES="Sorted by Patient Name"
	.I PXRMSRT="Y" S SDES="Sorted by Appointment Date"
	I PXRMREP="S" D
	.S PXRMOPT=PXRMOPT_" - Summary Report"
	.S PXRMH(0)="# Patients with Reminders",PXRMT(0)=50
	.S PXRMH(1)="Applicable           Due"
	.S PXRMH(2)="----------           ---"
	.N IC F IC=1,2 S PXRMT(IC)=50
	.S PXRMH(3)="Denominator"
	.S PXRMH(4)="-----------"
	.F IC=3,4 S PXRMT(IC)=0
	;
	;Print Criteria Page if normal report
	S CRITERIA=0 I PXRMTABS="N" S CRITERIA=1
	;or delimited report with notemplate
	I PXRMTABS="Y",PXRMTMP="" S CRITERIA=1
	;
	;Build array of locations/providers with no patients selected in
	;MISSED.
	D NOPATS^PXRMXPR1(.MISSED)
	;
	;Print either criteria page or summary header
	I CRITERIA D  G:DONE EXIT
	.D PAGE^PXRMXGPR Q:DONE
	.D CRIT^PXRMXGPR(10,.PLSTCRIT) Q:DONE
	;Header if delimited output from a template
	I 'CRITERIA D
	.N HDR1,HDR2,HDR3
	.S HDR1="",HDR2="",HDR3=""
	.I PXRMTMP]"" S HDR1="TITLE:"_$P(PXRMTMP,U,2)_U_"TEMPLATE:"_$P(PXRMTMP,U,3)
	.I PXRMTMP="" D
	..N PXRMFLD,DES,CDES D LITS^PXRMXPR1 S HDR1=PXRMFLD_U_$G(DES)_U_$G(CDES)
	.I PXRMSEL="L" S HDR2="START:"_BD_U_"END:"_ED
	.S HDR2=HDR2_U_"RUN:"_RD_"Effective Date:"_SD
	.I PXRMFCMB="Y" S HDR3="COMBINED FACILITY"
	.I PXRMLCMB="Y" S $P(HDR3,SEP,2)="COMBINED LOCATION"
	.I PXRMTCMB="Y" S $P(HDR3,SEP,2)="COMBINED OE/RR TEAMS"
	.I PXRMREP="S" D
	..N LIT1,LIT2,LIT3
	..D LIT^PXRMXD
	..I PXRMTOT="I" S $P(HDR3,SEP,3)=$$UP^XLFSTR(LIT1)
	..I PXRMTOT="R" S $P(HDR3,SEP,3)=$$UP^XLFSTR(LIT2)
	..I PXRMTOT="T" S $P(HDR3,SEP,3)=$$UP^XLFSTR(LIT3)
	.S PLSTCRIT(1)=HDR1,PLSTCRIT(2)=HDR2,PLSTCRIT(3)=HDR3
	.W !,HDR1,!,HDR2,!,HDR3,!
	;
	;Kill items marked as found
	K ^XTMP(PXRMXTMP,"MARKED AS FOUND")
	;
	;Setup the final formatting parameters.
	S C1HS=INDENT+3
	S C1S=0
	S C2HS=C1S+2
	S C2S=C2HS
	S C3HS=C2HS+5
	S C3S=C3HS
	S HEAD=1
	S INDENT=10
	;
	; Update last run date 
	I $G(PXRMTMP)'="" D UPD^PXRMXTU
	;
	; Get report detail from ^XTMP
	N PNAM,SUB,DFN,BID,NAM,FAC,MOD,SRT,TOTAL,APPL,FACPNAME,PX,TTOTAL
	S TTOTAL=0
	; Set subroutine label from report format
	S MOD="SUMARY" I PXRMREP="D" S MOD="DETAIL"
	;
	S FAC=0,PX="PXRM"
	F  S FAC=$O(^XTMP(PXRMXTMP,PX,FAC)) Q:FAC=""  Q:DONE  D
	.;Get facility name for Location and PCMM team report
	.I "TL"[PXRMSEL,PXRMFCMB="N" D
	..S FACPNAME=$P(PXRMFACN(FAC),U,1)_"  "_$P(PXRMFACN(FAC),U,2)
	.;Report from ^XTMP - label MOD is DETAIL/SUMARY
	.S (PNAM,SUB,NAM,SRT)=""
	.I PXRMSEL="I" S SUB="INDIVIDUAL PATIENTS" D @MOD Q:DONE
	.I PXRMSEL'="I" D
	..;Sort internal IENs into alpha order
	..D XSORT
	..F  S SRT=$O(^TMP($J,"SORT",SRT)) Q:SRT=""  Q:DONE  D
	...S SUB=$G(^TMP($J,"SORT",SRT)) D @MOD
	..I MOD="SUMARY","RT"[PXRMTOT S SUB="TOTAL" D @MOD
	;
	; Null report if no patients selected
	I ('DONE),$O(^XTMP(PXRMXTMP,PX,""))="" D NULL^PXRMXGPR G EXIT
	; Report selected patient sample with no patients
	I $D(MISSED),PXRMPML=1 D MISSED^PXRMXPR1(0,.MISSED)
	;
	;Print Patient List
	I $G(PATLST)="Y" D FOOTER^PXRMXPR1(.PLSTCRIT)
	;
	;Print Error message
	I $D(^XTMP(PXRMXTMP,"ERROR"))>0!($D(^XTMP(PXRMXTMP,"CNBD"))>0) D ERROR^PXRMXBSY
EXIT	;
	D TIMING^PXRMXGUT
	D EXIT^PXRMXGUT
	;
	;Allow the task to be cleaned up upon successful completion.
	I $D(ZTQUEUED) S ZTREQ="@"
	;
	D EOR^PXRMXGUT
	Q
	;
	;Report by Patient
DETAIL	N JJ,VA,DATE,COUNT,DDAT,EMP
	N BED,DDUE,DDONE,DNEXT,FDAT1,FDAT2,FDAT3,FNAM,FTXT
	S NAM=$G(^XTMP(PXRMXTMP,PX,FAC,SUB)),HEAD=1
	S COUNT=$P(NAM,U,2),TOTAL=$P(NAM,U,3),APPL=$P(NAM,U,4),NAM=$P(NAM,U,1)
	S DDAT="",JJ=0
	; Get list of patients for each appointment date
	F  S DDAT=$O(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT)) Q:DDAT=""  Q:DONE  D PAT
	; No patients due
	I JJ=0 D:'DONE NONE^PXRMXGPR
	; Total patients
	D:'DONE TOTAL^PXRMXGPR
	S TTOTAL=TTOTAL+TOTAL
	Q
	;
PAT	;Extract and print patient detail
	N DNEXT1,NODE,PNUM
	F  S PNAM=$O(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM)) Q:PNAM=""  Q:DONE  D
	.S JJ=JJ+1
	.;Format print line
	.S (BID,DNEXT1,FDAT1,FDAT2,FDAT3,DNEXT1)="" I PNAM'["No patients found" D 
	..S FDAT2="N/A",FDAT3="None"
	..S NODE=$G(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM))
	..S DDUE=$P(NODE,U,2),DDONE=$P(NODE,U,3),DNEXT=$P(NODE,U,4)
	..S BED=$P(NODE,U,5)
	..S DFN=$P(NODE,U) S BID=$P($G(PNAM),U,2)
	..I PXRMSSN="N" S BID=$E(BID,6,9)
	..I PXRMSSN="Y",EMPCHK="Y" D EMP S:EMP BID=$E(BID,6,9)
	..S BID="("_BID_")"
	..S FDAT1=$$FMTE^XLFDT(DDUE,"5D")
	..I DDONE S FDAT2=$$FMTE^XLFDT(DDONE,"5D")
	..I BED'="NONE" S FDAT3=$P(NODE,U,5),DNEXT1=$$FMTE^XLFDT(DNEXT,"5D")
	..I DNEXT,FDAT3="None" S FDAT3=$$FMTE^XLFDT(DNEXT,"5D")
	.;Print
	.D CHECK Q:DONE
	.;Normal output
	.I PXRMTABS="N" D
	..S PNUM=JJ#10000
	..S PNUM=$$RJ^XLFSTR(PNUM,4)
	..W !,PNUM,?5,$E($P($G(PNAM),U),1,33-$L(BID))," ",BID,?40,FDAT1,?52,FDAT2
	..I ('$G(PXRMINP)),PXRMFUT'="Y" W ?64,$S(BED'="NONE":BED_" (Inp.)",1:FDAT3)
	..I $G(PXRMINP) W ?64,BED
	..I DNEXT1'="",PXRMFUT'="Y" W !,?64,DNEXT1
	.;Delimited report
	.I PXRMTABS="Y" D
	..N FNAM
	..S FNAM=$P($G(PNAM),U)
	..I FNAM'["No patients found" S FNAM=$E(FNAM,1,33-$L(BID))_" "_BID
	..I "CES"[PXRMTABC S FNAM=$TR(FNAM,SEP,"_"),FDAT1=$TR(FDAT1,SEP,"_")
	..I BED="NONE" S BED=" "
	..W !,JJ_SEP_FNAM_SEP_FDAT1_SEP_FDAT2 I $G(PXRMINP) W SEP_BED
	..I ('$G(PXRMINP)),PXRMFUT'="Y" W SEP_FDAT3_SEP_BED
	.;---
	.; Future Appointments
	.I PXRMFUT="Y" D
	..N CNT,ADAT,ALOC,ATYP,FIRST,NONE
	..S CNT=0,NONE=1,FIRST=1
	..I '$D(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM)) Q
	..F  S CNT=$O(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM,CNT)) Q:CNT'>0  D
	...S ADAT=$P(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM,CNT,0),U)
	...I PXRMDLOC="Y" D
	....S ALOC=$P(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM,CNT,0),U,2)
	....S ATYP=$P(^XTMP(PXRMXTMP,PX,FAC,SUB,DDAT,PNAM,CNT,0),U,3)
	...S ADAT=$$FMTE^XLFDT(ADAT,"2P")
	...I FIRST D  S FIRST=0,NONE=0
	....I PXRMTABS="N" W ?64,$S(BED'="NONE":BED_" (Inp.)",1:"")
	...D CHECK
	...I PXRMDLOC="Y" D
	....I PXRMTABS="N" W !,?8,ADAT,?30,$E(ALOC,1,25),?60,$E(ATYP,1,20)
	....I PXRMTABS="Y" W SEP_ADAT_SEP_$E(ALOC,1,25)_SEP_$E(ATYP,1,20)
	...I PXRMDLOC="N" D
	....I PXRMTABS="N" W !,?10,ADAT
	....I PXRMTABS="Y" W SEP_ADAT
	..I NONE,PXRMTABS="N" W ?64,FDAT3
	..I NONE,PXRMTABS="Y" W SEP_FDAT3
	..I PXRMTABS="Y" W $S(BED'="NONE":SEP_BED_" (Inp.)",1:"")
	..K ^UTILITY("VASD",$J)
	Q
	;
	;Summary by Reminder
SUMARY	N JJ,EVAL,DUE,RNAM,RNUM,ITEM,COUNT,FTXT
	S NAM=$G(^XTMP(PXRMXTMP,PX,FAC,SUB)),HEAD=1
	S TOTAL=$P(NAM,U,3),COUNT=$P(NAM,U,2),NAM=$P(NAM,U,1)
	S RNUM=$O(REMINDER(""),-1)
	;Get reminders in alpha order
	F JJ=1:1:RNUM D  Q:DONE
	.S ITEM=$P(REMINDER(JJ),U,1),RNAM=$P(REMINDER(JJ),U,4)
	.S:RNAM="" RNAM=$P(REMINDER(JJ),U,2)
	.; zero lines will be printed 
	.S DUE=$G(^XTMP(PXRMXTMP,PX,FAC,SUB,ITEM))
	.S EVAL=+$P(DUE,U,1),DUE=+$P(DUE,U,2)
	.;Print
	.D CHECK Q:DONE
	.;Normal Report
	.I PXRMTABS="N" W !,JJ,?5,RNAM,?48,$J(EVAL,10),?63,$J(DUE,10)
	.;Condensed Report
	.I PXRMTABS="Y" D
	..I "CES"[PXRMTABC S RNAM=$TR(RNAM,SEP,"_")
	..W !,JJ_SEP_RNAM_SEP_EVAL_SEP_DUE_SEP_$TR(NAM,SEP,"_")
	D:'DONE TOTAL^PXRMXGPR
	I $G(SUB)'="TOTAL",PXRMTOT'="T" S TTOTAL=TTOTAL+TOTAL
	I $G(SUB)="TOTAL",PXRMTOT="T" S TTOTAL=TTOTAL+TOTAL
	Q
	;
	;Check line count before writing line
CHECK	I ((PXRMTABS="N")&($Y>(IOSL-BMARG-3)))!(HEAD=1) D COL^PXRMXGPR(1)
	Q
	;
	;Check if employee
EMP	N VAEL
	D ELIG^VADPT
	;Check TYPE (#391) field
	I $P($G(VAEL(6)),U,2)="EMPLOYEE" S EMP=1 Q
	;Check PATIENT ELIGABILITY (#361) field
	N ELIG
	S ELIG=0,EMP=0
	F  S ELIG=$O(VAEL(1,ELIG)) Q:'ELIG  D  Q:EMP
	.I $P($G(VAEL(1,ELIG)),U,2)="EMPLOYEE" S EMP=1
	Q
	;
	;Sort internal numbers into Alpha order
XSORT	N SUB,NAM
	K ^TMP($J,"SORT")
	S SUB=""
	F  S SUB=$O(^XTMP(PXRMXTMP,PX,FAC,SUB)) Q:SUB=""  D
	.Q:SUB="TOTAL"
	.S NAM=$P(^XTMP(PXRMXTMP,PX,FAC,SUB),U)
	.I NAM="" S NAM=SUB
	.S ^TMP($J,"SORT",NAM)=SUB
	Q
	;
