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

BSDDAM.m

Go to the documentation of this file. 
  1. BSDDAM ; IHS/ANMC/LJF - APPTS MADE BY DATE REPORT ; 
  1.  ;;5.3;PIMS;;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 BSDDET=$$READ^BDGF("YO","Include Daily Totals","NO","^D HELP1^BSDDAM") Q:BSDDET=""  Q:BSDDET=U
  1.  ;
  1.  S BSDIND=$$READ^BDGF("YO","Display Individual Clinic Totals","NO","^D HELP2^BDSDAM") Q:BSDIND=""  Q:BSDIND=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^BSDDAM","APPT MADE BY MADE","BSDDET;BSDIND;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 COUNT APPT MADE")
  1.  D EXIT,CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S X="Appointments Made from "_$$RANGE^BDGF(BSDBD,BSDED)
  1.  S VALMHDR(1)=$$SP(70-$L(X)\2)_X
  1.  ;no column headings if no details
  1.  I 'BSDDET S VALMCAP=$$SP(40)_"# Appts Made"_$$SP(7)_"Ave # Appts Made"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW BSDPLO,BSDPHI,BSDLO,BSDHI
  1.  K ^TMP("BSDDAM",$J),^TMP("BSDDAM1",$J),^TMP("BSDDAM2",$J)
  1.  S VALMCNT=0 K ^TMP("BSDDAM3",$J)
  1.  ; set up day of week array
  1.  NEW BSDA F I=1:1:7 S BSDA($$DOW^XLFDT(DT+I,1))=$$DOW^XLFDT(DT+I)
  1.  NEW BSDAR S BSDAR=$S(VAUTC:"^SC",1:"VAUTC")
  1.  ;
  1.  ; -- loop by clinic
  1.  NEW CLN,NAME,MADE,END,DOW,DOWN,APPT,PC
  1.  K BSDPLO,BSDPHI
  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 NAME=$$GET1^DIQ(44,CLN,.01)     ;set clinic's name
  1.  . S PC=$$PC(CLN)                    ;set clinc's principal clinic
  1.  . K BSDLO,BSDHI
  1.  . ;
  1.  . ; -- then by date appt made
  1.  . S MADE=BSDBD,END=BSDED+.2400
  1.  . F  S MADE=$O(^SC("AIHSDAM",CLN,MADE)) Q:'MADE!(MADE>END)  D
  1.  .. S DOW=$$DOW^XLFDT(MADE)          ;day of week
  1.  .. S DOWN=$$DOW^XLFDT(MADE,1)       ;day of week number
  1.  .. ;
  1.  .. ; -- then by appts
  1.  .. S APPT=0
  1.  .. F  S APPT=$O(^SC("AIHSDAM",CLN,MADE,APPT)) Q:'APPT  D
  1.  ... Q:$$WALKIN(CLN,MADE,APPT)           ;don't count walkins
  1.  ... D INCR(PC,NAME,(MADE\1),DOWN)       ;increment totals for clinic
  1.  ... D WAIT(PC,NAME,(MADE\1),APPT)       ;set appt wait times
  1.  . ;
  1.  . ; set high-low values for clinic
  1.  . Q:'BSDIND
  1.  . S ^TMP("BSDDAM3",$J,PC,NAME,0)=$G(BSDLO)_U_$G(BSDHI)
  1.  ;
  1.  ; -- set princ clinic high-low values
  1.  NEW X S X=0 F  S X=$O(BSDPLO(X)) Q:X=""  D
  1.  . S ^TMP("BSDDAM3",$J,X,0,0)=BSDPLO(X)_U_BSDPHI(X)
  1.  ;
  1.  ;
  1.  ; -- set display lines by princ clinic
  1.  NEW PC,LINE,TOT
  1.  S PC=0 F  S PC=$O(^TMP("BSDDAM1",$J,PC)) Q:PC=""  D
  1.  . D SET(PC,.VALMCNT)                ;display princ clinic name
  1.  . ;
  1.  . S LINE=$$PAD(" Total for this principal clinic:",40)
  1.  . S TOT=+$G(^TMP("BSDDAM1",$J,PC))
  1.  . S LINE=$$PAD(LINE_$J(TOT,5),60)_$J($$AVETOT(PC,0,TOT),5)
  1.  . D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . I BSDDET D DETAIL(PC,0)      ;display daily details
  1.  . D AVEDOW(PC,0)               ;display averages for days of week
  1.  . I BSDIND D CLOOP(PC)         ;display individual clinics if chosen
  1.  . I $O(^TMP("BSDDAM1",$J,PC))]"" D SET("",.VALMCNT),SET("",.VALMCNT)
  1.  ;
  1.  K ^TMP("BSDDAM1",$J),^TMP("BSDDAM2",$J),^TMP("BSDDAM3",$J)
  1.  Q
  1.  ;
  1.  ;
  1. INCR(S1,S2,S3,S4) ; -- increment totals
  1.  ; S1=princ cln, S2=Cln name, S3=Date appt made, S4=day of week #
  1.  ; increment total appts made & day of week # for principal clinic
  1.  S ^TMP("BSDDAM1",$J,S1)=$G(^TMP("BSDDAM1",$J,S1))+1
  1.  S ^TMP("BSDDAM1",$J,S1,0,S3)=$G(^TMP("BSDDAM1",$J,S1,0,S3))+1
  1.  S ^TMP("BSDDAM2",$J,S1,0,S4)=$G(^TMP("BSDDAM2",$J,S1,0,S4))+1
  1.  ;
  1.  Q:'BSDIND     ;quit if individual clinics not to be displayed
  1.  ;
  1.  ; increment totals for clinic
  1.  S ^TMP("BSDDAM1",$J,S1,S2)=$G(^TMP("BSDDAM1",$J,S1,S2))+1
  1.  S ^TMP("BSDDAM1",$J,S1,S2,S3)=$G(^TMP("BSDDAM1",$J,S1,S2,S3))+1
  1.  S ^TMP("BSDDAM2",$J,S1,S2,S4)=$G(^TMP("BSDDAM2",$J,S1,S2,S4))+1
  1.  Q
  1.  ;
  1. WAIT(S1,S2,S3,S4) ; -- set lo-hi-total wait times
  1.  ; S1=princ clinic, S2=clinic name, S3=appt date, S4=date appt made
  1.  NEW DAYS S DAYS=$$FMDIFF^XLFDT(S4,S3) I DAYS<0 Q
  1.  ;
  1.  ; increment total wait times
  1.  S ^TMP("BSDDAM3",$J,S1,0)=$G(^TMP("BSDDAM3",$J,S1,0))+DAYS
  1.  S ^TMP("BSDDAM3",$J,S1,S2)=$G(^TMP("BSDDAM3",$J,S1,S2))+DAYS
  1.  ;
  1.  ; reset high-low wait times for principal clinic
  1.  S BSDPLO(S1)=$S('$D(BSDPLO(S1)):DAYS,DAYS<BSDPLO(S1):DAYS,1:BSDPLO(S1))
  1.  S BSDPHI(S1)=$S('$D(BSDPHI(S1)):DAYS,DAYS>BSDPHI(S1):DAYS,1:BSDPHI(S1))
  1.  Q:'BSDIND          ;quit if not displaying individual clinic data
  1.  ;
  1.  ; reset high-low wait times for clinic
  1.  S BSDLO=$S('$D(BSDLO):DAYS,DAYS<BSDLO:DAYS,1:BSDLO)
  1.  S BSDHI=$S('$D(BSDHI):DAYS,DAYS>BSDHI:DAYS,1:BSDHI)
  1.  Q
  1.  ;
  1.  ;
  1. DETAIL(S1,S2) ; -- daily details into display array
  1.  ; S1=princ clinc, S2=clinic or 0
  1.  NEW MADE,LAST,LINE
  1.  S (LAST,MADE)=0
  1.  F  S MADE=$O(^TMP("BSDDAM1",$J,S1,S2,MADE)) Q:'MADE  D
  1.  . ;
  1.  . ; extra line between weeks
  1.  . I $$DOW^XLFDT(MADE,1)<$$DOW^XLFDT(LAST,1) D SET("",.VALMCNT)
  1.  . ;
  1.  . ; create display line
  1.  . S LINE=$$PAD($$SP(2)_$$FMTE^XLFDT(MADE),21)_$$DOW^XLFDT(MADE)
  1.  . S LINE=$$PAD(LINE,40)_$J(+$G(^TMP("BSDDAM1",$J,S1,S2,MADE)),5)
  1.  . ;
  1.  . ; put into display array
  1.  . D SET(LINE,.VALMCNT) S LAST=MADE
  1.  Q
  1.  ;
  1. CLOOP(S1) ; -- loop thru clinics for princ clinic S1
  1.  NEW CLN,LINE,TOT
  1.  S CLN=0 F  S CLN=$O(^TMP("BSDDAM1",$J,S1,CLN)) Q:CLN=""  D
  1.  . D SET(CLN,.VALMCNT)                ;display princ clinic name
  1.  . ;
  1.  . S LINE=$$PAD($$SP(4)_"Total for this clinic:",40)
  1.  . S TOT=+$G(^TMP("BSDDAM1",$J,S1,CLN))
  1.  . S LINE=$$PAD(LINE_$J(TOT,5),60)_$J($$AVETOT(S1,CLN,TOT),5)
  1.  . D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . I BSDDET D DETAIL(S1,CLN)            ;display daily details
  1.  . D AVEDOW(S1,CLN)                     ;day of week averages
  1.  Q
  1.  ;
  1. AVEDOW(S1,S2) ; -- day of week averages
  1.  ; S1=princ clinic, S2=clinic or 0 if called by princ clin code
  1.  NEW DAY,LINE,X,AVE
  1.  D SET("",.VALMCNT)
  1.  S DAY="" F  S DAY=$O(BSDA(DAY)) Q:DAY=""  D
  1.  . S LINE=$$PAD($$SP(10)_"Average for "_BSDA(DAY)_"s: ",40)
  1.  . S LINE=LINE_$J(+$G(^TMP("BSDDAM2",$J,S1,S2,DAY)),5)    ;total
  1.  . S LINE=$$PAD(LINE,60)_$J((+$G(^TMP("BSDDAM2",$J,S1,S2,DAY))\$$DOWC(S1,S2,DAY)),5)
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  S LINE=$$PAD($$SP(5)_"Wait Times:  Low - High - Average",40)
  1.  D SET(LINE,.VALMCNT)
  1.  S X=$G(^TMP("BSDDAM3",$J,S1,S2,0)),Y=$G(^TMP("BSDDAM3",$J,S1,S2))
  1.  S AVE=$G(^TMP("BSDDAM1",$J,S1)),AVE=$S(AVE=0:0,1:Y\AVE)
  1.  S LINE=$$SP(18)_$J(+$P(X,U),3)_" - "_$J(+$P(X,U,2),3)_"  - "_$J(AVE,4)
  1.  D SET(LINE,.VALMCNT)
  1.  Q
  1.  ;
  1. AVETOT(S1,S2,S3) ; -- returns average # appts made in clinic
  1.  ; S1=prin cln, S2=clinic or 0
  1.  NEW X S X=$$TOTC(S1,S2) I X=0 Q 0
  1.  Q S3\X
  1.  ;
  1. DOWC(S1,S2,S3) ; -- returns # of day S3 for prin clinic S1 & clinic S2
  1.  NEW X,Y S (X,Y)=0
  1.  F  S X=$O(^TMP("BSDDAM1",$J,S1,S2,X)) Q:'X  D
  1.  . I $$DOW^XLFDT(X,1)=S3 S Y=Y+1   ;increment if date is DOW in S3
  1.  Q $S(Y=0:1,1:Y)
  1.  ;
  1. TOTC(S1,S2) ; -- returns # of days
  1.  NEW X,Y S (X,Y)=0
  1.  F  S X=$O(^TMP("BSDDAM1",$J,S1,S2,X)) Q:'X  S Y=Y+1
  1.  Q Y
  1.  ;
  1. WALKIN(S1,S2,S3) ; -- returns 1 if appt not scheduled or an error
  1.  ; S1=clinic ien, S2=date made, S3=appt date
  1.  NEW X S X=$O(^SC("AIHSDAM",S1,S2,S3,0)) I 'X Q 1
  1.  NEW PAT S PAT=+$G(^SC(CLN,"S",S3,1,X,0)) I 'PAT Q 1
  1.  I $P($G(^DPT(PAT,"S",S3,0)),U,7)'=3 Q 1
  1.  Q 0    ;scheduled appt
  1.  ;
  1. SET(LINE,NUM) ; -- put line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDDAM",$J,NUM,0)=LINE
  1.  Q
  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("BSDDAM",$J,LINE)) Q:'LINE  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDDAM",$J,LINE,0)
  1.  D ^%ZISC D EXIT
  1.  Q
  1.  ;
  1. HDG ; -- 2nd half of heading
  1.  NEW X
  1.  W @IOF,!!?20,"Number of Appointments Made by Date"
  1.  D HDR,MSG^BDGF(VALMHDR(1),0,1)
  1.  S X=$$PAD($$PAD($$SP(3)_"Date Appt Made",22)_"Day of Week",40)
  1.  S X=$$PAD(X_"# Appts Made",57)_"Ave # Appts Made"
  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.  ;