- PXRMXD ;SLC/PJH - Reminder Due reports DRIVER ;08/16/2018
- ;;2.0;CLINICAL REMINDERS;**4,6,12,42**;Feb 04, 2005;Build 245
- ;
- 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
- N PXRMRT,PXRMSSN,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 Separate 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/RR team 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)
- ;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)
- ;
- 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
- .D SSN^PXRMXSD(.PXRMSSN)
- ;
- ;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($G(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 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 character
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXD 10182 printed Jan 18, 2025@02:51:21 Page 2
- PXRMXD ;SLC/PJH - Reminder Due reports DRIVER ;08/16/2018
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,42**;Feb 04, 2005;Build 245
- +2 ;
- 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 NEW PXRMRT,PXRMSSN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
- +13 NEW DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
- +14 NEW PLISTPUG
- +15 NEW PXRMTPAT,PXRMDPAT,PXRMPML,PXRMPER,PXRMCCS,PXRMXCCS,PXRMOWN
- +16 ;
- +17 SET PXRMRT="PXRMX"
- SET PXRMTYP="X"
- SET PXRMFCMB="N"
- SET PXRMLCMB="N"
- SET PXRMTCMB="N"
- +18 SET PXRMCCS=""
- +19 ;
- +20 IF '$DATA(PXRMUSER)
- NEW PXRMUSER
- SET PXRMUSER=0
- +21 ;
- +22 ;Guarantee the timestamp is unique.
- +23 HANG 1
- +24 SET PXRMXST=$$NOW^XLFDT
- +25 SET PXRMXTMP=PXRMRT_PXRMXST
- +26 SET PXRMXCCS=PXRMRT_"SEPCLINIC"_PXRMXST
- +27 SET ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
- +28 SET ^XTMP(PXRMXCCS,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report Separate Clinic Stop"
- +29 ;
- +30 ;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/RR team 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 ;Get the location list.
- +13 IF PXRMSEL="L"
- KILL PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN
- Begin DoDot:1
- +14 DO LOC^PXRMXSU("Determine encounter counts for","HS")
- End DoDot:1
- +15 IF $DATA(DTOUT)
- GOTO EXIT
- +16 IF $DATA(DUOUT)
- if "IRPO"[PXRMSEL
- GOTO SEL
- if NFAC>1
- GOTO COMB
- GOTO FAC
- +17 ;
- +18 ;Check if inpatient location report
- +19 SET PXRMINP=$$INP
- +20 ;
- +21 ; 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 ;
- 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 DO SSN^PXRMXSD(.PXRMSSN)
- End DoDot:1
- if $DATA(DTOUT)
- GOTO EXIT
- IF $DATA(DUOUT)
- if "IR"[PXRMSEL
- GOTO FUT
- GOTO SRT
- +2 ;
- +3 ;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($GET(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 IF $DATA(DUOUT)
- GOTO MLOC
- +3 ;
- +4 ;Create combined reminder list
- +5 DO MERGE^PXRMXS1
- +6 ;
- 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 character
- 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 ;