Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXD.m

    r613 r623  
    1 PXRMXD  ; SLC/PJH - Reminder Due reports DRIVER ;11/27/2006
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4 START   ; Arrays and strings
    5         N PXRMIOD,PXRMXST,PXRMOPT,PXRMQUE,PXRMXTMP,PXRMSEL
    6         N PXRMFAC,PXRMFACN,PXRMSCAT,PXRMSRT,PXRMTYP
    7         N REMINDER,PXRMINP,PXRMFCMB,PXRMLCMB,PXRMTCMB,PXRMTOT
    8         ; Addenda
    9         N PXRMOTM,PXRMPAT,PXRMPCM,PXRMPRV,PXRMTMP,PXRMRCAT,PXRMREM
    10         N PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMLCSC,PXRMCGRP,PXRMCGRN
    11         N PXRMLIS
    12         ; Counters
    13         N NCAT,NFAC,NLOC,NPAT,NPCM,NOTM,NPRV,NREM,NCS,NHL,NCGRP
    14         ; Flags and Dates
    15         N PXRMFD,PXRMSDT,PXRMBDT,PXRMEDT,PXRMREP,PXRMPRIM,PXRMFUT,PXRMDLOC
    16         N PXRMRT,PXRMSSN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
    17         N DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
    18         N PLISTPUG
    19         N PXRMTPAT,PXRMDPAT,PXRMPML
    20         ;
    21         S PXRMRT="PXRMX",PXRMTYP="X",PXRMFCMB="N",PXRMLCMB="N",PXRMTCMB="N"
    22         ;
    23         I '$D(PXRMUSER) N PXRMUSER S PXRMUSER=0
    24         ;
    25         ;Guarantee the timestamp is unique.
    26         H 1
    27         S PXRMXST=$$NOW^XLFDT
    28         S PXRMXTMP=PXRMRT_PXRMXST
    29         S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
    30         ;
    31         ;Check for existing report templates
    32 REP     ;
    33         S PXRMINP=0
    34         D:PXRMUSER ^PXRMXTB D:'PXRMUSER ^PXRMXT I $D(DTOUT)!$D(DUOUT) G EXIT
    35         ;Run report from template details
    36         I PXRMTMP'="" D  G:$D(DUOUT)&'$D(DTOUT) REP Q
    37         .D START^PXRMXTA("JOB^PXRMXQUE") K DUOUT,DIRUT,DTOUT
    38         ;
    39         ;Select sample criteria
    40 SEL     ;
    41         D SELECT^PXRMXSD(.PXRMSEL) I $D(DTOUT) G EXIT
    42         I $D(DUOUT) G:PXRMTMP="" EXIT G REP
    43         ;
    44 FAC     ;Get the facility list.
    45         I "IRPO"'[PXRMSEL D  G:$D(DTOUT) EXIT G:$D(DUOUT) SEL
    46         .D FACILITY^PXRMXSU(.PXRMFAC) Q:$D(DTOUT)!$D(DUOUT)
    47         ;
    48         ;Check if combined facility report is required
    49 COMB    I "IRPO"'[PXRMSEL,NFAC>1 D  G:$D(DTOUT) EXIT G:$D(DUOUT) FAC
    50         .D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
    51         ;
    52 OPT     ;Variable prompts
    53         ;
    54         ;Get Individual Patient list
    55         I PXRMSEL="I" K PXRMPAT D PAT^PXRMXSU(.PXRMPAT)
    56         ;Get Patient list #810.5
    57         I PXRMSEL="R" K PXRMLIST D LIST^PXRMXSU(.PXRMLIST)
    58         ;Get OE/RRteam list
    59         I PXRMSEL="O" K PXRMOTM D OERR^PXRMXSU(.PXRMOTM)
    60         ;Get PCMM team
    61         I PXRMSEL="T" K PXRMPCM D PCMM^PXRMXSU(.PXRMPCM)
    62         ;Get provider list
    63         I PXRMSEL="P" K PXRMPRV D PROV^PXRMXSU(.PXRMPRV)
    64         ;Get the location list.
    65         I PXRMSEL="L" K PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN D
    66         .D LOC^PXRMXSU("Determine encounter counts for","HS")
    67         I $D(DTOUT) G EXIT
    68         I $D(DUOUT) G:"IRPO"[PXRMSEL SEL G:NFAC>1 COMB G FAC
    69         ;
    70         ;Check if inpatient location report
    71         S PXRMINP=$$INP
    72         ;
    73         ; Primary Provider or All (PCMM Provider only)
    74 PRIME   I PXRMSEL="P" D  G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
    75         .D PRIME^PXRMXSD(.PXRMPRIM)
    76         ;
    77 DR      ; Get the date range.
    78         S PXRMFD="P"
    79         ; No prompt if individual patients selected
    80         ; Single dates only if PCMM teams/providers and OE/RR teams selected
    81         ; Choice of previous/future date range if location selected
    82         ;
    83         ; Prior encounters/future appointments (location only)
    84 PREV    I PXRMSEL="L" D PREV^PXRMXSD(.PXRMFD) G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
    85         ; Date range input (location only)
    86         I PXRMSEL="L" D  G:$D(DTOUT) EXIT G:$D(DUOUT) PREV
    87         .I PXRMFD="P" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
    88         .I PXRMFD="F" D FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
    89         .I PXRMFD="A" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
    90         .I PXRMFD="C" S PXRMBDT=DT,PXRMEDT=DT
    91         ; Due Effective Date
    92 DUE     D SDR^PXRMXDUT(.PXRMSDT) G:$D(DTOUT) EXIT
    93         I $D(DUOUT) G:PXRMSEL="L" PREV G OPT
    94         ;
    95 SCAT    ;Get the service categories.
    96         I PXRMSEL="L",PXRMFD="P" D
    97         .D SCAT^PXRMXSC
    98         .I $D(DTOUT)!$D(DUOUT) Q
    99         I $D(DTOUT) G EXIT
    100         I $D(DUOUT) G DUE
    101         ;
    102 TYP     ;Determine type of report (detail/summary)
    103         S PXRMREP="S"
    104         D REP^PXRMXSD(.PXRMREP) I $D(DTOUT) G EXIT
    105         I $D(DUOUT) G SCAT
    106         ;
    107         ;Check if combined location report is required
    108 LCOMB   S NLOC=0
    109         I PXRMREP="D",PXRMSEL="L" D  G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
    110         .N DEFAULT,TEXT
    111         .D NLOC
    112         .I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
    113         ;
    114         ;Check if combined OE/RR team report is required
    115 TCOMB   I PXRMREP="D",PXRMSEL="O",$G(NOTM)>1 D  G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
    116         .N DEFAULT,TEXT
    117         .S DEFAULT="N",TEXT="OE/RR teams"
    118         .D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
    119         ;
    120 FUT     ;For detailed report give option to display future appointments
    121         S PXRMFUT="N"
    122         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
    123         .D FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
    124         .I PXRMFUT="Y" D  Q:$D(DTOUT)!$D(DUOUT)
    125         ..D FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
    126         ;
    127 SRT     ;For detailed report give option to sort by appointment date
    128         S PXRMSRT="N"
    129         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
    130         .;Option to sort by Bed for inpatients
    131         .I PXRMSEL="L",PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
    132         .;Otherwise option to sort by appt. date
    133         .D SRT^PXRMXSD(.PXRMSRT)
    134         ;
    135         ;Option to print full SSN
    136 SSN     I PXRMREP="D" D  G:$D(DTOUT) EXIT I $D(DUOUT) G:"IR"[PXRMSEL FUT G SRT
    137         .D SSN^PXRMXSD(.PXRMSSN)
    138         ;
    139         ;Option to print without totals, with totals or totals only
    140 TOT     I PXRMREP="S" D  G:$D(DTOUT) EXIT I $D(DUOUT) G TYP
    141         .;Default is normal report
    142         .S PXRMTOT="I"
    143         .;Ignore patient and patient list reports
    144         .I "RI"[PXRMSEL Q
    145         .;Only prompt if more than one location, team or provider is selected
    146         .I PXRMSEL="P",NPRV<2 Q
    147         .I "OT"[PXRMSEL,NOTM<2 Q
    148         .;Ignore reports for all locations
    149         .I PXRMSEL="L",PXRMLCMB="Y" Q
    150         .I PXRMSEL="L" N DEFAULT,TEXT D NLOC Q:NLOC<2
    151         .;Prompt for options
    152         .N LIT1,LIT2,LIT3
    153         .D LIT,TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
    154         ;
    155 MLOC        ;Print Locations empty location at the end of the report
    156         W !
    157         S DIR(0)="Y",DIR("B")="YES",DIR("A")="Print locations with no patients"
    158         D ^DIR
    159         I Y="^^" G EXIT
    160         I Y=U G:PXRMREP="D" SSN G TOT
    161         S PXRMPML=Y
    162         ;
    163         ;Reminder Category/Individual Reminder Selection
    164 RCAT    ;
    165         D RCAT^PXRMXSU(.PXRMRCAT,.PXRMREM) I $D(DTOUT) G EXIT
    166         ;I $D(DUOUT) G:PXRMREP="D" SSN G TOT
    167         I $D(DUOUT) G MLOC
    168         ;
    169         ;Create combined reminder list
    170         D MERGE^PXRMXS1
    171         ;
    172 SAV     ;Option to create a new report template
    173         I PXRMTMP="" D ^PXRMXTU G:$D(DTOUT) EXIT I $D(DUOUT) G RCAT
    174         ;
    175         ;Option to print delimiter separated output
    176 TABS    D  G:$D(DTOUT) EXIT I $D(DUOUT) G SAV
    177         .D TABS^PXRMXSD(.PXRMTABS)
    178         ;Select chracter
    179 TCHAR   I PXRMTABS="Y" D  G:$D(DTOUT) EXIT G:$D(DUOUT) TABS
    180         .S PXRMTABC=$$DELIMSEL^PXRMXSD
    181         ;
    182 DPAT    ;Ask whether to include deceased and test patients.
    183         S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
    184         N PXRMIDOD I PXRMDPAT>0 S PXRMIDOD=1
    185         Q:$D(DTOUT)  G:$D(DUOUT) TABS
    186 TPAT    ;
    187         S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
    188         Q:$D(DTOUT)  G:$D(DUOUT) DPAT
    189 PATLIST ;
    190         K PATCREAT
    191         N PATLST
    192         I PXRMSEL'="I"&(PXRMUSER'="Y") D
    193         . D ASK(.PATLST,"Save due patients to a patient list: ",3)
    194         . I $G(PATLST)="" Q
    195         . I $G(PATLST)="N" S PXRMLIS1="" Q
    196         . I $G(PATLST)="Y" D
    197         ..S PATCREAT="N"
    198         ..D ASK(.PATCREAT,"Secure list?: ",3) I $D(DTOUT)!($D(DUOUT)) Q
    199         ..K PLISTPUG
    200         ..S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
    201         I $G(PATLST)="" G:$D(DTOUT) EXIT I $D(DUOUT) G TPAT
    202         G:$D(DTOUT) EXIT I $D(DUOUT) G PATLIST
    203         I $G(PATLST)="Y" S TEXT="Select PATIENT LIST name: " D PLIST^PXRMLCR(.PXRMLIS1,TEXT,"") Q:$D(DUOUT)!$D(DTOUT)
    204         ;Determine whether the report should be queued.
    205 JOB     ;
    206         D JOB^PXRMXQUE
    207         Q
    208         ;
    209         ;Option PXRM REMINDERS DUE (USER)
    210 USER    N PXRMUSER
    211         S PXRMUSER=+$G(DUZ)
    212         G START
    213         ;
    214         ;
    215 EXIT    ;Clean things up.
    216         D EXIT^PXRMXGUT
    217         Q
    218         ;
    219         ;Check if inpatient report
    220 INP()   ;Applies to location reports only
    221         I PXRMSEL'="L" Q 0
    222         ;For all inpatient locations default is automatic
    223         I $P(PXRMLCSC,U)="HAI" Q 1
    224         ;For selected locations check if all locations are wards
    225         I $P(PXRMLCSC,U)="HS" Q $$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
    226         ;Otherwise
    227         Q 0
    228         ;
    229         ;Prompt text
    230 LIT     N LIT
    231         S LIT=$S(PXRMSEL="P":"Provider","OT"[PXRMSEL:"Team",1:"Location")
    232         I PXRMFCMB="N" D
    233         .S LIT1="Individual "_LIT_"s only"
    234         .S LIT2="Individual "_LIT_"s plus Totals by Facility"
    235         .S LIT3="Totals by Facility only"
    236         I PXRMFCMB="Y" D
    237         .S LIT1="Individual "_LIT_"s only"
    238         .S LIT2="Individual "_LIT_"s plus Overall Total"
    239         .S LIT3="Overall Total only"
    240         Q
    241         ;
    242         ;Check if multiple locations
    243 NLOC    S DEFAULT="N",NLOC=1,TEXT="Locations"
    244         I $P(PXRMLCSC,U)["HA" S DEFAULT="Y",NLOC=999
    245         I $P(PXRMLCSC,U)="CA" S DEFAULT="Y",NCS=999
    246         I $E(PXRMLCSC)="C" S TEXT="Clinic Stops",NLOC=NCS
    247         I $E(PXRMLCSC)="G" S TEXT="Clinic Groups",NLOC=NCGRP
    248         I $P(PXRMLCSC,U)="HS" S NLOC=NHL S:$$INP TEXT="Inpatient Locations"
    249         ;Special coding if more than one facility and location
    250         I $P(PXRMLCSC,U)="HS",NFAC>1,NLOC>1 D
    251         .N FAC,HLOCIEN,HLNAME,IC,MULT
    252         .S IC=0 S:PXRMFCMB="Y" FAC="COMBINED"
    253         .;Build list of locations by facility
    254         .F  S IC=$O(PXRMLCHL(IC)) Q:'IC  D
    255         ..S HLOCIEN=$P(PXRMLCHL(IC),U,2),FAC=$$FACL^PXRMXAP(HLOCIEN) Q:'FAC
    256         ..S HLNAME=$P(PXRMLCHL(IC),U) Q:HLNAME=""
    257         ..S MULT(FAC,HLNAME)=""
    258         .S MULT=0,FAC=0
    259         .;Count locations in each facility
    260         .F  S FAC=$O(MULT(FAC)) Q:'FAC  D  Q:MULT
    261         ..S IC=0,HLNAME=""
    262         ..F  S HLNAME=$O(MULT(FAC,HLNAME)) Q:HLNAME=""  S IC=IC+1
    263         ..I IC>1 S MULT=1
    264         .;If only one location per facility suppress combined location option
    265         .I 'MULT S NLOC=1
    266         Q
    267         ;
    268 ASK(YESNO,PROMPT,NUM)        ;
    269         N X,Y,TEXT
    270         K DIROUT,DIRUT,DTOUT,DUOUT
    271         S DIR(0)="YA0"
    272         S DIR("A")=PROMPT
    273         S DIR("B")="N"
    274         S DIR("?")="Enter Y or N. For detailed help type ??"
    275         S DIR("??")=U_"D HELP^PXRMLCR("_NUM_")"
    276         W !
    277         D ^DIR K DIR
    278         I $D(DIROUT) S DTOUT=1
    279         I $D(DTOUT)!($D(DUOUT)) Q
    280         S YESNO=$E(Y(0))
    281         Q
    282         ;
     1PXRMXD ; SLC/PJH - Reminder Due reports DRIVER ;06/20/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4START ; Arrays and strings
     5 N PXRMIOD,PXRMXST,PXRMOPT,PXRMQUE,PXRMXTMP,PXRMSEL
     6 N PXRMFAC,PXRMFACN,PXRMSCAT,PXRMSRT,PXRMTYP
     7 N REMINDER,PXRMINP,PXRMFCMB,PXRMLCMB,PXRMTCMB,PXRMTOT
     8 ; Addenda
     9 N PXRMOTM,PXRMPAT,PXRMPCM,PXRMPRV,PXRMTMP,PXRMRCAT,PXRMREM
     10 N PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMLCSC,PXRMCGRP,PXRMCGRN
     11 N PXRMLIS
     12 ; Counters
     13 N NCAT,NFAC,NLOC,NPAT,NPCM,NOTM,NPRV,NREM,NCS,NHL,NCGRP
     14 ; Flags and Dates
     15 N PXRMFD,PXRMSDT,PXRMBDT,PXRMEDT,PXRMREP,PXRMPRIM,PXRMFUT,PXRMDLOC
     16 N PXRMRT,PXRMSSN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
     17 N DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
     18 N PLISTPUG
     19 N PXRMTPAT,PXRMDPAT
     20 ;
     21 S PXRMRT="PXRMX",PXRMTYP="X",PXRMFCMB="N",PXRMLCMB="N",PXRMTCMB="N"
     22 ;
     23 I '$D(PXRMUSER) N PXRMUSER S PXRMUSER=0
     24 ;
     25 ;Guarantee the timestamp is unique.
     26 H 1
     27 S PXRMXST=$$NOW^XLFDT
     28 S PXRMXTMP=PXRMRT_PXRMXST
     29 S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
     30 ;
     31 ;Check for existing report templates
     32REP ;
     33 S PXRMINP=0
     34 D:PXRMUSER ^PXRMXTB D:'PXRMUSER ^PXRMXT I $D(DTOUT)!$D(DUOUT) G EXIT
     35 ;Run report from template details
     36 I PXRMTMP'="" D  G:$D(DUOUT)&'$D(DTOUT) REP Q
     37 .D START^PXRMXTA("JOB^PXRMXQUE") K DUOUT,DIRUT,DTOUT
     38 ;
     39 ;Select sample criteria
     40SEL ;
     41 D SELECT^PXRMXSD(.PXRMSEL) I $D(DTOUT) G EXIT
     42 I $D(DUOUT) G:PXRMTMP="" EXIT G REP
     43 ;
     44FAC ;Get the facility list.
     45 I "IRPO"'[PXRMSEL D  G:$D(DTOUT) EXIT G:$D(DUOUT) SEL
     46 .D FACILITY^PXRMXSU(.PXRMFAC) Q:$D(DTOUT)!$D(DUOUT)
     47 ;
     48 ;Check if combined facility report is required
     49COMB I "IRPO"'[PXRMSEL,NFAC>1 D  G:$D(DTOUT) EXIT G:$D(DUOUT) FAC
     50 .D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
     51 ;
     52OPT ;Variable prompts
     53 ;
     54 ;Get Individual Patient list
     55 I PXRMSEL="I" K PXRMPAT D PAT^PXRMXSU(.PXRMPAT)
     56 ;Get Patient list #810.5
     57 I PXRMSEL="R" K PXRMLIST D LIST^PXRMXSU(.PXRMLIST)
     58 ;Get OE/RRteam list
     59 I PXRMSEL="O" K PXRMOTM D OERR^PXRMXSU(.PXRMOTM)
     60 ;Get PCMM team
     61 I PXRMSEL="T" K PXRMPCM D PCMM^PXRMXSU(.PXRMPCM)
     62 ;Get provider list
     63 I PXRMSEL="P" K PXRMPRV D PROV^PXRMXSU(.PXRMPRV)
     64 ;Get the location list.
     65 I PXRMSEL="L" K PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN D
     66 .D LOC^PXRMXSU("Determine encounter counts for","HS")
     67 I $D(DTOUT) G EXIT
     68 I $D(DUOUT) G:"IRPO"[PXRMSEL SEL G:NFAC>1 COMB G FAC
     69 ;
     70 ;Check if inpatient location report
     71 S PXRMINP=$$INP
     72 ;
     73 ; Primary Provider or All (PCMM Provider only)
     74PRIME I PXRMSEL="P" D  G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
     75 .D PRIME^PXRMXSD(.PXRMPRIM)
     76 ;
     77DR ; Get the date range.
     78 S PXRMFD="P"
     79 ; No prompt if individual patients selected
     80 ; Single dates only if PCMM teams/providers and OE/RR teams selected
     81 ; Choice of previous/future date range if location selected
     82 ;
     83 ; Prior encounters/future appointments (location only)
     84PREV I PXRMSEL="L" D PREV^PXRMXSD(.PXRMFD) G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
     85 ; Date range input (location only)
     86 I PXRMSEL="L" D  G:$D(DTOUT) EXIT G:$D(DUOUT) PREV
     87 .I PXRMFD="P" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
     88 .I PXRMFD="F" D FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
     89 .I PXRMFD="A" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
     90 .I PXRMFD="C" S PXRMBDT=DT,PXRMEDT=DT
     91 ; Due Effective Date
     92DUE D SDR^PXRMXDUT(.PXRMSDT) G:$D(DTOUT) EXIT
     93 I $D(DUOUT) G:PXRMSEL="L" PREV G OPT
     94 ;
     95SCAT ;Get the service categories.
     96 I PXRMSEL="L",PXRMFD="P" D
     97 .D SCAT^PXRMXSC
     98 .I $D(DTOUT)!$D(DUOUT) Q
     99 I $D(DTOUT) G EXIT
     100 I $D(DUOUT) G DUE
     101 ;
     102TYP ;Determine type of report (detail/summary)
     103 S PXRMREP="S"
     104 D REP^PXRMXSD(.PXRMREP) I $D(DTOUT) G EXIT
     105 I $D(DUOUT) G SCAT
     106 ;
     107 ;Check if combined location report is required
     108LCOMB S NLOC=0
     109 I PXRMREP="D",PXRMSEL="L" D  G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
     110 .N DEFAULT,TEXT
     111 .D NLOC
     112 .I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
     113 ;
     114 ;Check if combined OE/RR team report is required
     115TCOMB I PXRMREP="D",PXRMSEL="O",$G(NOTM)>1 D  G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
     116 .N DEFAULT,TEXT
     117 .S DEFAULT="N",TEXT="OE/RR teams"
     118 .D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
     119 ;
     120FUT ;For detailed report give option to display future appointments
     121 S PXRMFUT="N"
     122 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
     123 .D FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
     124 .I PXRMFUT="Y" D  Q:$D(DTOUT)!$D(DUOUT)
     125 ..D FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
     126 ;
     127SRT ;For detailed report give option to sort by appointment date
     128 S PXRMSRT="N"
     129 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
     130 .;Option to sort by Bed for inpatients
     131 .I PXRMSEL="L",PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
     132 .;Otherwise option to sort by appt. date
     133 .D SRT^PXRMXSD(.PXRMSRT)
     134 ;
     135 ;Option to print full SSN
     136SSN I PXRMREP="D" D  G:$D(DTOUT) EXIT I $D(DUOUT) G:"IR"[PXRMSEL FUT G SRT
     137 .D SSN^PXRMXSD(.PXRMSSN)
     138 ;
     139 ;Option to print without totals, with totals or totals only
     140TOT I PXRMREP="S" D  G:$D(DTOUT) EXIT I $D(DUOUT) G TYP
     141 .;Default is normal report
     142 .S PXRMTOT="I"
     143 .;Ignore patient and patient list reports
     144 .I "RI"[PXRMSEL Q
     145 .;Only prompt if more than one location, team or provider is selected
     146 .I PXRMSEL="P",NPRV<2 Q
     147 .I "OT"[PXRMSEL,NOTM<2 Q
     148 .;Ignore reports for all locations
     149 .I PXRMSEL="L",PXRMLCMB="Y" Q
     150 .I PXRMSEL="L" N DEFAULT,TEXT D NLOC Q:NLOC<2
     151 .;Prompt for options
     152 .N LIT1,LIT2,LIT3
     153 .D LIT,TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
     154 ;
     155 ;Reminder Category/Individual Reminder Selection
     156RCAT ;
     157 D RCAT^PXRMXSU(.PXRMRCAT,.PXRMREM) I $D(DTOUT) G EXIT
     158 I $D(DUOUT) G:PXRMREP="D" SSN G TOT
     159 ;
     160 ;Create combined reminder list
     161 D MERGE^PXRMXS1
     162 ;
     163SAV ;Option to create a new report template
     164 I PXRMTMP="" D ^PXRMXTU G:$D(DTOUT) EXIT I $D(DUOUT) G RCAT
     165 ;
     166 ;Option to print delimiter separated output
     167TABS D  G:$D(DTOUT) EXIT I $D(DUOUT) G SAV
     168 .D TABS^PXRMXSD(.PXRMTABS)
     169 ;Select chracter
     170TCHAR I PXRMTABS="Y" D  G:$D(DTOUT) EXIT G:$D(DUOUT) TABS
     171 .S PXRMTABC=$$DELIMSEL^PXRMXSD
     172 ;
     173DPAT ;Ask whether to include deceased and test patients.
     174 S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
     175 N PXRMIDOD I PXRMDPAT>0 S PXRMIDOD=1
     176 Q:$D(DTOUT)  G:$D(DUOUT) TABS
     177TPAT ;
     178 S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
     179 Q:$D(DTOUT)  G:$D(DUOUT) DPAT
     180PATLIST ;
     181 K PATCREAT
     182 N PATLST
     183 I PXRMSEL'="I"&(PXRMUSER'="Y") D
     184 . D ASK(.PATLST,"Save due patients to a patient list: ",3)
     185 . I $G(PATLST)="" Q
     186 . I $G(PATLST)="N" S PXRMLIS1="" Q
     187 . I $G(PATLST)="Y" D
     188 ..S PATCREAT="N"
     189 ..D ASK(.PATCREAT,"Secure list?: ",3) I $D(DTOUT)!($D(DUOUT)) Q
     190 ..K PLISTPUG
     191 ..S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
     192 I $G(PATLST)="" G:$D(DTOUT) EXIT I $D(DUOUT) G TPAT
     193 G:$D(DTOUT) EXIT I $D(DUOUT) G PATLIST
     194 I $G(PATLST)="Y" S TEXT="Select PATIENT LIST name: " D PLIST^PXRMLCR(.PXRMLIS1,TEXT,"") Q:$D(DUOUT)!$D(DTOUT)
     195 ;Determine whether the report should be queued.
     196JOB ;
     197 D JOB^PXRMXQUE
     198 Q
     199 ;
     200 ;Option PXRM REMINDERS DUE (USER)
     201USER N PXRMUSER
     202 S PXRMUSER=+$G(DUZ)
     203 G START
     204 ;
     205 ;
     206EXIT ;Clean things up.
     207 D EXIT^PXRMXGUT
     208 Q
     209 ;
     210 ;Check if inpatient report
     211INP() ;Applies to location reports only
     212 I PXRMSEL'="L" Q 0
     213 ;For all inpatient locations default is automatic
     214 I $P(PXRMLCSC,U)="HAI" Q 1
     215 ;For selected locations check if all locations are wards
     216 I $P(PXRMLCSC,U)="HS" Q $$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
     217 ;Otherwise
     218 Q 0
     219 ;
     220 ;Prompt text
     221LIT N LIT
     222 S LIT=$S(PXRMSEL="P":"Provider","OT"[PXRMSEL:"Team",1:"Location")
     223 I PXRMFCMB="N" D
     224 .S LIT1="Individual "_LIT_"s only"
     225 .S LIT2="Individual "_LIT_"s plus Totals by Facility"
     226 .S LIT3="Totals by Facility only"
     227 I PXRMFCMB="Y" D
     228 .S LIT1="Individual "_LIT_"s only"
     229 .S LIT2="Individual "_LIT_"s plus Overall Total"
     230 .S LIT3="Overall Total only"
     231 Q
     232 ;
     233 ;Check if multiple locations
     234NLOC S DEFAULT="N",NLOC=1,TEXT="Locations"
     235 I $P(PXRMLCSC,U)["HA" S DEFAULT="Y",NLOC=999
     236 I $P(PXRMLCSC,U)="CA" S DEFAULT="Y",NCS=999
     237 I $E(PXRMLCSC)="C" S TEXT="Clinic Stops",NLOC=NCS
     238 I $E(PXRMLCSC)="G" S TEXT="Clinic Groups",NLOC=NCGRP
     239 I $P(PXRMLCSC,U)="HS" S NLOC=NHL S:$$INP TEXT="Inpatient Locations"
     240 ;Special coding if more than one facility and location
     241 I $P(PXRMLCSC,U)="HS",NFAC>1,NLOC>1 D
     242 .N FAC,HLOCIEN,HLNAME,IC,MULT
     243 .S IC=0 S:PXRMFCMB="Y" FAC="COMBINED"
     244 .;Build list of locations by facility
     245 .F  S IC=$O(PXRMLCHL(IC)) Q:'IC  D
     246 ..S HLOCIEN=$P(PXRMLCHL(IC),U,2),FAC=$$FACL^PXRMXAP(HLOCIEN) Q:'FAC
     247 ..S HLNAME=$P(PXRMLCHL(IC),U) Q:HLNAME=""
     248 ..S MULT(FAC,HLNAME)=""
     249 .S MULT=0,FAC=0
     250 .;Count locations in each facility
     251 .F  S FAC=$O(MULT(FAC)) Q:'FAC  D  Q:MULT
     252 ..S IC=0,HLNAME=""
     253 ..F  S HLNAME=$O(MULT(FAC,HLNAME)) Q:HLNAME=""  S IC=IC+1
     254 ..I IC>1 S MULT=1
     255 .;If only one location per facility suppress combined location option
     256 .I 'MULT S NLOC=1
     257 Q
     258 ;
     259ASK(YESNO,PROMPT,NUM)      ;
     260 N X,Y,TEXT
     261 K DIROUT,DIRUT,DTOUT,DUOUT
     262 S DIR(0)="YA0"
     263 S DIR("A")=PROMPT
     264 S DIR("B")="N"
     265 S DIR("?")="Enter Y or N. For detailed help type ??"
     266 S DIR("??")=U_"D HELP^PXRMLCR("_NUM_")"
     267 W !
     268 D ^DIR K DIR
     269 I $D(DIROUT) S DTOUT=1
     270 I $D(DTOUT)!($D(DUOUT)) Q
     271 S YESNO=$E(Y(0))
     272 Q
     273 ;
Note: See TracChangeset for help on using the changeset viewer.