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