- 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")