Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMXD

PXRMXD.m

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