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

PXRMXTA.m

Go to the documentation of this file. 
  1. PXRMXTA ; SLC/PJH - Reminder Reports Template Edit ;23-Mar-2015 10:42;DU
  1.  ;;2.0;CLINICAL REMINDERS;**4,1001,12,26,1005**;Feb 04, 2005;Build 23
  1.  ;IHS/MSC/MGH Patch 1001 added data for IHS primary provider
  1.  ;
  1.  ; Called from PXRMYD,PXRMXD
  1.  ;
  1.  ;Edit selected template or run report
  1.  ;-------------------------------------
  1. CANEDIT(TIEN) ;
  1.  I $P($G(^PXRMPT(810.1,TIEN,0)),U,11)=DUZ Q 1
  1.  I $D(^XUSEC("PXRM MANAGER",DUZ)) Q 1
  1.  Q 0
  1.  ;
  1. START(ROUTINE) ;
  1.  N DA,PXRMASK,PXRMEDIT,PXRMCOPY,MSG,DIC,NLOC
  1.  N PXRMTREM,PXRMTCAT
  1.  S PXRMASK="N",PXRMCOPY="N",PXRMEDIT="N"
  1.  ;Option to edit/copy template
  1. USE I 'PXRMUSER,$$CANEDIT($P(PXRMTMP,U)) D ASK(.PXRMASK) Q:$D(DUOUT)!$D(DTOUT)
  1.  ;Option to edit template
  1.  I PXRMASK="Y" D  Q:$D(DUOUT)!$D(DTOUT)
  1.  .;Template edit and redisplay
  1.  .D LOCK Q:$D(DUOUT)
  1.  .D EDIT^PXRMXTE,UNLOCK
  1.  .;Rollback changes on exit
  1.  .I $D(DUOUT)!$D(DTOUT) D  Q
  1.  ..D ROLL^PXRMXTF
  1.  .;If all the templates have been deleted exit report
  1.  .I '$$FIND^PXRMXT(PXRMTYP) S DTOUT=1 Q
  1.  .;Check if template has been deleted
  1.  .I '$D(DA) S DUOUT=1 Q
  1.  .;Sort out the filing
  1.  .D ^PXRMXTF I $D(MSG) S DUOUT=1 Q
  1.  ;
  1. CHECK ;Check for missing fields
  1.  N CNT,CRCNT,NODE,QUIT,RIEN
  1.  S CNT=0,QUIT=0
  1.  I PXRMSEL="R" F  S CNT=$O(PXRMLIST(CNT)) Q:CNT'>0  D
  1.  .S NODE=$G(PXRMLIST(CNT))
  1.  .I $P(^PXRMXP(810.5,$P(NODE,U),30,0),U,3)'>0 S QUIT=1 W !!,"PATIENT LIST: "_$P(NODE,U,2)_"DOES NOT CONTAIN PATIENTS!" Q
  1.  ;I PXRMSEL="O" F  S CNT=$O(PXRMOTM(CNT)) Q:CNT'>0  D
  1.  ;.S NODE=$G(PXRMOTM(CNT))
  1.  ;.I $P(^OR(100.21,$P(NODE,U),10,0),U,3)'>0 S QUIT=1 W !!,"OE/RR TEAM: "_$P(NODE,U,2)_"DOES NOT CONTAIN PATIENTS!" Q
  1.  S CNT=0
  1.  I $D(PXRMRCAT)>0 F  S CNT=$O(PXRMRCAT(CNT)) Q:CNT'>0  D
  1.  .S NODE=$G(PXRMRCAT(CNT))
  1.  .S CRCNT=0 F  S CRCNT=$O(^PXRMD(811.7,$P(NODE,U),2,CRCNT)) Q:CRCNT'>0  D
  1.  ..S RIEN=$P($G(^PXRMD(811.7,$P(NODE,U),2,CRCNT,0)),U)
  1.  ..I $D(^PXD(811.9,RIEN))'>0 S QUIT=1 D
  1.  ...W !!,"REMINDER CATEGORY: "_$P(NODE,U,2)_" CONTAINS A POINTER TO ONE OR MORE REMINDERS THAT DO"
  1.  ...W !,"NOT EXIST ON THE SYSTEM!" Q
  1.  I QUIT=1,'PXRMUSER W !!,"THE TEMPLATE NEEDS TO BE EDITED." H 2 G USE
  1.  I QUIT=1,PXRMUSER W !!,"HAVE THE REMINDERS CLINICAL APPLICATION COORDINATOR CORRECT THE TEMPLATE." H 2 Q
  1.  ;
  1. FAC ;Option to combine multifacility report
  1.  I "IRPO"'[PXRMSEL,NFAC>1 D  Q:$D(DTOUT)  I $D(DUOUT) Q:PXRMUSER  G USE
  1.  .D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
  1.  ;
  1.  ;Date range input (location only)
  1. DAT I PXRMSEL="L" D  Q:$D(DTOUT)  I $D(DUOUT) Q:PXRMUSER  G USE
  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. EFF D SDR^PXRMXDUT(.PXRMSDT) Q:$D(DTOUT)
  1.  I $D(DUOUT) G:PXRMSEL="L" DAT Q:PXRMUSER  G USE
  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) EFF
  1.  .N DEFAULT,TEXT
  1.  .D NLOC^PXRMXD
  1.  .I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
  1.  ;
  1.  ;Check if combined OE/RR team report is required
  1. TCOMB S NOTM=0
  1.  I PXRMREP="D",PXRMSEL="O" D  G:$D(DTOUT) EXIT G:$D(DUOUT) EFF
  1.  .N DEFAULT,TEXT
  1.  .S NOTM=$O(PXRMOTM(""),-1) I NOTM<2 Q
  1.  .S DEFAULT="N",TEXT="OE/RR teams"
  1.  .D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
  1.  ;
  1.  ;Reminders Due sort and appointment date options
  1. APPT I PXRMREP="D" D FUT Q:$D(DTOUT)  I $D(DUOUT) G:(PXRMSEL="L")&(NLOC>1) LCOMB G:(PXRMSEL="O")&(NOTM>1) TCOMB G EFF
  1.  ;
  1.  ;
  1.  ;Option to print full SSN
  1. SSN I PXRMREP="D" D  G:$D(DTOUT) EXIT G:$D(DUOUT) APPT
  1.  .;IHS/MSC/MGH Patch 1001 Use HRCN
  1.  .;D SSN^PXRMXSD(.PXRMSSN)
  1.  .D SSN^PXRMXSD(.PXRMHRCN)
  1.  ;
  1.  ;Option to print without totals, with totals or totals only
  1. TOT I PXRMREP="S" D  Q:$D(DTOUT)  I $D(DUOUT) G EFF
  1.  .;Default is normal report
  1.  .S PXRMTOT="I"
  1.  .;Ignore patient list and individual patient options
  1.  .I "RI"[PXRMSEL Q
  1.  .;Only prompt if more than one location, team or provider is selected
  1.  .I PXRMSEL="P",'$O(PXRMPRV(1)) Q
  1.  .I PXRMSEL="O",'$O(PXRMOTM(1)) Q
  1.  .I PXRMSEL="T",'$O(PXRMPCM(1)) Q
  1.  .;Ignore reports for all locations
  1.  .I PXRMSEL="L",PXRMLCMB="Y" Q
  1.  .I PXRMSEL="L" N DEFAULT,TEXT D NLOC^PXRMXD Q:NLOC<2
  1.  .;Prompt for options
  1.  .N LIT1,LIT2,LIT3
  1.  .D LIT^PXRMXD,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.  ;Option to print delimiter separated output
  1. TABS D  G:$D(DTOUT) EXIT I $D(DUOUT) G:PXRMREP="D" SSN G TOT
  1.  .D TABS^PXRMXSD(.PXRMTABS)
  1.  ;
  1.  ;Select chracter
  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.  N PATLST,PATCREAT
  1.  I PXRMSEL'="I"&(PXRMUSER=0) D
  1.  . D ASK^PXRMXD(.PATLST,"Save due patients to a patient list: ",3)
  1.  . I $G(PATLST)="" Q
  1.  . I $G(PATLST)="N" S PXRMLIS1=""
  1.  . I $G(PATLST)="Y" D
  1.  . . S PATCREAT="N" D ASK^PXRMXD(.PATCREAT,"Secure list?: ",2)
  1.  . . Q:$D(DTOUT)!($D(DUOUT))
  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.  ;Initiate report
  1.  D @ROUTINE
  1. EXIT Q
  1.  ;
  1.  ;File locking
  1.  ;------------
  1. UNLOCK L -^PXRMPT(810.1,$P(PXRMTMP,U)) Q
  1. LOCK L +^PXRMPT(810.1,$P(PXRMTMP,U)):DILOCKTM
  1.  E  W !!?5,"Another user is editing this entry" S DUOUT=1
  1.  Q
  1.  ;
  1.  ;Option to use report template
  1.  ;-----------------------------
  1. ASK(YESNO) ;
  1.  N X,Y,TEXT
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="WANT TO EDIT '"_$P(PXRMTMP,U,2)_"' TEMPLATE: "
  1.  S DIR("B")="N"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMXTA(1)"
  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.  ;
  1.  ;General help text routine. Write out the text in the HTEXT array
  1.  ;----------------------------------------------------------------
  1. HELP(CALL) ;
  1.  N HTEXT
  1.  N DIWF,DIWL,DIWR,IC
  1.  S DIWF="C70",DIWL=0,DIWR=70
  1.  ;
  1.  I CALL=1 D
  1.  .S HTEXT(1)="Enter 'N' to run the report using the parameters from "
  1.  .S HTEXT(2)="the existing template. Enter 'Y' to copy/edit the "
  1.  .S HTEXT(3)="template."
  1.  ;
  1.  K ^UTILITY($J,"W")
  1.  S IC=""
  1.  F  S IC=$O(HTEXT(IC)) Q:IC=""  D
  1.  . S X=HTEXT(IC)
  1.  . D ^DIWP
  1.  W !
  1.  S IC=0
  1.  F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D
  1.  . W !,^UTILITY($J,"W",0,IC,0)
  1.  K ^UTILITY($J,"W")
  1.  W !
  1.  Q
  1.  ;
  1.  ;Reminders Due specific prompts
  1.  ;------------------------------
  1. FUT ;For detailed report give option to display future appointments
  1.  S PXRMFUT="N",PXRMDLOC="N"
  1.  I PXRMREP="D" D  Q:$D(DTOUT)!$D(DUOUT)
  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",(PXRMSEL'="I") D  G:$D(DUOUT) FUT
  1.  .;Inpatient report
  1.  .S PXRMINP=$$INP^PXRMXD
  1.  .;Option to sort by bed
  1.  .I PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
  1.  .;Option to sort by appt date
  1.  .D SRT^PXRMXSD(.PXRMSRT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;Input validation for file #810.1
  1.  ;
  1.  ;If detail report allow only one reminder
  1. PXRMREM I $P(^PXRMPT(810.1,DA(1),0),U,6)'="D" Q
  1.  ;If template has no reminders ignore
  1.  I +$P($G(^PXRMPT(810.1,DA(1),1,0)),U,4)=0 Q
  1.  ;If this a new entry
  1.  I $G(Y)=-1 K X W !,"Only one reminder allowed for detailed report."
  1.  Q
  1.  ;
  1.  ;If changing from Summary to Detail report
  1. PXRMREP Q:$G(X)'="D"
  1.  Q:$P($G(^PXRMPT(810.1,DA,0)),U,6)'="S"
  1.  Q:+$G(NREM)<2
  1.  W !,"Only the first reminder on this template will be evaluated"
  1.  Q