BSDCCR2 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONT.;
;;5.3;PIMS;**1011**;APR 26, 2002
;COPY OF SCRPW72 BEFORE PATCH #223
;IHS/ANMC/LJF 10/06/2000 added call to IHS subtitles code
; made report 80 columns wide for past dates
; added call to list template
; made IHS mods to heading code
; 8/24/2001 check clinic selection for summary too
; 12/13/2001 screen out non-clinic entries in file 44
; 4/11/2002 screen out entries without clinic codes
;cmi/flag/maw 11/09/2009 put fix in ORD for clinic codes that are not numeric
;
START ;Gather data for printed report
I $E(IOST,1,2)="C-" D EN^BSDCCRL Q ;IHS/ANMC/LJF 10/6/2000
IHS ;EP; re-entry point from list template ;IHS/ANMC/LJF 10/6/2000
N SDCP,SC,SCNA,SDI,SDOUT,SDPAST,SDXM,MAX,X1,X2,X,SDIOM
S (SDOUT,SDI)=0,SDIOM=$G(IOM,80)
S SDPAST=SDBDT'>DT ;S:SDPAST SDIOM=130 ;IHS/ANMC/LJF 10/6/2000
K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDTOT",$J)
;D INIT^BSDCCR1 S SDCOL=$S(SDPAST:0,1:(SDIOM-58\2)) ;IHS/ANMC/LJF 10/6/2000
D INIT^BSDCCR1 S SDCOL=$S(SDPAST:-7,1:(SDIOM-58\2)) ;IHS/ANMC/LJF 10/6/2000
S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
I SDPAST D OE(SDBDT,SDEDT,MAX,0) Q:SDOUT ;get outpt. enc. workload
G:SDOUT EXIT^BSDCCR4
;
;IHS/ANMC/LJF 8/24/2001 summary has clinic selection too
;I SDFMT="D" D @SDSORT
;I SDFMT="S" S SC=0 F S SC=$O(^SC(SC)) Q:'SC!SDOUT D
;.S SDI=SDI+1 I SDI#25=0 D STOP Q:SDOUT
;.S SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
;.S SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
;.Q
D @SDSORT
;IHS/ANMC/LJF 8/24/2001 end of mods
;
G:SDOUT EXIT^BSDCCR4
S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
I SDPAST D NAVA^BSDCCR5(SDBDT,SDEDT,SDEX) ;get next available wait times
G:SDOUT EXIT^BSDCCR4
D ORD,PRT^BSDCCR3(0) G EXIT^BSDCCR4
;
ORD ;Build list to order clinic output
S SDIV="" F S SDIV=$O(^TMP("SD",$J,SDIV)) Q:SDIV=""!SDOUT D
.;S SDCP=0 F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:'SDCP!SDOUT D cmi/maw 11/9/2009 PATCH 1011 orig line
.S SDCP=0 F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:SDCP=""!SDOUT D ;cmi/maw 11/9/2009 PATCH 1011
..S SC=0 F S SC=$O(^TMP("SD",$J,SDIV,SDCP,SC)) Q:'SC!SDOUT D
...S SCNA=$P($G(^SC(SC,0)),U) S:'$L(SCNA) SCNA="UNKNOWN"
...S ^TMP("SDS",$J,SDCP,SCNA,SC)=""
...Q
..Q
.Q
Q
;
OE(SDBDT,SDEDT,MAX,SDEX) ;Count clinic workload
;Input: SDBDT=begin date
;Input: SDEDT=end date
;Input: MAX=number of days in date range
;Input: SDEX='0' for user report, '1' for Austin extract
N SDT,SDOE,SDOE0,SDCT,SDCP,SDQUIT S (SDQUIT,SDCT)=0,SDT=SDBDT
F S SDT=$O(^SCE("B",SDT)) Q:'SDT!(SDT>SDEDT)!SDOUT D
.S SDOE=0 F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT D
..S SDCT=SDCT+1 I SDCT#1000=0 D STOP Q:SDOUT
..S SDOE0=$$GETOE^SDOE(SDOE) Q:$P(SDOE0,U,6) Q:$P(SDOE0,U,12)=12
..S SC=$P(SDOE0,U,4) Q:'SC Q:'$$DIV(+$P(SDOE0,U,11))
..S SC0=$G(^SC(SC,0)) Q:'$L($P(SC0,U))
..Q:$P(SC0,U,17)="Y" Q:'$$CPAIR^BSDCCR1(SC0,.SDCP)
.. ;
.. ;IHS/ANMC/LJF 8/24/2001 check clinic for summary report too
..;I SDFMT="D",'SDEX S SDQUIT=0 D Q:SDQUIT
..;.I SDSORT="CL",'$D(SDSORT($P(SC0,U))) S SDQUIT=1 Q
..;.I SDSORT="CP",'$D(SDSORT(SDCP)) S SDQUIT=1
..;.Q
..I SDSORT="CL",'$D(SDSORT($P(SC0,U))) S SDQUIT=1 Q
..I SDSORT="CP",'$D(SDSORT(SDCP)) S SDQUIT=1
.. ;IHS/ANMC/LJF 8/24/2001 end of mods
.. ;
..S SDIV=$$DIV^BSDCCR1(SC0)
..I '$D(^TMP("SD",$J,SDIV,SDCP,SC)) D ARRINI^BSDCCR1(SDCP,SC,MAX,SDPAST)
..S $P(^TMP("SD",$J,SDIV,SDCP),U,3)=$P(^TMP("SD",$J,SDIV,SDCP),U,3)+1
..S $P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)=$P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)+1
..Q:SDFMT'="D" S X1=$P(SDT,"."),X2=SDBDT D ^%DTC S SDAY=X+1
..D ARRSET(SDCP,SC,SDAY) Q
.Q
Q
;
ARRSET(SDCP,SC,SDI) ;Set daily counts into array
;Input: SDCP=credit pair
;Input: SC=clinic ifn
;Input: SDI=number of days from report date
N SDS,SDP,SDX
S SDS=SDI-1\12,SDP=SDI#12 S:SDP=0 SDP=12
S SDX=$P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)
S:'$L(SDX) SDX="0~0~0"
S $P(SDX,"~",3)=$P(SDX,"~",3)+1
S $P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)=SDX
Q
;
DIV(SDIV) ;Evaluate division
Q:'SDDIV 1 Q $D(SDDIV(SDIV))
;
CL ;Evaluate list of clinics
N SDCNAM,SC0,SDIV S SDI=0
S SDCNAM="" F S SDCNAM=$O(SDSORT(SDCNAM)) Q:SDCNAM=""!SDOUT D
.S SDI=SDI+1 I SDI#10=0 D STOP Q:SDOUT
.S SC=SDSORT(SDCNAM),SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
.S SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
.I $P(SDX,U,3)=-1 D
..S SDIV=$$DIV^BSDCCR1(SC0)
..S:$L(SDIV) $P(^TMP("SD",$J,SDIV,SDCNAM),U,3)=$P(SDX,U,3,4) Q
.Q
Q
;
CP ;Evaluate list of credit pairs
N SDCCP,SC,SC0 S SC=0
F S SC=$O(^SC(SC)) Q:'SC!SDOUT D
.S SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
.Q:$P(SC0,U,3)'="C" ;IHS/ANMC/LJF 12/13/2001 must be a clinic
.Q:$P(SC0,U,7)="" ;IHS/ANMC/LJF 04/11/2002 must have clinic code
.Q:'$$CPAIR^BSDCCR1(SC0,.SDCCP)!'$D(SDSORT(SDCCP))
.S SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
.Q
Q
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
HINI ;Initialize header variables
N %,%H,%I,X,X1,X2
;S SDLINE="",$P(SDLINE,"-",$S(SDPAST:131,1:(SDIOM+1)))="",SDPAGE=1,SDPG=0 ;IHS/ANMC/LJF 10/6/2000
S SDLINE="",$P(SDLINE,"-",$S(SDPAST:80,1:(SDIOM+1)))="",SDPAGE=1,SDPG=0 ;IHS/ANMC/LJF 10/6/2000
D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
;S SDTITL="<*> Clinic Appointment Availability Report <*>" ;IHS/ANMC/LF 10/6/2000
S SDTITL="<*> Clinic Appointment Capacity Report <*>" ;IHS/ANMC/LJF 10/6/2000
Q
;
HDR(SDTY,SDIV,SDCP,SC) ;Print header
;Input: SDTY=type of header where:
; '0'=negative report
; '1'=detailed report
; '2'=division summary
; '3'=facility summary
;Input: SDIV=division name^division number
;Input: SDCP=credit pair
;Input: SC=clinic ifn
;
Q:SDOUT
I $G(SDXM) D HDRXM^BSDCCR3 Q
I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
N SDX,SDI D STOP Q:SDOUT
W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
W SDLINE,!?(SDIOM-$L(SDTITL)\2),SDTITL
D HDRX(SDTY) Q:SDOUT S SDI=0
F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(SDIOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
W !,SDLINE,!,"For clinic availability dates ",SDPBDT," through ",SDPEDT
W !,"Date printed: ",SDPNOW,?(SDIOM-6-$L(SDPAGE)),"Page: ",SDPAGE
W !,SDLINE S SDPAGE=SDPAGE+1,SDPG=1 D:SDTY SUBT(SDTY) Q
;
HDRX(SDTY) ;Extra header lines
K SDTIT
Q:SDTY=0 S SDIV=$G(SDIV)
I SDTY=3 S SDTIT(1)="Facility Summary" Q
N SDDV S SDDV=$P(SDIV,U)_" ("_$P(SDIV,U,2)_")"
I SDTY=2 S SDTIT(1)="Summary for division: "_SDDV Q
S SDTIT(1)="Division: "_SDDV
;S:SDSORT="CP" SDTIT(2)="For clinics with credit pair: "_$$OTX^BSDCCR3("CP") ;IHS/ANMC/LJF 10/6/2000
S:SDSORT="CP" SDTIT(2)="For clinics with clinic code: "_$$OTX^BSDCCR3("CP") S SDTIT(3)="Detail for clinic: "_$$OTX^BSDCCR3("CL") ;IHS/ANMC/LJF 10/6/2000
Q
;
SUBT(SDTY) ;Print subtitles
D SUBT^BSDCCRL(SDTY) Q ;IHS/ANMC/LJF 10/6/2000
N SDI
W !?(SDCOL+44),"Avail.",?(SDCOL+54),"Pct."
I SDPAST F SDI=0:1:3 W ?(SDCOL+68+(16*SDI)),"---Type '",SDI,"'---"
W ! W:SDTY>1 ?(SDCOL),"Credit Pair"
W ?(SDCOL+36),"Clinic",?(SDCOL+45),"Appt.",?(SDCOL+53),"Slots"
W:SDPAST ?(SDCOL+60),"Clinic"
I SDPAST F SDI=0:1:3 W ?(SDCOL+68+(16*SDI)),"Sched. Wait"
W !?(SDCOL+4),$S(SDTY=1:"Availability Date",1:"Clinic Name")
W ?(SDCOL+34),"Capacity",?(SDCOL+45),"Slots",?(SDCOL+52),"Avail."
W:SDPAST ?(SDCOL+62),"Enc."
I SDPAST F SDI=0:1:3 W ?(SDCOL+68+(16*SDI)),"Appts. Time"
W !?($S(SDTY>1:SDCOL,1:SDCOL+4)),$E(SDLINE,1,($S(SDPAST:130,1:58)-$S(SDTY=1:4,1:0)))
Q
;
N SDBEG,SDEND,SDTIME,SDCP,SDX,SC,SCNA,SDI,SDFMT,SDOUT,SDXM,SDIOM
N SDEXDT,MAX,X1,X2,X S SDIOM=$G(IOM,80)
S (SDOUT,SDCOL)=0,SDFMT="D",SDBEG=$H,SDEXDT=DT D INIT^BSDCCR1
K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDXM",$J)
S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
;
;Get encounter workload
I SDPAST D OE(SDBDT,SDEDT_.9999,MAX,1) ;encounter workload
;
;Get clinic availability data
S SC=0 F S SC=$O(^SC(SC)) Q:'SC S SC0=$G(^SC(SC,0)) D
.S SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
.Q
;
;Get next available wait times
S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
I SDPAST D NAVA^BSDCCR5(SDBDT,SDEDT_.9999,1) ;next ava. wait times
;
;Order by clinic, send extract data to Austin
D ORD,TXXM^BSDCCR0 K ^TMP("SDXM",$J)
;
;Send summary bulletin to mail group
S SDFMT="S",SDEND=$H,SDTIME=$$TIME(SDBEG,SDEND)
S SDBEG=$$HTE^XLFDT(SDBEG),SDEND=$$HTE^XLFDT(SDEND)
S SDY="*** Clinic Appointment "_$S(SDPAST:"Utilization",1:"Availability")_" Extract ***"
S SDXM=1,SDX="",$E(SDX,(79-$L(SDY)\2))=SDY D XMTX^BSDCCR3(SDX)
D XMTX^BSDCCR3(" ")
D XMTX^BSDCCR3(" For date range: "_SDPBDT_" to "_SDPEDT)
D XMTX^BSDCCR3(" Extract start time: "_SDBEG)
D XMTX^BSDCCR3(" Extract end time: "_SDEND)
D XMTX^BSDCCR3(" Extract run time: "_SDTIME)
F SDI=1:1:4 D XMTX^BSDCCR3("")
D PRT^BSDCCR3(SDXM),EXXM^BSDCCR0("G.SC CLINIC WAIT TIME")
G EXIT^BSDCCR4
;
TIME(SDBEG,SDEND) ;Calculate length of run time
;Input: SDBEG=start time in $H format
;Input: SDEND=end time in $H format
;Output: text formatted string with # days, hours, minutes and seconds
N X,Y
S SDEND=$P(SDEND,",")-$P(SDBEG,",")*86400+$P(SDEND,",",2)
S SDBEG=$P(SDBEG,",",2),X=SDEND-SDBEG,Y("D")=X\86400
S X=X#86400,Y("H")=X\3600,X=X#3600,Y("M")=X\60,Y("S")=X#60
S Y("D")=$S('Y("D"):"",1:Y("D")_" day"_$S(Y("D")=1:"",1:"s")_", ")
S Y("H")=Y("H")_" hour"_$S(Y("H")=1:"",1:"s")_", "
S Y("M")=Y("M")_" minute"_$S(Y("M")=1:"",1:"s")_", "
S Y("S")=Y("S")_" second"_$S(Y("S")=1:"",1:"s")
Q Y("D")_Y("H")_Y("M")_Y("S")
BSDCCR2 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONT.;
+1 ;;5.3;PIMS;**1011**;APR 26, 2002
+2 ;COPY OF SCRPW72 BEFORE PATCH #223
+3 ;IHS/ANMC/LJF 10/06/2000 added call to IHS subtitles code
+4 ; made report 80 columns wide for past dates
+5 ; added call to list template
+6 ; made IHS mods to heading code
+7 ; 8/24/2001 check clinic selection for summary too
+8 ; 12/13/2001 screen out non-clinic entries in file 44
+9 ; 4/11/2002 screen out entries without clinic codes
+10 ;cmi/flag/maw 11/09/2009 put fix in ORD for clinic codes that are not numeric
+11 ;
START ;Gather data for printed report
+1 ;IHS/ANMC/LJF 10/6/2000
IF $EXTRACT(IOST,1,2)="C-"
DO EN^BSDCCRL
QUIT
IHS ;EP; re-entry point from list template ;IHS/ANMC/LJF 10/6/2000
+1 NEW SDCP,SC,SCNA,SDI,SDOUT,SDPAST,SDXM,MAX,X1,X2,X,SDIOM
+2 SET (SDOUT,SDI)=0
SET SDIOM=$GET(IOM,80)
+3 ;S:SDPAST SDIOM=130 ;IHS/ANMC/LJF 10/6/2000
SET SDPAST=SDBDT'>DT
+4 KILL ^TMP("SD",$JOB),^TMP("SDS",$JOB),^TMP("SDTMP",$JOB),^TMP("SDTOT",$JOB)
+5 ;D INIT^BSDCCR1 S SDCOL=$S(SDPAST:0,1:(SDIOM-58\2)) ;IHS/ANMC/LJF 10/6/2000
+6 ;IHS/ANMC/LJF 10/6/2000
DO INIT^BSDCCR1
SET SDCOL=$SELECT(SDPAST:-7,1:(SDIOM-58\2))
+7 SET X1=SDEDT
SET X2=SDBDT
DO ^%DTC
SET MAX=X+1
+8 ;get outpt. enc. workload
IF SDPAST
DO OE(SDBDT,SDEDT,MAX,0)
IF SDOUT
QUIT
+9 IF SDOUT
GOTO EXIT^BSDCCR4
+10 ;
+11 ;IHS/ANMC/LJF 8/24/2001 summary has clinic selection too
+12 ;I SDFMT="D" D @SDSORT
+13 ;I SDFMT="S" S SC=0 F S SC=$O(^SC(SC)) Q:'SC!SDOUT D
+14 ;.S SDI=SDI+1 I SDI#25=0 D STOP Q:SDOUT
+15 ;.S SC0=$G(^SC(SC,0)) Q:'$$DIV(+$P(SC0,U,15))
+16 ;.S SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
+17 ;.Q
+18 DO @SDSORT
+19 ;IHS/ANMC/LJF 8/24/2001 end of mods
+20 ;
+21 IF SDOUT
GOTO EXIT^BSDCCR4
+22 SET SDMD=$ORDER(^TMP("SD",$JOB,""))
SET SDMD=$ORDER(^TMP("SD",$JOB,SDMD))
SET SDMD=$LENGTH(SDMD)
+23 ;get next available wait times
IF SDPAST
DO NAVA^BSDCCR5(SDBDT,SDEDT,SDEX)
+24 IF SDOUT
GOTO EXIT^BSDCCR4
+25 DO ORD
DO PRT^BSDCCR3(0)
GOTO EXIT^BSDCCR4
+26 ;
ORD ;Build list to order clinic output
+1 SET SDIV=""
FOR
SET SDIV=$ORDER(^TMP("SD",$JOB,SDIV))
IF SDIV=""!SDOUT
QUIT
Begin DoDot:1
+2 ;S SDCP=0 F S SDCP=$O(^TMP("SD",$J,SDIV,SDCP)) Q:'SDCP!SDOUT D cmi/maw 11/9/2009 PATCH 1011 orig line
+3 ;cmi/maw 11/9/2009 PATCH 1011
SET SDCP=0
FOR
SET SDCP=$ORDER(^TMP("SD",$JOB,SDIV,SDCP))
IF SDCP=""!SDOUT
QUIT
Begin DoDot:2
+4 SET SC=0
FOR
SET SC=$ORDER(^TMP("SD",$JOB,SDIV,SDCP,SC))
IF 'SC!SDOUT
QUIT
Begin DoDot:3
+5 SET SCNA=$PIECE($GET(^SC(SC,0)),U)
IF '$LENGTH(SCNA)
SET SCNA="UNKNOWN"
+6 SET ^TMP("SDS",$JOB,SDCP,SCNA,SC)=""
+7 QUIT
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
OE(SDBDT,SDEDT,MAX,SDEX) ;Count clinic workload
+1 ;Input: SDBDT=begin date
+2 ;Input: SDEDT=end date
+3 ;Input: MAX=number of days in date range
+4 ;Input: SDEX='0' for user report, '1' for Austin extract
+5 NEW SDT,SDOE,SDOE0,SDCT,SDCP,SDQUIT
SET (SDQUIT,SDCT)=0
SET SDT=SDBDT
+6 FOR
SET SDT=$ORDER(^SCE("B",SDT))
IF 'SDT!(SDT>SDEDT)!SDOUT
QUIT
Begin DoDot:1
+7 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("B",SDT,SDOE))
IF 'SDOE!SDOUT
QUIT
Begin DoDot:2
+8 SET SDCT=SDCT+1
IF SDCT#1000=0
DO STOP
IF SDOUT
QUIT
+9 SET SDOE0=$$GETOE^SDOE(SDOE)
IF $PIECE(SDOE0,U,6)
QUIT
IF $PIECE(SDOE0,U,12)=12
QUIT
+10 SET SC=$PIECE(SDOE0,U,4)
IF 'SC
QUIT
IF '$$DIV(+$PIECE(SDOE0,U,11))
QUIT
+11 SET SC0=$GET(^SC(SC,0))
IF '$LENGTH($PIECE(SC0,U))
QUIT
+12 IF $PIECE(SC0,U,17)="Y"
QUIT
IF '$$CPAIR^BSDCCR1(SC0,.SDCP)
QUIT
+13 ;
+14 ;IHS/ANMC/LJF 8/24/2001 check clinic for summary report too
+15 ;I SDFMT="D",'SDEX S SDQUIT=0 D Q:SDQUIT
+16 ;.I SDSORT="CL",'$D(SDSORT($P(SC0,U))) S SDQUIT=1 Q
+17 ;.I SDSORT="CP",'$D(SDSORT(SDCP)) S SDQUIT=1
+18 ;.Q
+19 IF SDSORT="CL"
IF '$DATA(SDSORT($PIECE(SC0,U)))
SET SDQUIT=1
QUIT
+20 IF SDSORT="CP"
IF '$DATA(SDSORT(SDCP))
SET SDQUIT=1
+21 ;IHS/ANMC/LJF 8/24/2001 end of mods
+22 ;
+23 SET SDIV=$$DIV^BSDCCR1(SC0)
+24 IF '$DATA(^TMP("SD",$JOB,SDIV,SDCP,SC))
DO ARRINI^BSDCCR1(SDCP,SC,MAX,SDPAST)
+25 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)+1
+26 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)+1
+27 IF SDFMT'="D"
QUIT
SET X1=$PIECE(SDT,".")
SET X2=SDBDT
DO ^%DTC
SET SDAY=X+1
+28 DO ARRSET(SDCP,SC,SDAY)
QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 QUIT
+31 ;
ARRSET(SDCP,SC,SDI) ;Set daily counts into array
+1 ;Input: SDCP=credit pair
+2 ;Input: SC=clinic ifn
+3 ;Input: SDI=number of days from report date
+4 NEW SDS,SDP,SDX
+5 SET SDS=SDI-1\12
SET SDP=SDI#12
IF SDP=0
SET SDP=12
+6 SET SDX=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC,SDS),U,SDP)
+7 IF '$LENGTH(SDX)
SET SDX="0~0~0"
+8 SET $PIECE(SDX,"~",3)=$PIECE(SDX,"~",3)+1
+9 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC,SDS),U,SDP)=SDX
+10 QUIT
+11 ;
DIV(SDIV) ;Evaluate division
+1 IF 'SDDIV
QUIT 1
QUIT $DATA(SDDIV(SDIV))
+2 ;
CL ;Evaluate list of clinics
+1 NEW SDCNAM,SC0,SDIV
SET SDI=0
+2 SET SDCNAM=""
FOR
SET SDCNAM=$ORDER(SDSORT(SDCNAM))
IF SDCNAM=""!SDOUT
QUIT
Begin DoDot:1
+3 SET SDI=SDI+1
IF SDI#10=0
DO STOP
IF SDOUT
QUIT
+4 SET SC=SDSORT(SDCNAM)
SET SC0=$GET(^SC(SC,0))
IF '$$DIV(+$PIECE(SC0,U,15))
QUIT
+5 SET SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
+6 IF $PIECE(SDX,U,3)=-1
Begin DoDot:2
+7 SET SDIV=$$DIV^BSDCCR1(SC0)
+8 IF $LENGTH(SDIV)
SET $PIECE(^TMP("SD",$JOB,SDIV,SDCNAM),U,3)=$PIECE(SDX,U,3,4)
QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
CP ;Evaluate list of credit pairs
+1 NEW SDCCP,SC,SC0
SET SC=0
+2 FOR
SET SC=$ORDER(^SC(SC))
IF 'SC!SDOUT
QUIT
Begin DoDot:1
+3 SET SC0=$GET(^SC(SC,0))
IF '$$DIV(+$PIECE(SC0,U,15))
QUIT
+4 ;IHS/ANMC/LJF 12/13/2001 must be a clinic
IF $PIECE(SC0,U,3)'="C"
QUIT
+5 ;IHS/ANMC/LJF 04/11/2002 must have clinic code
IF $PIECE(SC0,U,7)=""
QUIT
+6 IF '$$CPAIR^BSDCCR1(SC0,.SDCCP)!'$DATA(SDSORT(SDCCP))
QUIT
+7 SET SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
STOP ;Check for stop task request
+1 IF $DATA(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
HINI ;Initialize header variables
+1 NEW %,%H,%I,X,X1,X2
+2 ;S SDLINE="",$P(SDLINE,"-",$S(SDPAST:131,1:(SDIOM+1)))="",SDPAGE=1,SDPG=0 ;IHS/ANMC/LJF 10/6/2000
+3 ;IHS/ANMC/LJF 10/6/2000
SET SDLINE=""
SET $PIECE(SDLINE,"-",$SELECT(SDPAST:80,1:(SDIOM+1)))=""
SET SDPAGE=1
SET SDPG=0
+4 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET SDPNOW=$PIECE(Y,":",1,2)
+5 ;S SDTITL="<*> Clinic Appointment Availability Report <*>" ;IHS/ANMC/LF 10/6/2000
+6 ;IHS/ANMC/LJF 10/6/2000
SET SDTITL="<*> Clinic Appointment Capacity Report <*>"
+7 QUIT
+8 ;
HDR(SDTY,SDIV,SDCP,SC) ;Print header
+1 ;Input: SDTY=type of header where:
+2 ; '0'=negative report
+3 ; '1'=detailed report
+4 ; '2'=division summary
+5 ; '3'=facility summary
+6 ;Input: SDIV=division name^division number
+7 ;Input: SDCP=credit pair
+8 ;Input: SC=clinic ifn
+9 ;
+10 IF SDOUT
QUIT
+11 IF $GET(SDXM)
DO HDRXM^BSDCCR3
QUIT
+12 IF $EXTRACT(IOST)="C"
IF SDPAGE>1
NEW DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
SET SDOUT=Y'=1
IF SDOUT
QUIT
+13 NEW SDX,SDI
DO STOP
IF SDOUT
QUIT
+14 IF SDPG!($EXTRACT(IOST)="C")
WRITE $$XY^SCRPW50(IOF,1,0)
IF $X
WRITE $$XY^SCRPW50("",0,0)
+15 WRITE SDLINE,!?(SDIOM-$LENGTH(SDTITL)\2),SDTITL
+16 DO HDRX(SDTY)
IF SDOUT
QUIT
SET SDI=0
+17 FOR
SET SDI=$ORDER(SDTIT(SDI))
IF 'SDI
QUIT
WRITE !?(SDIOM-$LENGTH(SDTIT(SDI))\2),SDTIT(SDI)
+18 WRITE !,SDLINE,!,"For clinic availability dates ",SDPBDT," through ",SDPEDT
+19 WRITE !,"Date printed: ",SDPNOW,?(SDIOM-6-$LENGTH(SDPAGE)),"Page: ",SDPAGE
+20 WRITE !,SDLINE
SET SDPAGE=SDPAGE+1
SET SDPG=1
IF SDTY
DO SUBT(SDTY)
QUIT
+21 ;
HDRX(SDTY) ;Extra header lines
+1 KILL SDTIT
+2 IF SDTY=0
QUIT
SET SDIV=$GET(SDIV)
+3 IF SDTY=3
SET SDTIT(1)="Facility Summary"
QUIT
+4 NEW SDDV
SET SDDV=$PIECE(SDIV,U)_" ("_$PIECE(SDIV,U,2)_")"
+5 IF SDTY=2
SET SDTIT(1)="Summary for division: "_SDDV
QUIT
+6 SET SDTIT(1)="Division: "_SDDV
+7 ;S:SDSORT="CP" SDTIT(2)="For clinics with credit pair: "_$$OTX^BSDCCR3("CP") ;IHS/ANMC/LJF 10/6/2000
+8 ;IHS/ANMC/LJF 10/6/2000
IF SDSORT="CP"
SET SDTIT(2)="For clinics with clinic code: "_$$OTX^BSDCCR3("CP")
SET SDTIT(3)="Detail for clinic: "_$$OTX^BSDCCR3("CL")
+9 QUIT
+10 ;
SUBT(SDTY) ;Print subtitles
+1 ;IHS/ANMC/LJF 10/6/2000
DO SUBT^BSDCCRL(SDTY)
QUIT
+2 NEW SDI
+3 WRITE !?(SDCOL+44),"Avail.",?(SDCOL+54),"Pct."
+4 IF SDPAST
FOR SDI=0:1:3
WRITE ?(SDCOL+68+(16*SDI)),"---Type '",SDI,"'---"
+5 WRITE !
IF SDTY>1
WRITE ?(SDCOL),"Credit Pair"
+6 WRITE ?(SDCOL+36),"Clinic",?(SDCOL+45),"Appt.",?(SDCOL+53),"Slots"
+7 IF SDPAST
WRITE ?(SDCOL+60),"Clinic"
+8 IF SDPAST
FOR SDI=0:1:3
WRITE ?(SDCOL+68+(16*SDI)),"Sched. Wait"
+9 WRITE !?(SDCOL+4),$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
+10 WRITE ?(SDCOL+34),"Capacity",?(SDCOL+45),"Slots",?(SDCOL+52),"Avail."
+11 IF SDPAST
WRITE ?(SDCOL+62),"Enc."
+12 IF SDPAST
FOR SDI=0:1:3
WRITE ?(SDCOL+68+(16*SDI)),"Appts. Time"
+13 WRITE !?($SELECT(SDTY>1:SDCOL,1:SDCOL+4)),$EXTRACT(SDLINE,1,($SELECT(SDPAST:130,1:58)-$SELECT(SDTY=1:4,1:0)))
+14 QUIT
+15 ;
+1 NEW SDBEG,SDEND,SDTIME,SDCP,SDX,SC,SCNA,SDI,SDFMT,SDOUT,SDXM,SDIOM
+2 NEW SDEXDT,MAX,X1,X2,X
SET SDIOM=$GET(IOM,80)
+3 SET (SDOUT,SDCOL)=0
SET SDFMT="D"
SET SDBEG=$HOROLOG
SET SDEXDT=DT
DO INIT^BSDCCR1
+4 KILL ^TMP("SD",$JOB),^TMP("SDS",$JOB),^TMP("SDTMP",$JOB),^TMP("SDXM",$JOB)
+5 SET X1=SDEDT
SET X2=SDBDT
DO ^%DTC
SET MAX=X+1
+6 ;
+7 ;Get encounter workload
+8 ;encounter workload
IF SDPAST
DO OE(SDBDT,SDEDT_.9999,MAX,1)
+9 ;
+10 ;Get clinic availability data
+11 SET SC=0
FOR
SET SC=$ORDER(^SC(SC))
IF 'SC
QUIT
SET SC0=$GET(^SC(SC,0))
Begin DoDot:1
+12 SET SDX=$$CLINIC^BSDCCR1(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
+13 QUIT
End DoDot:1
+14 ;
+15 ;Get next available wait times
+16 SET SDMD=$ORDER(^TMP("SD",$JOB,""))
SET SDMD=$ORDER(^TMP("SD",$JOB,SDMD))
SET SDMD=$LENGTH(SDMD)
+17 ;next ava. wait times
IF SDPAST
DO NAVA^BSDCCR5(SDBDT,SDEDT_.9999,1)
+18 ;
+19 ;Order by clinic, send extract data to Austin
+20 DO ORD
DO TXXM^BSDCCR0
KILL ^TMP("SDXM",$JOB)
+21 ;
+22 ;Send summary bulletin to mail group
+23 SET SDFMT="S"
SET SDEND=$HOROLOG
SET SDTIME=$$TIME(SDBEG,SDEND)
+24 SET SDBEG=$$HTE^XLFDT(SDBEG)
SET SDEND=$$HTE^XLFDT(SDEND)
+25 SET SDY="*** Clinic Appointment "_$SELECT(SDPAST:"Utilization",1:"Availability")_" Extract ***"
+26 SET SDXM=1
SET SDX=""
SET $EXTRACT(SDX,(79-$LENGTH(SDY)\2))=SDY
DO XMTX^BSDCCR3(SDX)
+27 DO XMTX^BSDCCR3(" ")
+28 DO XMTX^BSDCCR3(" For date range: "_SDPBDT_" to "_SDPEDT)
+29 DO XMTX^BSDCCR3(" Extract start time: "_SDBEG)
+30 DO XMTX^BSDCCR3(" Extract end time: "_SDEND)
+31 DO XMTX^BSDCCR3(" Extract run time: "_SDTIME)
+32 FOR SDI=1:1:4
DO XMTX^BSDCCR3("")
+33 DO PRT^BSDCCR3(SDXM)
DO EXXM^BSDCCR0("G.SC CLINIC WAIT TIME")
+34 GOTO EXIT^BSDCCR4
+35 ;
TIME(SDBEG,SDEND) ;Calculate length of run time
+1 ;Input: SDBEG=start time in $H format
+2 ;Input: SDEND=end time in $H format
+3 ;Output: text formatted string with # days, hours, minutes and seconds
+4 NEW X,Y
+5 SET SDEND=$PIECE(SDEND,",")-$PIECE(SDBEG,",")*86400+$PIECE(SDEND,",",2)
+6 SET SDBEG=$PIECE(SDBEG,",",2)
SET X=SDEND-SDBEG
SET Y("D")=X\86400
+7 SET X=X#86400
SET Y("H")=X\3600
SET X=X#3600
SET Y("M")=X\60
SET Y("S")=X#60
+8 SET Y("D")=$SELECT('Y("D"):"",1:Y("D")_" day"_$SELECT(Y("D")=1:"",1:"s")_", ")
+9 SET Y("H")=Y("H")_" hour"_$SELECT(Y("H")=1:"",1:"s")_", "
+10 SET Y("M")=Y("M")_" minute"_$SELECT(Y("M")=1:"",1:"s")_", "
+11 SET Y("S")=Y("S")_" second"_$SELECT(Y("S")=1:"",1:"s")
+12 QUIT Y("D")_Y("H")_Y("M")_Y("S")
