PXRMXD ; SLC/PJH - Reminder Due reports DRIVER ;23-Mar-2015 10:41;DU
;;2.0;CLINICAL REMINDERS;**4,6,1001,12,1005**;Feb 04, 2005;Build 23
;
;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
START ; Arrays and strings
N PX,PXRMDEV,PXRMHFIO,PXRMIOP,PXRMXST,PXRMOPT,PXRMQUE,PXRMXTMP,PXRMSEL
N PXRMFAC,PXRMFACN,PXRMSCAT,PXRMSRT,PXRMTYP
N REMINDER,PXRMINP,PXRMFCMB,PXRMLCMB,PXRMTCMB,PXRMTOT
; Addenda
N PXRMOTM,PXRMPAT,PXRMPCM,PXRMPRV,PXRMTMP,PXRMRCAT,PXRMREM
N PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMLCSC,PXRMCGRP,PXRMCGRN
N PXRMLIS
; Counters
N NCAT,NFAC,NLOC,NPAT,NPCM,NOTM,NPRV,NREM,NCS,NHL,NCGRP
; Flags and Dates
N PXRMFD,PXRMSDT,PXRMBDT,PXRMEDT,PXRMREP,PXRMPRIM,PXRMFUT,PXRMDLOC
;IHS/CIA/MGH Modified to add variable for health record number
N PXRMRT,PXRMSSN,PXRMHRCN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
N DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
N PLISTPUG
N PXRMTPAT,PXRMDPAT,PXRMPML,PXRMPER,PXRMCCS,PXRMXCCS,PXRMOWN
;
S PXRMRT="PXRMX",PXRMTYP="X",PXRMFCMB="N",PXRMLCMB="N",PXRMTCMB="N"
S PXRMCCS=""
;
I '$D(PXRMUSER) N PXRMUSER S PXRMUSER=0
;
;Guarantee the timestamp is unique.
H 1
S PXRMXST=$$NOW^XLFDT
S PXRMXTMP=PXRMRT_PXRMXST
S PXRMXCCS=PXRMRT_"SEPCLINIC"_PXRMXST
S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
S ^XTMP(PXRMXCCS,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report Seperate Clinic Stop"
;
;Check for existing report templates
REP ;
S PXRMINP=0
D:PXRMUSER ^PXRMXTB D:'PXRMUSER ^PXRMXT I $D(DTOUT)!$D(DUOUT) G EXIT
;Run report from template details
I PXRMTMP'="" D G:$D(DUOUT)&'$D(DTOUT) REP Q
.D START^PXRMXTA("JOB^PXRMXQUE") K DUOUT,DIRUT,DTOUT
;
;Select sample criteria
SEL ;
D SELECT^PXRMXSD(.PXRMSEL) I $D(DTOUT) G EXIT
I $D(DUOUT) G:PXRMTMP="" EXIT G REP
;
FAC ;Get the facility list.
I "IRPO"'[PXRMSEL D G:$D(DTOUT) EXIT G:$D(DUOUT) SEL
.D FACILITY^PXRMXSU(.PXRMFAC) Q:$D(DTOUT)!$D(DUOUT)
;
;Check if combined facility report is required
COMB I "IRPO"'[PXRMSEL,NFAC>1 D G:$D(DTOUT) EXIT G:$D(DUOUT) FAC
.D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
;
OPT ;Variable prompts
;
;Get Individual Patient list
I PXRMSEL="I" K PXRMPAT D PAT^PXRMXSU(.PXRMPAT)
;Get Patient list #810.5
I PXRMSEL="R" K PXRMLIST D LIST^PXRMXSU(.PXRMLIST)
;Get OE/RRteam list
I PXRMSEL="O" K PXRMOTM D OERR^PXRMXSU(.PXRMOTM)
;Get PCMM team
I PXRMSEL="T" K PXRMPCM D PCMM^PXRMXSU(.PXRMPCM)
;Get provider list
I PXRMSEL="P" K PXRMPRV D PROV^PXRMXSU(.PXRMPRV)
;IHS/MSC/MGH Patch 1001 Get provider list for IHS
I PXRMSEL="D" K PXRMPRV D PROV^PXRMXSU(.PXRMPRV)
;Get the location list.
I PXRMSEL="L" K PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN D
.D LOC^PXRMXSU("Determine encounter counts for","HS")
I $D(DTOUT) G EXIT
I $D(DUOUT) G:"IRPO"[PXRMSEL SEL G:NFAC>1 COMB G FAC
;
;Check if inpatient location report
S PXRMINP=$$INP
;
; Primary Provider or All (PCMM Provider only)
PRIME ;
I PXRMSEL="P" D G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
.D PRIME^PXRMXSD(.PXRMPRIM)
;
IHSDT ;IHS/MSC/MGH patch 1001 for primary care providers
;Get a date range for IHS
I PXRMSEL="D" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
;End addition
DR ; Get the date range.
S PXRMFD="P"
; No prompt if individual patients selected
; Single dates only if PCMM teams/providers and OE/RR teams selected
; Choice of previous/future date range if location selected
;
; Prior encounters/future appointments (location only)
PREV I PXRMSEL="L" D PREV^PXRMXSD(.PXRMFD) G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
; Date range input (location only)
I PXRMSEL="L" D G:$D(DTOUT) EXIT G:$D(DUOUT) PREV
.I PXRMFD="P" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
.I PXRMFD="F" D FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
.I PXRMFD="A" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
.I PXRMFD="C" S PXRMBDT=DT,PXRMEDT=DT
; Due Effective Date
DUE D SDR^PXRMXDUT(.PXRMSDT) G:$D(DTOUT) EXIT
I $D(DUOUT) G:PXRMSEL="L" PREV G OPT
;
SCAT ;Get the service categories.
I PXRMSEL="L",PXRMFD="P" D
.D SCAT^PXRMXSC
.I $D(DTOUT)!$D(DUOUT) Q
I $D(DTOUT) G EXIT
I $D(DUOUT) G DUE
;
TYP ;Determine type of report (detail/summary)
S PXRMREP="S"
D REP^PXRMXSD(.PXRMREP) I $D(DTOUT) G EXIT
I $D(DUOUT) G SCAT
;
;Check if combined location report is required
LCOMB S NLOC=0
I PXRMREP="D",PXRMSEL="L" D G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
.N DEFAULT,TEXT
.D NLOC
.I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
;
;Check if combined OE/RR team report is required
TCOMB I PXRMREP="D",PXRMSEL="O",$G(NOTM)>1 D G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
.N DEFAULT,TEXT
.S DEFAULT="N",TEXT="OE/RR teams"
.D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
;
FUT ;For detailed report give option to display future appointments
S PXRMFUT="N"
I PXRMREP="D",'PXRMINP D G:$D(DTOUT) EXIT I $D(DUOUT) G:(PXRMSEL="L")&(NLOC>1) LCOMB G:(PXRMSEL="O")&($G(NOTM)>1) TCOMB G TYP
.D FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
.I PXRMFUT="Y" D Q:$D(DTOUT)!$D(DUOUT)
..D FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
;
SRT ;For detailed report give option to sort by appointment date
S PXRMSRT="N"
I PXRMREP="D",("RI"'[PXRMSEL) D G:$D(DTOUT) EXIT I $D(DUOUT) G:(PXRMSEL="L")&(PXRMINP)&(NLOC>1) LCOMB G:PXRMINP TYP G:(PXRMSEL="O")&($G(NOTM)>1) TCOMB G FUT
.;Option to sort by Bed for inpatients
.I PXRMSEL="L",PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
.;Otherwise option to sort by appt. date
.D SRT^PXRMXSD(.PXRMSRT)
;
;Option to print full SSN
SSN I PXRMREP="D" D G:$D(DTOUT) EXIT I $D(DUOUT) G:"IR"[PXRMSEL FUT G SRT
.;IHS/MSC/MGH Modified to use HRCN
.;D SSN^PXRMXSD(.PXRMSSN)
.D SSN^PXRMXSD(.PXRMHRCN)
;
;Option to print without totals, with totals or totals only
TOT I PXRMREP="S" D G:$D(DTOUT) EXIT I $D(DUOUT) G TYP
.;Default is normal report
.S PXRMTOT="I"
.;Ignore patient and patient list reports
.I "RI"[PXRMSEL Q
.;Only prompt if more than one location, team or provider is selected
.I PXRMSEL="P",NPRV<2 Q
.I "OT"[PXRMSEL,NOTM<2 Q
.;Ignore reports for all locations
.I PXRMSEL="L",PXRMLCMB="Y" Q
.I PXRMSEL="L" N DEFAULT,TEXT D NLOC Q:NLOC<2
.;Prompt for options
.N LIT1,LIT2,LIT3
.D LIT,TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
;
SEPCS ;Allow users to determine the output of the Clinic Stops report
D SEPCS^PXRMXSD(.PXRMCCS) G:$D(DTOUT) EXIT I $D(DUOUT) G:PXRMREP="D" SSN G TOT
;
MLOC ;Print Locations empty location at the end of the report
W !
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Print locations with no patients"
D ^DIR
I Y="^^" G EXIT
I Y=U G:$P(PXRMLCSC,U)="CS" SEPCS G:PXRMREP="D" SSN G TOT
S PXRMPML=Y
;
DPER ;Print percentage with the report outut
W !
S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Print percentages with the report output"
D ^DIR
I Y="^^" G EXIT
I Y=U G MLOC
S PXRMPER=Y
;
;Reminder Category/Individual Reminder Selection
RCAT ;
D RCAT^PXRMXSU(.PXRMRCAT,.PXRMREM) I $D(DTOUT) G EXIT
;I $D(DUOUT) G:PXRMREP="D" SSN G TOT
I $D(DUOUT) G MLOC
;
;Create combined reminder list
D MERGE^PXRMXS1
;
SAV ;Option to create a new report template
I PXRMTMP="" D ^PXRMXTU G:$D(DTOUT) EXIT I $D(DUOUT) G RCAT
;
;Option to print delimiter separated output
TABS D G:$D(DTOUT) EXIT I $D(DUOUT) G SAV
.D TABS^PXRMXSD(.PXRMTABS)
;Select chracter
TCHAR I PXRMTABS="Y" D G:$D(DTOUT) EXIT G:$D(DUOUT) TABS
.S PXRMTABC=$$DELIMSEL^PXRMXSD
;
DPAT ;Ask whether to include deceased and test patients.
S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
N PXRMIDOD I PXRMDPAT>0 S PXRMIDOD=1
Q:$D(DTOUT) G:$D(DUOUT) TABS
TPAT ;
S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
Q:$D(DTOUT) G:$D(DUOUT) DPAT
PATLIST ;
K PATCREAT
N PATLST
I PXRMSEL'="I"&(PXRMUSER'="Y") D
. D ASK(.PATLST,"Save due patients to a patient list: ",3)
. I $G(PATLST)="" Q
. I $G(PATLST)="N" S PXRMLIS1="" Q
. I $G(PATLST)="Y" D
..S PATCREAT="N"
..D ASK(.PATCREAT,"Secure list?: ",3) I $D(DTOUT)!($D(DUOUT)) Q
..K PLISTPUG
..S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
I $G(PATLST)="" G:$D(DTOUT) EXIT I $D(DUOUT) G TPAT
G:$D(DTOUT) EXIT I $D(DUOUT) G PATLIST
I $G(PATLST)="Y" S TEXT="Select PATIENT LIST name: " D PLIST^PXRMLCR(.PXRMLIS1,TEXT,"") Q:$D(DUOUT)!$D(DTOUT)
;Determine whether the report should be queued.
JOB ;
D JOB^PXRMXQUE
Q
;
;Option PXRM REMINDERS DUE (USER)
USER N PXRMUSER
S PXRMUSER=+$G(DUZ)
G START
;
;
EXIT ;Clean things up.
D EXIT^PXRMXGUT
Q
;
;Check if inpatient report
INP() ;Applies to location reports only
I PXRMSEL'="L" Q 0
;For all inpatient locations default is automatic
I $P(PXRMLCSC,U)="HAI" Q 1
;For selected locations check if all locations are wards
I $P(PXRMLCSC,U)="HS" Q $$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
;Otherwise
Q 0
;
;Prompt text
LIT N LIT
S LIT=$S(PXRMSEL="P":"Provider","OT"[PXRMSEL:"Team",1:"Location")
I PXRMFCMB="N" D
.S LIT1="Individual "_LIT_"s only"
.S LIT2="Individual "_LIT_"s plus Totals by Facility"
.S LIT3="Totals by Facility only"
I PXRMFCMB="Y" D
.S LIT1="Individual "_LIT_"s only"
.S LIT2="Individual "_LIT_"s plus Overall Total"
.S LIT3="Overall Total only"
Q
;
;Check if multiple locations
NLOC S DEFAULT="N",NLOC=1,TEXT="Locations"
I $P(PXRMLCSC,U)["HA" S DEFAULT="Y",NLOC=999
I $P(PXRMLCSC,U)="CA" S DEFAULT="Y",NCS=999
I $E(PXRMLCSC)="C" S TEXT="Clinic Stops",NLOC=NCS
I $E(PXRMLCSC)="G" S TEXT="Clinic Groups",NLOC=NCGRP
I $P(PXRMLCSC,U)="HS" S NLOC=NHL S:$$INP TEXT="Inpatient Locations"
;Special coding if more than one facility and location
I $P(PXRMLCSC,U)="HS",NFAC>1,NLOC>1 D
.N FAC,HLOCIEN,HLNAME,IC,MULT
.S IC=0 S:PXRMFCMB="Y" FAC="COMBINED"
.;Build list of locations by facility
.F S IC=$O(PXRMLCHL(IC)) Q:'IC D
..S HLOCIEN=$P(PXRMLCHL(IC),U,2),FAC=$$FACL^PXRMXAP(HLOCIEN) Q:'FAC
..S HLNAME=$P(PXRMLCHL(IC),U) Q:HLNAME=""
..S MULT(FAC,HLNAME)=""
.S MULT=0,FAC=0
.;Count locations in each facility
.F S FAC=$O(MULT(FAC)) Q:'FAC D Q:MULT
..S IC=0,HLNAME=""
..F S HLNAME=$O(MULT(FAC,HLNAME)) Q:HLNAME="" S IC=IC+1
..I IC>1 S MULT=1
.;If only one location per facility suppress combined location option
.I 'MULT S NLOC=1
Q
;
ASK(YESNO,PROMPT,NUM) ;
N X,Y,TEXT
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YA0"
S DIR("A")=PROMPT
S DIR("B")="N"
S DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMLCR("_NUM_")"
W !
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0))
Q
;
PXRMXD ; SLC/PJH - Reminder Due reports DRIVER ;23-Mar-2015 10:41;DU
+1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,12,1005**;Feb 04, 2005;Build 23
+2 ;
+3 ;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
START ; Arrays and strings
+1 NEW PX,PXRMDEV,PXRMHFIO,PXRMIOP,PXRMXST,PXRMOPT,PXRMQUE,PXRMXTMP,PXRMSEL
+2 NEW PXRMFAC,PXRMFACN,PXRMSCAT,PXRMSRT,PXRMTYP
+3 NEW REMINDER,PXRMINP,PXRMFCMB,PXRMLCMB,PXRMTCMB,PXRMTOT
+4 ; Addenda
+5 NEW PXRMOTM,PXRMPAT,PXRMPCM,PXRMPRV,PXRMTMP,PXRMRCAT,PXRMREM
+6 NEW PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMLCSC,PXRMCGRP,PXRMCGRN
+7 NEW PXRMLIS
+8 ; Counters
+9 NEW NCAT,NFAC,NLOC,NPAT,NPCM,NOTM,NPRV,NREM,NCS,NHL,NCGRP
+10 ; Flags and Dates
+11 NEW PXRMFD,PXRMSDT,PXRMBDT,PXRMEDT,PXRMREP,PXRMPRIM,PXRMFUT,PXRMDLOC
+12 ;IHS/CIA/MGH Modified to add variable for health record number
+13 NEW PXRMRT,PXRMSSN,PXRMHRCN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
+14 NEW DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
+15 NEW PLISTPUG
+16 NEW PXRMTPAT,PXRMDPAT,PXRMPML,PXRMPER,PXRMCCS,PXRMXCCS,PXRMOWN
+17 ;
+18 SET PXRMRT="PXRMX"
SET PXRMTYP="X"
SET PXRMFCMB="N"
SET PXRMLCMB="N"
SET PXRMTCMB="N"
+19 SET PXRMCCS=""
+20 ;
+21 IF '$DATA(PXRMUSER)
NEW PXRMUSER
SET PXRMUSER=0
+22 ;
+23 ;Guarantee the timestamp is unique.
+24 HANG 1
+25 SET PXRMXST=$$NOW^XLFDT
+26 SET PXRMXTMP=PXRMRT_PXRMXST
+27 SET PXRMXCCS=PXRMRT_"SEPCLINIC"_PXRMXST
+28 SET ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
+29 SET ^XTMP(PXRMXCCS,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report Seperate Clinic Stop"
+30 ;
+31 ;Check for existing report templates
REP ;
+1 SET PXRMINP=0
+2 IF PXRMUSER
DO ^PXRMXTB
IF 'PXRMUSER
DO ^PXRMXT
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+3 ;Run report from template details
+4 IF PXRMTMP'=""
Begin DoDot:1
+5 DO START^PXRMXTA("JOB^PXRMXQUE")
KILL DUOUT,DIRUT,DTOUT
End DoDot:1
IF $DATA(DUOUT)&'$DATA(DTOUT)
GOTO REP
QUIT
+6 ;
+7 ;Select sample criteria
SEL ;
+1 DO SELECT^PXRMXSD(.PXRMSEL)
IF $DATA(DTOUT)
GOTO EXIT
+2 IF $DATA(DUOUT)
IF PXRMTMP=""
GOTO EXIT
GOTO REP
+3 ;
FAC ;Get the facility list.
+1 IF "IRPO"'[PXRMSEL
Begin DoDot:1
+2 DO FACILITY^PXRMXSU(.PXRMFAC)
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO SEL
+3 ;
+4 ;Check if combined facility report is required
COMB IF "IRPO"'[PXRMSEL
IF NFAC>1
Begin DoDot:1
+1 DO COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO FAC
+2 ;
OPT ;Variable prompts
+1 ;
+2 ;Get Individual Patient list
+3 IF PXRMSEL="I"
KILL PXRMPAT
DO PAT^PXRMXSU(.PXRMPAT)
+4 ;Get Patient list #810.5
+5 IF PXRMSEL="R"
KILL PXRMLIST
DO LIST^PXRMXSU(.PXRMLIST)
+6 ;Get OE/RRteam list
+7 IF PXRMSEL="O"
KILL PXRMOTM
DO OERR^PXRMXSU(.PXRMOTM)
+8 ;Get PCMM team
+9 IF PXRMSEL="T"
KILL PXRMPCM
DO PCMM^PXRMXSU(.PXRMPCM)
+10 ;Get provider list
+11 IF PXRMSEL="P"
KILL PXRMPRV
DO PROV^PXRMXSU(.PXRMPRV)
+12 ;IHS/MSC/MGH Patch 1001 Get provider list for IHS
+13 IF PXRMSEL="D"
KILL PXRMPRV
DO PROV^PXRMXSU(.PXRMPRV)
+14 ;Get the location list.
+15 IF PXRMSEL="L"
KILL PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN
Begin DoDot:1
+16 DO LOC^PXRMXSU("Determine encounter counts for","HS")
End DoDot:1
+17 IF $DATA(DTOUT)
GOTO EXIT
+18 IF $DATA(DUOUT)
IF "IRPO"[PXRMSEL
GOTO SEL
IF NFAC>1
GOTO COMB
GOTO FAC
+19 ;
+20 ;Check if inpatient location report
+21 SET PXRMINP=$$INP
+22 ;
+23 ; Primary Provider or All (PCMM Provider only)
PRIME ;
+1 IF PXRMSEL="P"
Begin DoDot:1
+2 DO PRIME^PXRMXSD(.PXRMPRIM)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO OPT
+3 ;
IHSDT ;IHS/MSC/MGH patch 1001 for primary care providers
+1 ;Get a date range for IHS
+2 IF PXRMSEL="D"
DO PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
+3 ;End addition
DR ; Get the date range.
+1 SET PXRMFD="P"
+2 ; No prompt if individual patients selected
+3 ; Single dates only if PCMM teams/providers and OE/RR teams selected
+4 ; Choice of previous/future date range if location selected
+5 ;
+6 ; Prior encounters/future appointments (location only)
PREV IF PXRMSEL="L"
DO PREV^PXRMXSD(.PXRMFD)
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO OPT
+1 ; Date range input (location only)
+2 IF PXRMSEL="L"
Begin DoDot:1
+3 IF PXRMFD="P"
DO PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
+4 IF PXRMFD="F"
DO FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
+5 IF PXRMFD="A"
DO PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
+6 IF PXRMFD="C"
SET PXRMBDT=DT
SET PXRMEDT=DT
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO PREV
+7 ; Due Effective Date
DUE DO SDR^PXRMXDUT(.PXRMSDT)
IF $DATA(DTOUT)
GOTO EXIT
+1 IF $DATA(DUOUT)
IF PXRMSEL="L"
GOTO PREV
GOTO OPT
+2 ;
SCAT ;Get the service categories.
+1 IF PXRMSEL="L"
IF PXRMFD="P"
Begin DoDot:1
+2 DO SCAT^PXRMXSC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
End DoDot:1
+4 IF $DATA(DTOUT)
GOTO EXIT
+5 IF $DATA(DUOUT)
GOTO DUE
+6 ;
TYP ;Determine type of report (detail/summary)
+1 SET PXRMREP="S"
+2 DO REP^PXRMXSD(.PXRMREP)
IF $DATA(DTOUT)
GOTO EXIT
+3 IF $DATA(DUOUT)
GOTO SCAT
+4 ;
+5 ;Check if combined location report is required
LCOMB SET NLOC=0
+1 IF PXRMREP="D"
IF PXRMSEL="L"
Begin DoDot:1
+2 NEW DEFAULT,TEXT
+3 DO NLOC
+4 IF NLOC>1
DO COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO TYP
+5 ;
+6 ;Check if combined OE/RR team report is required
TCOMB IF PXRMREP="D"
IF PXRMSEL="O"
IF $GET(NOTM)>1
Begin DoDot:1
+1 NEW DEFAULT,TEXT
+2 SET DEFAULT="N"
SET TEXT="OE/RR teams"
+3 DO COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO TYP
+4 ;
FUT ;For detailed report give option to display future appointments
+1 SET PXRMFUT="N"
+2 IF PXRMREP="D"
IF 'PXRMINP
Begin DoDot:1
+3 DO FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
+4 IF PXRMFUT="Y"
Begin DoDot:2
+5 DO FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
End DoDot:2
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
IF (PXRMSEL="L")&(NLOC>1)
GOTO LCOMB
IF (PXRMSEL="O")&($GET(NOTM)>1)
GOTO TCOMB
GOTO TYP
+6 ;
SRT ;For detailed report give option to sort by appointment date
+1 SET PXRMSRT="N"
+2 IF PXRMREP="D"
IF ("RI"'[PXRMSEL)
Begin DoDot:1
+3 ;Option to sort by Bed for inpatients
+4 IF PXRMSEL="L"
IF PXRMINP
DO BED^PXRMXSD(.PXRMSRT)
QUIT
+5 ;Otherwise option to sort by appt. date
+6 DO SRT^PXRMXSD(.PXRMSRT)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
IF (PXRMSEL="L")&(PXRMINP)&(NLOC>1)
GOTO LCOMB
IF PXRMINP
GOTO TYP
IF (PXRMSEL="O")&($GET(NOTM)>1)
GOTO TCOMB
GOTO FUT
+7 ;
+8 ;Option to print full SSN
SSN IF PXRMREP="D"
Begin DoDot:1
+1 ;IHS/MSC/MGH Modified to use HRCN
+2 ;D SSN^PXRMXSD(.PXRMSSN)
+3 DO SSN^PXRMXSD(.PXRMHRCN)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
IF "IR"[PXRMSEL
GOTO FUT
GOTO SRT
+4 ;
+5 ;Option to print without totals, with totals or totals only
TOT IF PXRMREP="S"
Begin DoDot:1
+1 ;Default is normal report
+2 SET PXRMTOT="I"
+3 ;Ignore patient and patient list reports
+4 IF "RI"[PXRMSEL
QUIT
+5 ;Only prompt if more than one location, team or provider is selected
+6 IF PXRMSEL="P"
IF NPRV<2
QUIT
+7 IF "OT"[PXRMSEL
IF NOTM<2
QUIT
+8 ;Ignore reports for all locations
+9 IF PXRMSEL="L"
IF PXRMLCMB="Y"
QUIT
+10 IF PXRMSEL="L"
NEW DEFAULT,TEXT
DO NLOC
IF NLOC<2
QUIT
+11 ;Prompt for options
+12 NEW LIT1,LIT2,LIT3
+13 DO LIT
DO TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO TYP
+14 ;
SEPCS ;Allow users to determine the output of the Clinic Stops report
+1 DO SEPCS^PXRMXSD(.PXRMCCS)
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
IF PXRMREP="D"
GOTO SSN
GOTO TOT
+2 ;
MLOC ;Print Locations empty location at the end of the report
+1 WRITE !
+2 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Print locations with no patients"
+3 DO ^DIR
+4 IF Y="^^"
GOTO EXIT
+5 IF Y=U
IF $PIECE(PXRMLCSC,U)="CS"
GOTO SEPCS
IF PXRMREP="D"
GOTO SSN
GOTO TOT
+6 SET PXRMPML=Y
+7 ;
DPER ;Print percentage with the report outut
+1 WRITE !
+2 SET DIR(0)="Y"
SET DIR("B")="NO"
+3 SET DIR("A")="Print percentages with the report output"
+4 DO ^DIR
+5 IF Y="^^"
GOTO EXIT
+6 IF Y=U
GOTO MLOC
+7 SET PXRMPER=Y
+8 ;
+9 ;Reminder Category/Individual Reminder Selection
RCAT ;
+1 DO RCAT^PXRMXSU(.PXRMRCAT,.PXRMREM)
IF $DATA(DTOUT)
GOTO EXIT
+2 ;I $D(DUOUT) G:PXRMREP="D" SSN G TOT
+3 IF $DATA(DUOUT)
GOTO MLOC
+4 ;
+5 ;Create combined reminder list
+6 DO MERGE^PXRMXS1
+7 ;
SAV ;Option to create a new report template
+1 IF PXRMTMP=""
DO ^PXRMXTU
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO RCAT
+2 ;
+3 ;Option to print delimiter separated output
TABS Begin DoDot:1
+1 DO TABS^PXRMXSD(.PXRMTABS)
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO SAV
+2 ;Select chracter
TCHAR IF PXRMTABS="Y"
Begin DoDot:1
+1 SET PXRMTABC=$$DELIMSEL^PXRMXSD
End DoDot:1
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO TABS
+2 ;
DPAT ;Ask whether to include deceased and test patients.
+1 SET PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
+2 NEW PXRMIDOD
IF PXRMDPAT>0
SET PXRMIDOD=1
+3 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
GOTO TABS
TPAT ;
+1 SET PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
+2 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
GOTO DPAT
PATLIST ;
+1 KILL PATCREAT
+2 NEW PATLST
+3 IF PXRMSEL'="I"&(PXRMUSER'="Y")
Begin DoDot:1
+4 DO ASK(.PATLST,"Save due patients to a patient list: ",3)
+5 IF $GET(PATLST)=""
QUIT
+6 IF $GET(PATLST)="N"
SET PXRMLIS1=""
QUIT
+7 IF $GET(PATLST)="Y"
Begin DoDot:2
+8 SET PATCREAT="N"
+9 DO ASK(.PATCREAT,"Secure list?: ",3)
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+10 KILL PLISTPUG
+11 SET PLISTPUG="N"
DO ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
End DoDot:2
End DoDot:1
+12 IF $GET(PATLST)=""
IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO TPAT
+13 IF $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
GOTO PATLIST
+14 IF $GET(PATLST)="Y"
SET TEXT="Select PATIENT LIST name: "
DO PLIST^PXRMLCR(.PXRMLIS1,TEXT,"")
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+15 ;Determine whether the report should be queued.
JOB ;
+1 DO JOB^PXRMXQUE
+2 QUIT
+3 ;
+4 ;Option PXRM REMINDERS DUE (USER)
USER NEW PXRMUSER
+1 SET PXRMUSER=+$GET(DUZ)
+2 GOTO START
+3 ;
+4 ;
EXIT ;Clean things up.
+1 DO EXIT^PXRMXGUT
+2 QUIT
+3 ;
+4 ;Check if inpatient report
INP() ;Applies to location reports only
+1 IF PXRMSEL'="L"
QUIT 0
+2 ;For all inpatient locations default is automatic
+3 IF $PIECE(PXRMLCSC,U)="HAI"
QUIT 1
+4 ;For selected locations check if all locations are wards
+5 IF $PIECE(PXRMLCSC,U)="HS"
QUIT $$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
+6 ;Otherwise
+7 QUIT 0
+8 ;
+9 ;Prompt text
LIT NEW LIT
+1 SET LIT=$SELECT(PXRMSEL="P":"Provider","OT"[PXRMSEL:"Team",1:"Location")
+2 IF PXRMFCMB="N"
Begin DoDot:1
+3 SET LIT1="Individual "_LIT_"s only"
+4 SET LIT2="Individual "_LIT_"s plus Totals by Facility"
+5 SET LIT3="Totals by Facility only"
End DoDot:1
+6 IF PXRMFCMB="Y"
Begin DoDot:1
+7 SET LIT1="Individual "_LIT_"s only"
+8 SET LIT2="Individual "_LIT_"s plus Overall Total"
+9 SET LIT3="Overall Total only"
End DoDot:1
+10 QUIT
+11 ;
+12 ;Check if multiple locations
NLOC SET DEFAULT="N"
SET NLOC=1
SET TEXT="Locations"
+1 IF $PIECE(PXRMLCSC,U)["HA"
SET DEFAULT="Y"
SET NLOC=999
+2 IF $PIECE(PXRMLCSC,U)="CA"
SET DEFAULT="Y"
SET NCS=999
+3 IF $EXTRACT(PXRMLCSC)="C"
SET TEXT="Clinic Stops"
SET NLOC=NCS
+4 IF $EXTRACT(PXRMLCSC)="G"
SET TEXT="Clinic Groups"
SET NLOC=NCGRP
+5 IF $PIECE(PXRMLCSC,U)="HS"
SET NLOC=NHL
IF $$INP
SET TEXT="Inpatient Locations"
+6 ;Special coding if more than one facility and location
+7 IF $PIECE(PXRMLCSC,U)="HS"
IF NFAC>1
IF NLOC>1
Begin DoDot:1
+8 NEW FAC,HLOCIEN,HLNAME,IC,MULT
+9 SET IC=0
IF PXRMFCMB="Y"
SET FAC="COMBINED"
+10 ;Build list of locations by facility
+11 FOR
SET IC=$ORDER(PXRMLCHL(IC))
IF 'IC
QUIT
Begin DoDot:2
+12 SET HLOCIEN=$PIECE(PXRMLCHL(IC),U,2)
SET FAC=$$FACL^PXRMXAP(HLOCIEN)
IF 'FAC
QUIT
+13 SET HLNAME=$PIECE(PXRMLCHL(IC),U)
IF HLNAME=""
QUIT
+14 SET MULT(FAC,HLNAME)=""
End DoDot:2
+15 SET MULT=0
SET FAC=0
+16 ;Count locations in each facility
+17 FOR
SET FAC=$ORDER(MULT(FAC))
IF 'FAC
QUIT
Begin DoDot:2
+18 SET IC=0
SET HLNAME=""
+19 FOR
SET HLNAME=$ORDER(MULT(FAC,HLNAME))
IF HLNAME=""
QUIT
SET IC=IC+1
+20 IF IC>1
SET MULT=1
End DoDot:2
IF MULT
QUIT
+21 ;If only one location per facility suppress combined location option
+22 IF 'MULT
SET NLOC=1
End DoDot:1
+23 QUIT
+24 ;
ASK(YESNO,PROMPT,NUM) ;
+1 NEW X,Y,TEXT
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="YA0"
+4 SET DIR("A")=PROMPT
+5 SET DIR("B")="N"
+6 SET DIR("?")="Enter Y or N. For detailed help type ??"
+7 SET DIR("??")=U_"D HELP^PXRMLCR("_NUM_")"
+8 WRITE !
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DIROUT)
SET DTOUT=1
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 SET YESNO=$EXTRACT(Y(0))
+13 QUIT
+14 ;
