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

BSDCCR2.m

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