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

BSDNS2.m

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