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

BSDTOD.m

Go to the documentation of this file. 
  1. BSDTOD ;cmi/flag/maw - Time of Day Appointment fills up ; 
  1.  ;;5.3;PIMS;**1012**;APR 26, 2002
  1.  ;
  1. ASK ; -- ask user questions
  1.  NEW VAUTC,VAUTD,POP,BSDBD,BSDED,BSDDET,BSDIND,Y
  1.  ;
  1.  D CLINIC^BSDU(2) Q:$D(BSDQ)                  ;get clinic choices
  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 Y=$$BROWSE^BDGF Q:"PB"'[Y  I Y="B" D EN Q  ;browse in list mgr mode
  1.  D ZIS^BDGF("PQ","START^BSDTOD","TOD FILL UP","BSDBD;BSDED;VAUTC*;VAUTD*")
  1.  Q
  1.  ;
  1. START ;EP; -- re-entry for printing to paper
  1.  D INIT,PRINT Q
  1.  ;
  1. EN ;EP; -- called by SD IHS COUNT APPTS MADE list template
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D MSG^BDGF("Counting Appointments . . . Please wait",2,0)
  1.  D EN^VALM("BSDRM TOD")
  1.  D EXIT,CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S X="Time of Day Clinic Appointments Fill Up for  "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  S VALMHDR(1)=$$SP(70-$L(X)\2)_X
  1.  ;no column headings if no details
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDTOD",$J),^TMP("BSDTOD1",$J)
  1.  NEW ARRAY S ARRAY=$S(VAUTC:"^SC",1:"VAUTC")
  1.  ;
  1.  ; loop thru selected clinics and put in principal clinic order
  1.  NEW CLINIC,PC,ABBR,CLNE
  1.  S CLINIC=0
  1.  F  S CLINIC=$O(@ARRAY@(CLINIC)) Q:'CLINIC  D
  1.  . Q:$D(^SC("AIHSPC",CLINIC))          ;quit if principal clinic
  1.  . S PC=$$PRIN^BSDU(CLINIC)            ;get princ clinic name
  1.  . S ABBR=$$GET1^DIQ(44,CLINIC,1)      ;clinic's abbreviation
  1.  . S CLNE=$$GET1^DIQ(44,CLINIC,.01)    ;clinic name
  1.  . S ^TMP("BSDTOD1",$J,PC,CLNE,CLINIC)=""  ;put in pc/clinic order
  1.  ;
  1.  ; loop thru sorted list and count available appts
  1.  NEW PC,ABBR,CLINIC,CLINE,LINE,DATE,SCHED,COUNT,END
  1.  S PC=0 F  S PC=$O(^TMP("BSDTOD1",$J,PC)) Q:PC=""  D
  1.  . S ABBR=0 F  S ABBR=$O(^TMP("BSDTOD1",$J,PC,ABBR)) Q:ABBR=""  D
  1.  .. S CLINIC=0
  1.  .. F  S CLINIC=$O(^TMP("BSDTOD1",$J,PC,ABBR,CLINIC)) Q:'CLINIC  D
  1.  ... ; now loop thru date range, count and put in display array
  1.  ... S DATE=BSDBD-1,END=BSDED
  1.  ... F  S DATE=$$FMADD^XLFDT(DATE,1) Q:DATE>END  D
  1.  .... Q:'$$OKAY(CLINIC,DATE)                   ;quit if inactive or no schedule
  1.  .... S SCHED=$G(^SC(CLINIC,"ST",DATE,1))
  1.  .... Q:$G(SCHED)=""
  1.  .... S COUNT=$$COUNT(SCHED)
  1.  .... Q:+$G(COUNT)>0
  1.  .... S BSDTOD=$$LASTAPPT(DATE,CLINIC)
  1.  .... Q:'$G(BSDTOD)
  1.  .... S CLINE=$$GET1^DIQ(44,CLINIC,.01)
  1.  .... S LINE=$$PAD(CLINE,21)
  1.  .... S LINE=LINE_$$PAD($$FMTE^XLFDT(DATE),28)
  1.  .... S LINE=LINE_$$PAD($$FMTE^XLFDT(BSDTOD),22)
  1.  .... D SET(LINE,.VALMCNT)  ;add clinic's line to display array
  1.  ;
  1.  K ^TMP("BSDTOD1",$J)
  1.  Q
  1.  ;
  1. COUNT(LINE) ; returns # of avail appts in display line LINE
  1.  NEW I,CNT,J,X
  1.  I LINE["CANCELLED" Q 0
  1.  S LINE=$P(LINE,"|",2,999)
  1.  F I="|","[","]","*"," ","0" S LINE=$$STRIP^XLFSTR(LINE,I)
  1.  ;
  1.  ; -- count up appts left
  1.  S CNT=0 F I=1:1:9 Q:LINE=""  D
  1.  . S X=LINE F J=1:1 Q:X=""  S:$E(X)=I CNT=CNT+I S X=$E(X,2,99)
  1.  . S LINE=$$STRIP^XLFSTR(LINE,I)
  1.  Q +$G(CNT)
  1.  ;
  1. SET(LINE,NUM) ; put display line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDTOD",$J,NUM,0)=LINE
  1.  Q
  1.  ;
  1. OKAY(C,BSDATE) ; -- active clinic with schedule? (yes=true)
  1.  NEW X
  1.  S X=$G(^SC(C,"I")) Q:'$D(^SC(C,"ST")) 0 Q:'$O(^("ST",BSDATE)) 0
  1.  Q $S($P(^SC(C,0),U,3)'="C":0,'X:1,(BSDATE>(X-1))&('$P(X,U,2)):0,1:1)
  1.  ;
  1. LASTAPPT(D,C) ;-- get the last appointment made for that date
  1.  I '$D(^SC(C,"S")) Q 0
  1.  N BSDA,BSDRR,BSDLAP,BSDI
  1.  S BSDCNT=0
  1.  S BSDA=D F  S BSDA=$O(^SC(C,"S",BSDA)) Q:'BSDA!(BSDA>(D+.9999))  D
  1.  . S BSDI=0 F  S BSDI=$O(^SC(C,"S",BSDA,1,BSDI)) Q:'BSDI  D
  1.  .. S BSDLAP=$P($G(^SC(C,"S",BSDA,1,BSDI,0)),U,7)
  1.  .. Q:'$G(BSDLAP)
  1.  .. S BSDRR(BSDLAP)=""
  1.  I '$O(BSDRR("")) Q 0
  1.  Q $O(BSDRR(""),-1)
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDDAM",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1.  ;
  1. PRINT ;EP; --prints report to paper
  1.  NEW LINE
  1.  U IO D HDG
  1.  S LINE=0 F  S LINE=$O(^TMP("BSDTOD",$J,LINE)) Q:'LINE  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDTOD",$J,LINE,0)
  1.  D ^%ZISC D EXIT
  1.  Q
  1.  ;
  1. HDG ; -- 2nd half of heading
  1.  NEW X
  1.  W @IOF,!!?25,"Time of Day Clinic Fills Up"
  1.  D HDR,MSG^BDGF(VALMHDR(1),0,1)
  1.  S X=$$PAD("Clinic",21)
  1.  S X=$$PAD(X_"Appointment Date",49)
  1.  S X=X_"Date/Time"
  1.  D MSG^BDGF(X,1,0),MSG^BDGF($$REPEAT^XLFSTR("=",80),1,1)
  1.  Q
  1.  ;
  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)
  1.  ;
  1. PC(C) ; -- returns name of principal clinic
  1.  Q $$PRIN^BSDU(C)
  1.  ;
  1. HELP1 ;EP; called from DIR for Detailed Display question
  1.  D MSG^BDGF("Answer YES to include totals for each date in your",2,0)
  1.  D MSG^BDGF("date range in addition to the day of week averages.",1,0)
  1.  D MSG^BDGF("Answer NO to only display day of week data.",2,1)
  1.  Q
  1.  ;
  1. HELP2 ;EP; called by DIR for Include Individual Clinic Totals question
  1.  D MSG^BDGF("Answer YES to display data on each individual clinic",2,0)
  1.  D MSG^BDGF("as opposed to just principal clinic totals.",1,0)
  1.  D MSG^BDGF("Answer NO to only see principal clinic data.",2,1)
  1.  Q
  1.  ;
  1. XREFC(CLIN,DATE,PAT) ;EP; -- updates AIHSDAM xref when data is hard set
  1.  ; Called by SDM1A and SDMM1
  1.  NEW MADE
  1.  S MADE=$P($G(^SC(CLIN,"S",DATE,1,PAT,0)),U,7)
  1.  I MADE]"" S ^SC("AIHSDAM",CLIN,MADE,DATE,PAT)=""
  1.  Q
  1.  ;