BSDNS2 ; IHS/ANMC/LJF - FREQUENT NO-SHOWS ;
;;5.3;PIMS;**1010**;APR 26, 2002
;
ASK ; ask user questions
NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,Y,BSDSEEN
N BSDCP,BSDP,BSDPCNT
D CLINIC^BSDU(2) Q:$D(BSDQ)
;
;cmi/maw patch 1010 possibility to ask for patient in later patch
; get clinic arrays
;S BSDCP=$$READ^BDGF("S^C:Clinic;P:Patient","Select Clinic or Patient","Clinic") ;cmi/maw PATCH 1010
;Q:BSDCP=U ;cmi/maw PATCH 1010
;
;I BSDCP="C" D CLINIC^BSDU(2) Q:$D(BSDQ)
;I BSDCP="P" D
;. S VAUTC=1
;. S BSDP=$$READ^BDGF("S^A:All Patients;I:Individual Patients","All or Individual Patients","All")
;. Q:BSDP=U
;. I BSDP="I" S BSDPCNT=0 D PAT
;I BSDCP="P" Q:'$D(BSDP(1))
;
S BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search") Q:'BSDBD
S BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search") Q:'BSDED
;
S BSDLMT=$$READ^BDGF("N^1:99","Number of No-Shows that defines Frequent","","^D HELP1^BSDNS2") Q:BSDLMT="" Q:BSDLMT=U
;
S BSDMODE=$$READ^BDGF("S^F:Facility;P:Principal Clinic;C:Clinic;N:Patient;O:Clinic Code","No-Show Limit based on which category","","^D HELP2^BSDNS2") Q:BSDMODE="" Q:BSDMODE=U ;cmi/maw PATCH 1010 RQMT 1
;
S BSDINFO=$$READ^BDGF("YO","Display Appt. Other Info","NO","^D HELP3^BSDNS2") Q:BSDINFO=U
;
S Y=$$BROWSE^BDGF Q:"PB"'[Y I Y="B" D EN Q ;browse in list mgr mode
D ZIS^BDGF("PQ","START^BSDNS2","FREQ NO-SHOWS","BSDINFO;BSDLMT;BSDMODE;BSDBD;BSDED;VAUTC*;VAUTD*")
Q
;
PAT ;-- select patients to show or all
S DIC=9000001,DIC("A")="Select Patient: ",DIC(0)="AEMQZ"
D ^DIC
S BSDP=+Y
Q:Y<0
S BSDPCNT=BSDPCNT+1
S BSDP(BSDPCNT)=+BSDP
G PAT
Q
;
START ;EP; -- re-entry for printing to paper
D INIT,PRINT Q
;
EN ; -- main entry point for BSDRM FREQUENT NOSHOWS
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDRM FREQUENT NOSHOWS")
D CLEAR^VALM1
Q
;
HDR ; -- header code
S VALMHDR(1)=$$SP(15)_$$CONF^BSDU
S VALMHDR(2)=$$SP(11)_"For appointments between "_$$FMTE^XLFDT(BSDBD)
S VALMHDR(2)=VALMHDR(2)_" and "_$$FMTE^XLFDT(BSDED)
S VALMHDR(3)=$$SP(13)_"Patients with at least "_BSDLMT_" no-shows "_$$MODEMSG(BSDMODE)
Q
;
INIT ; -- init variables and list array
S VALMCNT=0 K ^TMP("BSDNS2",$J),^TMP("BSDNS21",$J)
NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
;
; -- loop by clinic
NEW CLN,PC,APPT,IEN,CLNM,PATNM,DFN,X,NOSHOWS
S CLN=0 F S CLN=$O(@BSDAR@(CLN)) Q:'CLN D
. Q:$D(^SC("AIHSPC",CLN)) ;quit if principal clinic
. S PC=$$PRIN^BSDU(CLN) ;principal clinic name
. S CLNM=$$GET1^DIQ(44,CLN,.01) ;clinic's name
. ;
. ; now loop by date to find no-shows
. ; loop backwards to find most recent no-show
. S APPT=BSDED+.24,END=BSDBD
. F S APPT=$O(^SC(CLN,"S",APPT),-1) Q:'APPT Q:APPT<BSDBD D
.. S IEN=0 F S IEN=$O(^SC(CLN,"S",APPT,1,IEN)) Q:'IEN D
... S DFN=+^SC(CLN,"S",APPT,1,IEN,0) ;pat ien
... ; quit if not a no-show
... S X=$P($G(^DPT(DFN,"S",APPT,0)),U,2) Q:X="NT" Q:X'["N"
... S PATNM=$$GET1^DIQ(2,DFN,.01) ;pat name
... Q:$D(^TMP("BSDNS21",$J,PC,CLNM,PATNM,DFN)) ;patient already done
... ;
... S NOSHOWS=$$PDATA(DFN,CLN,APPT,BSDED) ;count no-shows for pat
... Q:'$$LIMIT(NOSHOWS,BSDLMT,BSDMODE) ;quit if not within limit
... I BSDMODE'="N" S ^TMP("BSDNS21",$J,PC,CLNM,PATNM,DFN)=NOSHOWS_U_APPT
... I BSDMODE="N" S ^TMP("BSDNS21",$J,PATNM,DFN,CLNM)=NOSHOWS_U_APPT ;cmi/maw PATCH 1010 RQMT 1
;
; put sorted list into display array
;below will be by clinic cmi/maw PATCH 1010 RQMT 1
I BSDMODE'="N" D BYPC Q
I BSDMODE="N" D BYPAT Q
Q
;
BYPC ;-- sort everything by clinic
NEW LINE,COUNTS
S PC=0 F S PC=$O(^TMP("BSDNS21",$J,PC)) Q:PC="" D
. S LINE=$$PAD("Principal Clinic: "_PC,45)_" ("_$$LMT(PC)_")"
. D SET(LINE,.VALMCNT)
. ;
. S CLNM=0 F S CLNM=$O(^TMP("BSDNS21",$J,PC,CLNM)) Q:CLNM="" D
.. S LINE=" "_CLNM_" ("_$$LMT(CLNM)_")" ;clinic name
.. D SET("",.VALMCNT),SET(LINE,.VALMCNT)
.. ;
.. S PATNM=0
.. F S PATNM=$O(^TMP("BSDNS21",$J,PC,CLNM,PATNM)) Q:PATNM="" D
... S DFN=0
... F S DFN=$O(^TMP("BSDNS21",$J,PC,CLNM,PATNM,DFN)) Q:'DFN D
.... S COUNTS=^TMP("BSDNS21",$J,PC,CLNM,PATNM,DFN) ;no-show counts
.... S LINE=$$PAD($$SP(2)_PATNM,18)_$J($$HRCN^BDGF2(DFN,+$G(DUZ(2))),7)
.... S LINE=$$PAD($$PAD(LINE,30)_$P(COUNTS,U,4),53) ;last noshow dt
.... F I=3,2,1 S LINE=LINE_$J($P(COUNTS,U,I),8)
.... D SET(LINE,.VALMCNT)
.... I BSDINFO D SET($$SP(15)_$P(COUNTS,U,5),.VALMCNT)
. D SET("",.VALMCNT)
;
;K ^TMP("BSDNS21",$J)
Q
;
BYPAT ;-- sort by patient
NEW LINE,COUNTS
S PAT=0 F S PAT=$O(^TMP("BSDNS21",$J,PAT)) Q:PAT="" D
. S LINE=$$PAD("Patient Name: "_$E(PAT,1,20)_" Chart: "_$$HRCN^BDGF2($O(^TMP("BSDNS21",$J,PAT,0)),+$G(DUZ(2))),57)_" ("_$$LMT(PAT)_")"
. D SET(LINE,.VALMCNT)
. ;
. S DFN=0 F S DFN=$O(^TMP("BSDNS21",$J,PAT,DFN)) Q:DFN="" D
.. S CLNNM=0
.. F S CLNNM=$O(^TMP("BSDNS21",$J,PAT,DFN,CLNNM)) Q:CLNNM="" D
... S COUNTS=^TMP("BSDNS21",$J,PAT,DFN,CLNNM) ;no-show counts
... S LINE=$$PAD($$SP(2)_CLNNM,18)
... S LINE=$$PAD($$PAD(LINE,30)_$P(COUNTS,U,4),53) ;last noshow dt
... F I=3,2,1 S LINE=LINE_$J($P(COUNTS,U,I),8)
... D SET(LINE,.VALMCNT)
... I BSDINFO D SET($$SP(15)_$P(COUNTS,U,5),.VALMCNT)
. D SET("",.VALMCNT)
Q
;
PRINT ; -- print list to paper
U IO NEW BSDN,BSDT
S BSDN=0 D HDG
F S BSDN=$O(^TMP("BSDNS2",$J,BSDN)) Q:'BSDN D
. I $Y>(IOSL-5) D HDG
. W !,^TMP("BSDNS2",$J,BSDN,0)
D ^%ZISC,EXIT
Q
;
HDG ;Print report header
NEW X,I
W @IOF
I '$D(BSDT) S X=$$HTFM^XLFDT($H),BSDT=$$FMTE^XLFDT($E(X,1,12),"2P")
W !?20,"FREQUENT NO-SHOWS REPORT",?55,"Printed: ",BSDT
D HDR F I=1:1:3 W !,VALMHDR(I)
W !,$$REPEAT^XLFSTR("-",80)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BSDNS2",$J)
Q
;
EXPND ; -- expand code
Q
;
HELP1 ;EP; help for number limit question
D MSG^BDGF("Enter the number of no-shows a patient must have",2,0)
D MSG^BDGF("within a clinic's time frame (up to a year) to be",1,0)
D MSG^BDGF("included on this report.",1,1)
Q
;
HELP2 ;EP; help for limit category
D MSG^BDGF("Please select the no-show limit category.",2,1)
D MSG^BDGF("Answer F to include patients with at least "_BSDLMT_" no-shows for your whole FACILITY.",1,0)
D MSG^BDGF("Answer P to include patients with at least "_BSDLMT_" no-shows within a PRINCIPAL clinic.",1,0)
D MSG^BDGF("Answer C to include patients with at least "_BSDLMT_" no-shows within a selected CLINIC.",1,1)
Q
;
HELP3 ;EP; help for display other info question
D MSG^BDGF("Answer YES to include appointment length and other info (used for appt reason).",2,0)
D MSG^BDGF("Answer NO to list patient name, chart #, last no-show, and counts only.",2,1)
Q
;
PDATA(DFN,CLINIC,BEGDT,ENDT) ;EP; -- called to calculate # noshows for patient
; will count patient's no-shows in this clinic & principal clinic
; date range for search is based on division and clinic parameters
NEW PRINC,TOTL,NOCLN,PCNT,LMT,LMT2,X,X1,X2,APPDT,LINE,LASTNOS,CLNCD
S PRINC=$P($G(^SC(+CLINIC,"SL")),U,5) ;princ clinic
S CLNCD=$P($G(^SC(+CLINIC,0)),U,7) ;clinic code
S (TOTL,NOCLN,PCNT,CLNCNT)=0
S LMT=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.15) ;division limit
I 'LMT S LMT=365
S LMT2=$$GET1^DIQ(9009017.2,+CLINIC,.03) ;clinic limit
S LMT2=$S(LMT2="":LMT,1:LMT2) ;clinic overrides div
;
; loop by division date limit to get patient's total no-shows for site
S X1=BEGDT,X2=-LMT D C^%DTC S APPDT=X
F S APPDT=$O(^DPT(DFN,"S",APPDT)) Q:'APPDT Q:(APPDT>(ENDT+.24)) D
. S X=$P(^DPT(DFN,"S",APPDT,0),U,2) Q:(X="NT") Q:(X'["N")
. S TOTL=TOTL+1
;
; loop by clinic date range for clinic specific totals
S X1=BEGDT,X2=-LMT2 D C^%DTC S APPDT=X
F S APPDT=$O(^DPT(DFN,"S",APPDT)) Q:'APPDT Q:(APPDT>(ENDT+.24)) D
. S X=$P(^DPT(DFN,"S",APPDT,0),U,2) Q:(X="NT") Q:(X'["N")
. ;
. ; if appt for specified clinic, add to subtotal & set last no-show
. I +^DPT(DFN,"S",APPDT,0)=+CLINIC D
.. S NOCLN=NOCLN+1,LASTNOS=$$LASTNOS(DFN,+CLINIC,APPDT)
. ;
. ; if part of specified principal clinic, add to its subtotal
. I PRINC]"",$D(^SC("AIHSPC",+PRINC,+^DPT(DFN,"S",APPDT,0))) S PCNT=PCNT+1
. I CLNCD]"" S CLNCNT=CLNCNT+1
;
; returns numbers: total facility^total prin^total clinic^last noshow^clinic code count
Q TOTL_U_$G(PCNT)_U_NOCLN_U_$G(LASTNOS)_U_CLNCNT
;
LASTNOS(PAT,CLINIC,DATE) ; -- returns appt display line
NEW X,Y,Z
S X=$$FMTE^XLFDT(DATE,2)_" " ;appt date/time
; get info out of hospital location file entry
S Y=0 F S Y=$O(^SC(+CLINIC,"S",DATE,1,Y)) Q:'Y!$D(Z) D
. Q:$P(^SC(+CLINIC,"S",DATE,1,Y,0),U)'=PAT
. S Z=^SC(+CLINIC,"S",DATE,1,Y,0)
. S X=X_U_$P(Z,U,2)_"MIN "_$E($P(Z,U,4),1,25) ;appt length&other info
Q X
;
LIMIT(NUM,LMT,MODE) ; returns 1 if number within limit for mode
; +NUM=# of no-shows for patient
; LMT=# no-shows needed to be included
; MODE=(F:facility, P:principal clinic C:clinic)
I MODE="F" Q $S(+NUM<LMT:0,1:1) ;enough for facility?
I MODE="P" Q $S($P(NUM,U,2)<LMT:0,1:1) ;enough for princ clinic?
I MODE="C" Q $S($P(NUM,U,3)<LMT:0,1:1) ;enough for this clinic?
I MODE="N" Q $S(+NUM<LMT:0,1:1) ;enough for this patient? cmi/maw PATCH 1010 RQMT 1
I MODE="O" Q $S($P(NUM,U,5)<LMT:0,1:1) ;enough for this clinic code
Q 0
;
LMT(CLN) ; return time limit for clinic
NEW LMT,LMT2
S LMT=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.15) ;division limit
I 'LMT S LMT=365
S LMT2=$$GET1^DIQ(9009017.2,+CLN,.03) ;clinic limit
Q "Count back "_$S(LMT2="":LMT,1:LMT2)_" days" ;clinic overrides div
;
MODEMSG(MODE) ; return mode in external format
I MODE="F" Q "for the facility"
I MODE="P" Q "within principal clinics"
Q "within any clinic"
;
SET(LINE,NUM) ; put display line into display array
S NUM=NUM+1
S ^TMP("BSDNS2",$J,NUM,0)=LINE
Q
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BSDNS2 ; IHS/ANMC/LJF - FREQUENT NO-SHOWS ;
+1 ;;5.3;PIMS;**1010**;APR 26, 2002
+2 ;
ASK ; ask user questions
+1 NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDSUB,BSDTT,Y,BSDSEEN
+2 NEW BSDCP,BSDP,BSDPCNT
+3 DO CLINIC^BSDU(2)
IF $DATA(BSDQ)
QUIT
+4 ;
+5 ;cmi/maw patch 1010 possibility to ask for patient in later patch
+6 ; get clinic arrays
+7 ;S BSDCP=$$READ^BDGF("S^C:Clinic;P:Patient","Select Clinic or Patient","Clinic") ;cmi/maw PATCH 1010
+8 ;Q:BSDCP=U ;cmi/maw PATCH 1010
+9 ;
+10 ;I BSDCP="C" D CLINIC^BSDU(2) Q:$D(BSDQ)
+11 ;I BSDCP="P" D
+12 ;. S VAUTC=1
+13 ;. S BSDP=$$READ^BDGF("S^A:All Patients;I:Individual Patients","All or Individual Patients","All")
+14 ;. Q:BSDP=U
+15 ;. I BSDP="I" S BSDPCNT=0 D PAT
+16 ;I BSDCP="P" Q:'$D(BSDP(1))
+17 ;
+18 SET BSDBD=$$READ^BDGF("DO^::EX","Select First Date to Search")
IF 'BSDBD
QUIT
+19 SET BSDED=$$READ^BDGF("DO^::EX","Select Last Date to Search")
IF 'BSDED
QUIT
+20 ;
+21 SET BSDLMT=$$READ^BDGF("N^1:99","Number of No-Shows that defines Frequent","","^D HELP1^BSDNS2")
IF BSDLMT=""
QUIT
IF BSDLMT=U
QUIT
+22 ;
+23 ;cmi/maw PATCH 1010 RQMT 1
SET BSDMODE=$$READ^BDGF("S^F:Facility;P:Principal Clinic;C:Clinic;N:Patient;O:Clinic Code","No-Show Limit based on which category","","^D HELP2^BSDNS2")
IF BSDMODE=""
QUIT
IF BSDMODE=U
QUIT
+24 ;
+25 SET BSDINFO=$$READ^BDGF("YO","Display Appt. Other Info","NO","^D HELP3^BSDNS2")
IF BSDINFO=U
QUIT
+26 ;
+27 ;browse in list mgr mode
SET Y=$$BROWSE^BDGF
IF "PB"'[Y
QUIT
IF Y="B"
DO EN
QUIT
+28 DO ZIS^BDGF("PQ","START^BSDNS2","FREQ NO-SHOWS","BSDINFO;BSDLMT;BSDMODE;BSDBD;BSDED;VAUTC*;VAUTD*")
+29 QUIT
+30 ;
PAT ;-- select patients to show or all
+1 SET DIC=9000001
SET DIC("A")="Select Patient: "
SET DIC(0)="AEMQZ"
+2 DO ^DIC
+3 SET BSDP=+Y
+4 IF Y<0
QUIT
+5 SET BSDPCNT=BSDPCNT+1
+6 SET BSDP(BSDPCNT)=+BSDP
+7 GOTO PAT
+8 QUIT
+9 ;
START ;EP; -- re-entry for printing to paper
+1 DO INIT
DO PRINT
QUIT
+2 ;
EN ; -- main entry point for BSDRM FREQUENT NOSHOWS
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDRM FREQUENT NOSHOWS")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=$$SP(15)_$$CONF^BSDU
+2 SET VALMHDR(2)=$$SP(11)_"For appointments between "_$$FMTE^XLFDT(BSDBD)
+3 SET VALMHDR(2)=VALMHDR(2)_" and "_$$FMTE^XLFDT(BSDED)
+4 SET VALMHDR(3)=$$SP(13)_"Patients with at least "_BSDLMT_" no-shows "_$$MODEMSG(BSDMODE)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=0
KILL ^TMP("BSDNS2",$JOB),^TMP("BSDNS21",$JOB)
+2 NEW BSDAR
SET BSDAR=$SELECT(VAUTC:"^SC",1:"VAUTC")
+3 ;
+4 ; -- loop by clinic
+5 NEW CLN,PC,APPT,IEN,CLNM,PATNM,DFN,X,NOSHOWS
+6 SET CLN=0
FOR
SET CLN=$ORDER(@BSDAR@(CLN))
IF 'CLN
QUIT
Begin DoDot:1
+7 ;quit if principal clinic
IF $DATA(^SC("AIHSPC",CLN))
QUIT
+8 ;principal clinic name
SET PC=$$PRIN^BSDU(CLN)
+9 ;clinic's name
SET CLNM=$$GET1^DIQ(44,CLN,.01)
+10 ;
+11 ; now loop by date to find no-shows
+12 ; loop backwards to find most recent no-show
+13 SET APPT=BSDED+.24
SET END=BSDBD
+14 FOR
SET APPT=$ORDER(^SC(CLN,"S",APPT),-1)
IF 'APPT
QUIT
IF APPT<BSDBD
QUIT
Begin DoDot:2
+15 SET IEN=0
FOR
SET IEN=$ORDER(^SC(CLN,"S",APPT,1,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+16 ;pat ien
SET DFN=+^SC(CLN,"S",APPT,1,IEN,0)
+17 ; quit if not a no-show
+18 SET X=$PIECE($GET(^DPT(DFN,"S",APPT,0)),U,2)
IF X="NT"
QUIT
IF X'["N"
QUIT
+19 ;pat name
SET PATNM=$$GET1^DIQ(2,DFN,.01)
+20 ;patient already done
IF $DATA(^TMP("BSDNS21",$JOB,PC,CLNM,PATNM,DFN))
QUIT
+21 ;
+22 ;count no-shows for pat
SET NOSHOWS=$$PDATA(DFN,CLN,APPT,BSDED)
+23 ;quit if not within limit
IF '$$LIMIT(NOSHOWS,BSDLMT,BSDMODE)
QUIT
+24 IF BSDMODE'="N"
SET ^TMP("BSDNS21",$JOB,PC,CLNM,PATNM,DFN)=NOSHOWS_U_APPT
+25 ;cmi/maw PATCH 1010 RQMT 1
IF BSDMODE="N"
SET ^TMP("BSDNS21",$JOB,PATNM,DFN,CLNM)=NOSHOWS_U_APPT
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;
+27 ; put sorted list into display array
+28 ;below will be by clinic cmi/maw PATCH 1010 RQMT 1
+29 IF BSDMODE'="N"
DO BYPC
QUIT
+30 IF BSDMODE="N"
DO BYPAT
QUIT
+31 QUIT
+32 ;
BYPC ;-- sort everything by clinic
+1 NEW LINE,COUNTS
+2 SET PC=0
FOR
SET PC=$ORDER(^TMP("BSDNS21",$JOB,PC))
IF PC=""
QUIT
Begin DoDot:1
+3 SET LINE=$$PAD("Principal Clinic: "_PC,45)_" ("_$$LMT(PC)_")"
+4 DO SET(LINE,.VALMCNT)
+5 ;
+6 SET CLNM=0
FOR
SET CLNM=$ORDER(^TMP("BSDNS21",$JOB,PC,CLNM))
IF CLNM=""
QUIT
Begin DoDot:2
+7 ;clinic name
SET LINE=" "_CLNM_" ("_$$LMT(CLNM)_")"
+8 DO SET("",.VALMCNT)
DO SET(LINE,.VALMCNT)
+9 ;
+10 SET PATNM=0
+11 FOR
SET PATNM=$ORDER(^TMP("BSDNS21",$JOB,PC,CLNM,PATNM))
IF PATNM=""
QUIT
Begin DoDot:3
+12 SET DFN=0
+13 FOR
SET DFN=$ORDER(^TMP("BSDNS21",$JOB,PC,CLNM,PATNM,DFN))
IF 'DFN
QUIT
Begin DoDot:4
+14 ;no-show counts
SET COUNTS=^TMP("BSDNS21",$JOB,PC,CLNM,PATNM,DFN)
+15 SET LINE=$$PAD($$SP(2)_PATNM,18)_$JUSTIFY($$HRCN^BDGF2(DFN,+$GET(DUZ(2))),7)
+16 ;last noshow dt
SET LINE=$$PAD($$PAD(LINE,30)_$PIECE(COUNTS,U,4),53)
+17 FOR I=3,2,1
SET LINE=LINE_$JUSTIFY($PIECE(COUNTS,U,I),8)
+18 DO SET(LINE,.VALMCNT)
+19 IF BSDINFO
DO SET($$SP(15)_$PIECE(COUNTS,U,5),.VALMCNT)
End DoDot:4
End DoDot:3
End DoDot:2
+20 DO SET("",.VALMCNT)
End DoDot:1
+21 ;
+22 ;K ^TMP("BSDNS21",$J)
+23 QUIT
+24 ;
BYPAT ;-- sort by patient
+1 NEW LINE,COUNTS
+2 SET PAT=0
FOR
SET PAT=$ORDER(^TMP("BSDNS21",$JOB,PAT))
IF PAT=""
QUIT
Begin DoDot:1
+3 SET LINE=$$PAD("Patient Name: "_$EXTRACT(PAT,1,20)_" Chart: "_$$HRCN^BDGF2($ORDER(^TMP("BSDNS21",$JOB,PAT,0)),+$GET(DUZ(2))),57)_" ("_$$LMT(PAT)_")"
+4 DO SET(LINE,.VALMCNT)
+5 ;
+6 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("BSDNS21",$JOB,PAT,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+7 SET CLNNM=0
+8 FOR
SET CLNNM=$ORDER(^TMP("BSDNS21",$JOB,PAT,DFN,CLNNM))
IF CLNNM=""
QUIT
Begin DoDot:3
+9 ;no-show counts
SET COUNTS=^TMP("BSDNS21",$JOB,PAT,DFN,CLNNM)
+10 SET LINE=$$PAD($$SP(2)_CLNNM,18)
+11 ;last noshow dt
SET LINE=$$PAD($$PAD(LINE,30)_$PIECE(COUNTS,U,4),53)
+12 FOR I=3,2,1
SET LINE=LINE_$JUSTIFY($PIECE(COUNTS,U,I),8)
+13 DO SET(LINE,.VALMCNT)
+14 IF BSDINFO
DO SET($$SP(15)_$PIECE(COUNTS,U,5),.VALMCNT)
End DoDot:3
End DoDot:2
+15 DO SET("",.VALMCNT)
End DoDot:1
+16 QUIT
+17 ;
PRINT ; -- print list to paper
+1 USE IO
NEW BSDN,BSDT
+2 SET BSDN=0
DO HDG
+3 FOR
SET BSDN=$ORDER(^TMP("BSDNS2",$JOB,BSDN))
IF 'BSDN
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-5)
DO HDG
+5 WRITE !,^TMP("BSDNS2",$JOB,BSDN,0)
End DoDot:1
+6 DO ^%ZISC
DO EXIT
+7 QUIT
+8 ;
HDG ;Print report header
+1 NEW X,I
+2 WRITE @IOF
+3 IF '$DATA(BSDT)
SET X=$$HTFM^XLFDT($HOROLOG)
SET BSDT=$$FMTE^XLFDT($EXTRACT(X,1,12),"2P")
+4 WRITE !?20,"FREQUENT NO-SHOWS REPORT",?55,"Printed: ",BSDT
+5 DO HDR
FOR I=1:1:3
WRITE !,VALMHDR(I)
+6 WRITE !,$$REPEAT^XLFSTR("-",80)
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BSDNS2",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
HELP1 ;EP; help for number limit question
+1 DO MSG^BDGF("Enter the number of no-shows a patient must have",2,0)
+2 DO MSG^BDGF("within a clinic's time frame (up to a year) to be",1,0)
+3 DO MSG^BDGF("included on this report.",1,1)
+4 QUIT
+5 ;
HELP2 ;EP; help for limit category
+1 DO MSG^BDGF("Please select the no-show limit category.",2,1)
+2 DO MSG^BDGF("Answer F to include patients with at least "_BSDLMT_" no-shows for your whole FACILITY.",1,0)
+3 DO MSG^BDGF("Answer P to include patients with at least "_BSDLMT_" no-shows within a PRINCIPAL clinic.",1,0)
+4 DO MSG^BDGF("Answer C to include patients with at least "_BSDLMT_" no-shows within a selected CLINIC.",1,1)
+5 QUIT
+6 ;
HELP3 ;EP; help for display other info question
+1 DO MSG^BDGF("Answer YES to include appointment length and other info (used for appt reason).",2,0)
+2 DO MSG^BDGF("Answer NO to list patient name, chart #, last no-show, and counts only.",2,1)
+3 QUIT
+4 ;
PDATA(DFN,CLINIC,BEGDT,ENDT) ;EP; -- called to calculate # noshows for patient
+1 ; will count patient's no-shows in this clinic & principal clinic
+2 ; date range for search is based on division and clinic parameters
+3 NEW PRINC,TOTL,NOCLN,PCNT,LMT,LMT2,X,X1,X2,APPDT,LINE,LASTNOS,CLNCD
+4 ;princ clinic
SET PRINC=$PIECE($GET(^SC(+CLINIC,"SL")),U,5)
+5 ;clinic code
SET CLNCD=$PIECE($GET(^SC(+CLINIC,0)),U,7)
+6 SET (TOTL,NOCLN,PCNT,CLNCNT)=0
+7 ;division limit
SET LMT=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.15)
+8 IF 'LMT
SET LMT=365
+9 ;clinic limit
SET LMT2=$$GET1^DIQ(9009017.2,+CLINIC,.03)
+10 ;clinic overrides div
SET LMT2=$SELECT(LMT2="":LMT,1:LMT2)
+11 ;
+12 ; loop by division date limit to get patient's total no-shows for site
+13 SET X1=BEGDT
SET X2=-LMT
DO C^%DTC
SET APPDT=X
+14 FOR
SET APPDT=$ORDER(^DPT(DFN,"S",APPDT))
IF 'APPDT
QUIT
IF (APPDT>(ENDT+.24))
QUIT
Begin DoDot:1
+15 SET X=$PIECE(^DPT(DFN,"S",APPDT,0),U,2)
IF (X="NT")
QUIT
IF (X'["N")
QUIT
+16 SET TOTL=TOTL+1
End DoDot:1
+17 ;
+18 ; loop by clinic date range for clinic specific totals
+19 SET X1=BEGDT
SET X2=-LMT2
DO C^%DTC
SET APPDT=X
+20 FOR
SET APPDT=$ORDER(^DPT(DFN,"S",APPDT))
IF 'APPDT
QUIT
IF (APPDT>(ENDT+.24))
QUIT
Begin DoDot:1
+21 SET X=$PIECE(^DPT(DFN,"S",APPDT,0),U,2)
IF (X="NT")
QUIT
IF (X'["N")
QUIT
+22 ;
+23 ; if appt for specified clinic, add to subtotal & set last no-show
+24 IF +^DPT(DFN,"S",APPDT,0)=+CLINIC
Begin DoDot:2
+25 SET NOCLN=NOCLN+1
SET LASTNOS=$$LASTNOS(DFN,+CLINIC,APPDT)
End DoDot:2
+26 ;
+27 ; if part of specified principal clinic, add to its subtotal
+28 IF PRINC]""
IF $DATA(^SC("AIHSPC",+PRINC,+^DPT(DFN,"S",APPDT,0)))
SET PCNT=PCNT+1
+29 IF CLNCD]""
SET CLNCNT=CLNCNT+1
End DoDot:1
+30 ;
+31 ; returns numbers: total facility^total prin^total clinic^last noshow^clinic code count
+32 QUIT TOTL_U_$GET(PCNT)_U_NOCLN_U_$GET(LASTNOS)_U_CLNCNT
+33 ;
LASTNOS(PAT,CLINIC,DATE) ; -- returns appt display line
+1 NEW X,Y,Z
+2 ;appt date/time
SET X=$$FMTE^XLFDT(DATE,2)_" "
+3 ; get info out of hospital location file entry
+4 SET Y=0
FOR
SET Y=$ORDER(^SC(+CLINIC,"S",DATE,1,Y))
IF 'Y!$DATA(Z)
QUIT
Begin DoDot:1
+5 IF $PIECE(^SC(+CLINIC,"S",DATE,1,Y,0),U)'=PAT
QUIT
+6 SET Z=^SC(+CLINIC,"S",DATE,1,Y,0)
+7 ;appt length&other info
SET X=X_U_$PIECE(Z,U,2)_"MIN "_$EXTRACT($PIECE(Z,U,4),1,25)
End DoDot:1
+8 QUIT X
+9 ;
LIMIT(NUM,LMT,MODE) ; returns 1 if number within limit for mode
+1 ; +NUM=# of no-shows for patient
+2 ; LMT=# no-shows needed to be included
+3 ; MODE=(F:facility, P:principal clinic C:clinic)
+4 ;enough for facility?
IF MODE="F"
QUIT $SELECT(+NUM<LMT:0,1:1)
+5 ;enough for princ clinic?
IF MODE="P"
QUIT $SELECT($PIECE(NUM,U,2)<LMT:0,1:1)
+6 ;enough for this clinic?
IF MODE="C"
QUIT $SELECT($PIECE(NUM,U,3)<LMT:0,1:1)
+7 ;enough for this patient? cmi/maw PATCH 1010 RQMT 1
IF MODE="N"
QUIT $SELECT(+NUM<LMT:0,1:1)
+8 ;enough for this clinic code
IF MODE="O"
QUIT $SELECT($PIECE(NUM,U,5)<LMT:0,1:1)
+9 QUIT 0
+10 ;
LMT(CLN) ; return time limit for clinic
+1 NEW LMT,LMT2
+2 ;division limit
SET LMT=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.15)
+3 IF 'LMT
SET LMT=365
+4 ;clinic limit
SET LMT2=$$GET1^DIQ(9009017.2,+CLN,.03)
+5 ;clinic overrides div
QUIT "Count back "_$SELECT(LMT2="":LMT,1:LMT2)_" days"
+6 ;
MODEMSG(MODE) ; return mode in external format
+1 IF MODE="F"
QUIT "for the facility"
+2 IF MODE="P"
QUIT "within principal clinics"
+3 QUIT "within any clinic"
+4 ;
SET(LINE,NUM) ; put display line into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BSDNS2",$JOB,NUM,0)=LINE
+3 QUIT
+4 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
