SCRPW72 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/23/03 12:16pm
;;5.3;Scheduling;**192,206,223,241,249,291**;AUG 13, 1993
;
START ;Gather data for printed report
N SDCP,SC,SCNA,SDI,SDOUT,SDPAST,SDXM,MAX,X1,X2,X,SDIOM,SDFOOT
I $E(IOST)="C" D WAIT^DICD
S (SDOUT,SDI)=0,SDIOM=$G(IOM,80)
S SDPAST=SDBDT'>DT S:SDPAST SDIOM=130
D HINI^SCRPW76,FOOT^SCRPW77(.SDFOOT)
K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDTOT",$J)
I $G(SDREPORT(4)) K ^TMP("SDPLIST",$J)
I $G(SDREPORT(5)) D
.N CC F CC="SDIPLST","SDIP","SDORD" K ^TMP(CC,$J)
D INIT^SCRPW71 S SDCOL=$S(SDPAST:0,1:(SDIOM-58\2))
S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
I SDPAST I '$G(SDREPORT(5)) D OE(SDBDT,SDEDT,MAX,0) Q:SDOUT ;get outpt. enc. workload
G:SDOUT EXIT^SCRPW74
I $G(SDFMT)="D"!($G(SDFMTS)="CP") D
.I $G(SDREPORT(5)) D CA(.SDSORT) Q
.D @SDSORT
I $G(SDFMT)="S"&($G(SDFMTS)'="CP") 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^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
G:SDOUT EXIT^SCRPW74
S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
I SDPAST D NAVA^SCRPW75(SDBDT,SDEDT,SDEX) ;get next available wait times
G:SDOUT EXIT^SCRPW74
D ORD
I $E(IOST)="C" D END^SCRPW50
S SDREPORT=0 F S SDREPORT=$O(SDREPORT(SDREPORT)) Q:SDOUT!'SDREPORT D
.I SDREPORT(SDREPORT) S SDPAGE=1 D PRT^SCRPW73(0,SDREPORT)
G EXIT^SCRPW74
;
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
..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
;
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,SDAY,DFN
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 DFN=$P(SDOE0,U,2) Q:'DFN
..Q:$E($P($G(^DPT(DFN,0)),U,9),1,5)="00000" ;exclude test patients
..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^SCRPW71(SC0,.SDCP)
..I 'SDEX,$D(SDSORT) S SDQUIT=0 D Q:SDQUIT
...I SDSORT="CL"!(SDSORT="CA"),'$D(SDSORT($P(SC0,U))) S SDQUIT=1 Q
...I SDSORT="CP",'$D(SDSORT(SDCP)) S SDQUIT=1
..S SDIV=$$DIV^SCRPW71(SC0) Q:'$L(SDIV)
..I '$D(^TMP("SD",$J,SDIV,SDCP,SC)) D ARRINI^SCRPW71(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
;
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))
;
CA(SORT) ;Evaluate list of clinics for selected patient
N SDCNAM,SC0,SDIV,XX,DFN,SDIV,SDCP,SDPNAME S SDI=0
F XX=1:1:$G(SDPAT) S DFN=+^TMP("SDPAT",SDJN,XX),SDPNAME=$P(^(XX),U,2) D
.N SDDT S SDDT=SDBDT-1+.9999999 ; DATE/TIME APPT SCHEDULED
.F S SDDT=$O(^DPT(DFN,"S",SDDT)) Q:'SDDT!(SDDT>SDEDT) D
..S SDI=SDI+1 I SDI#10=0 D STOP Q:SDOUT
..S SC=+^DPT(DFN,"S",SDDT,0),SC0=$G(^SC(SC,0)) I '$$DIV(+$P(SC0,U,15)) Q
..Q:$P(SC0,U,17)="Y" ;non-count clinic
..S SDIV=$$DIV^SCRPW71(SC0)
..I '$$CPAIR^SCRPW71(SC0,.SDCP) Q
..I $G(SORT)="CP",'$D(SORT(SDCP)) Q ;selection by credit pairs
..I $G(SORT)="CL",'$D(SORT($P(SC0,U))) Q ; selection by list of clinics
..I $G(SDREPORT(5)) S ^TMP("SDIPLST",$J,DFN,SC)="",^TMP("SDIP",$J,$P(SDIV,U,2),SC)=SDCP_U_$P(SDIV,U),^TMP("SDORD",$J,SDPNAME,DFN)=""
..S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
Q
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))
.I $G(SDREPORT(4)) S ^TMP("SDPLIST",$J,SC)=""
.S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
.I $P(SDX,U,3)=-1 D
..S SDIV=$$DIV^SCRPW71(SC0)
..S:$L(SDIV) $P(^TMP("SD",$J,SDIV,SDCNAM),U,3)=$P(SDX,U,3,4) 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:'$$CPAIR^SCRPW71(SC0,.SDCCP)!'$D(SDSORT(SDCCP))
.I $G(SDREPORT(4)) S ^TMP("SDPLIST",$J,SC)=""
.S SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
Q
;
CNAME(SC) ;Massage clinic name
N SDX
;Default name value
S SDX=$P($G(^SC(SC,0)),U) Q:'$L(SDX) "UNKNOWN"
;Remove extract formatting characters
S SDX=$TR(SDX,"#$^~|")
;Uppercase name value
S SDX=$TR(SDX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q SDX
;
SORT(SDSORT) ;Gather sort values for detailed report
;Input: SDSORT=sort category (pass by reference)
;Output: '1' if selection(s) made, '0' otherwise
; SDSORT(clinic name)=clinic ifn
; (or)
; SDSORT(credit pair)=credit pair
;
N SDSX S SDSX="S"_SDSORT
I SDSORT="CA" Q 1
D @SDSX Q $D(SDSORT)>1
;
SCL ;Select clinics for detail
N DIC,SDQUIT S (SDQUIT,SDOUT)=0
S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select CLINIC: ",DIC("S")="I $P(^(0),U,3)=""C"""
W ! F Q:SDOUT!SDQUIT D
.D ^DIC I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
.I X="" S SDQUIT=1 Q
.I Y>0,$L($P(Y,U,2)) S SDSORT($P(Y,U,2))=+Y
Q
;
SCP ;Get credit pairs for detail
N DIR,SDQUIT S (SDQUIT,SDOUT)=0
S DIR(0)="NO:101000:999000:0",DIR("A")="Select clinic DSS credit pair"
S DIR("?",1)="Specify a six digit number that represents the primary and secondary stop"
S DIR("?",2)="code of clinics you wish to evaluate. For clinics that do not have a"
S DIR("?",3)="secondary stop code, enter ""000"" as the second half of the credit pair"
S DIR("?")="(eg. ""323000"")."
W ! F Q:SDOUT!SDQUIT D
.D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
.I X="" S SDQUIT=1 Q
.I '$$VCP(Y) W " Invalid credit pair!" Q
.S SDSORT(Y)=Y
Q
;
VCP(Y) ;Validate credit pair
;Input: Y=credit pair
;Output: '1' if valid, '0' otherwise
Q:Y'?6N 0
Q:'$D(^DIC(40.7,"C",$E(Y,1,3))) 0
Q:$E(Y,4,6)="000" 1
Q:'$D(^DIC(40.7,"C",$E(Y,4,6))) 0
Q 1
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
ADDL(SDZ) ;Format additional data
;Input: SDZ=addl. data from ^TMP("SDNAVB",^J,SDCP,SC)
;
N SDI,SDX S SDX=""
F SDI=1:1:7 S SDX=SDX_$S(SDI=5:"^",1:"~")_+$P(SDZ,U,SDI)
Q SDX
;
N SDBEG,SDEND,SDTIME,SDCP,SDX,SDY,SC,SCNA,SDI,SDFMT,SDOUT,SDXM,SDIOM,SDFOOT
N SDEXDT,MAX,X1,X2,X S SDIOM=$G(IOM,80)
F SDI=1,2,3 S SDREPORT(SDI)=1
S (SDOUT,SDCOL)=0,SDFMT="D",SDBEG=$H,SDEXDT=DT D INIT^SCRPW71
K ^TMP("SD",$J),^TMP("SDS",$J),^TMP("SDTMP",$J),^TMP("SDXM",$J)
S X1=SDEDT,X2=SDBDT D ^%DTC S MAX=X+1
D HINI^SCRPW76,FOOT^SCRPW77(.SDFOOT)
;
;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^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
;
;Get next available wait times
S SDMD=$O(^TMP("SD",$J,"")),SDMD=$O(^TMP("SD",$J,SDMD)),SDMD=$L(SDMD)
I SDPAST D NAVA^SCRPW75(SDBDT,SDEDT_.9999,1) ;next ava. wait times
;
;Order by clinic, send extract data to Austin
D ORD,TXXM^SCRPW70 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^SCRPW73(SDX)
D XMTX^SCRPW73(" ")
D XMTX^SCRPW73(" For date range: "_SDPBDT_" to "_SDPEDT)
D XMTX^SCRPW73(" Extract start time: "_SDBEG)
D XMTX^SCRPW73(" Extract end time: "_SDEND)
D XMTX^SCRPW73(" Extract run time: "_SDTIME)
D XMTX^SCRPW73(" Task number: "_$G(ZTSK))
F SDI=1:1:4 D XMTX^SCRPW73("")
D PRT^SCRPW73(SDXM,1),EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
I SDPAST F SDI=2,3 D
.K ^TMP("SDXM",$J) S SDXM=1
.D PRT^SCRPW73(SDXM,SDI),EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
G EXIT^SCRPW74
;
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")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW72 9689 printed Dec 13, 2024@02:44:04 Page 2
SCRPW72 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/23/03 12:16pm
+1 ;;5.3;Scheduling;**192,206,223,241,249,291**;AUG 13, 1993
+2 ;
START ;Gather data for printed report
+1 NEW SDCP,SC,SCNA,SDI,SDOUT,SDPAST,SDXM,MAX,X1,X2,X,SDIOM,SDFOOT
+2 IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+3 SET (SDOUT,SDI)=0
SET SDIOM=$GET(IOM,80)
+4 SET SDPAST=SDBDT'>DT
if SDPAST
SET SDIOM=130
+5 DO HINI^SCRPW76
DO FOOT^SCRPW77(.SDFOOT)
+6 KILL ^TMP("SD",$JOB),^TMP("SDS",$JOB),^TMP("SDTMP",$JOB),^TMP("SDTOT",$JOB)
+7 IF $GET(SDREPORT(4))
KILL ^TMP("SDPLIST",$JOB)
+8 IF $GET(SDREPORT(5))
Begin DoDot:1
+9 NEW CC
FOR CC="SDIPLST","SDIP","SDORD"
KILL ^TMP(CC,$JOB)
End DoDot:1
+10 DO INIT^SCRPW71
SET SDCOL=$SELECT(SDPAST:0,1:(SDIOM-58\2))
+11 SET X1=SDEDT
SET X2=SDBDT
DO ^%DTC
SET MAX=X+1
+12 ;get outpt. enc. workload
IF SDPAST
IF '$GET(SDREPORT(5))
DO OE(SDBDT,SDEDT,MAX,0)
if SDOUT
QUIT
+13 if SDOUT
GOTO EXIT^SCRPW74
+14 IF $GET(SDFMT)="D"!($GET(SDFMTS)="CP")
Begin DoDot:1
+15 IF $GET(SDREPORT(5))
DO CA(.SDSORT)
QUIT
+16 DO @SDSORT
End DoDot:1
+17 IF $GET(SDFMT)="S"&($GET(SDFMTS)'="CP")
SET SC=0
FOR
SET SC=$ORDER(^SC(SC))
if 'SC!SDOUT
QUIT
Begin DoDot:1
+18 SET SDI=SDI+1
IF SDI#25=0
DO STOP
if SDOUT
QUIT
+19 SET SC0=$GET(^SC(SC,0))
if '$$DIV(+$PIECE(SC0,U,15))
QUIT
+20 SET SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
End DoDot:1
+21 if SDOUT
GOTO EXIT^SCRPW74
+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^SCRPW75(SDBDT,SDEDT,SDEX)
+24 if SDOUT
GOTO EXIT^SCRPW74
+25 DO ORD
+26 IF $EXTRACT(IOST)="C"
DO END^SCRPW50
+27 SET SDREPORT=0
FOR
SET SDREPORT=$ORDER(SDREPORT(SDREPORT))
if SDOUT!'SDREPORT
QUIT
Begin DoDot:1
+28 IF SDREPORT(SDREPORT)
SET SDPAGE=1
DO PRT^SCRPW73(0,SDREPORT)
End DoDot:1
+29 GOTO EXIT^SCRPW74
+30 ;
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 SET SDCP=0
FOR
SET SDCP=$ORDER(^TMP("SD",$JOB,SDIV,SDCP))
if 'SDCP!SDOUT
QUIT
Begin DoDot:2
+3 SET SC=0
FOR
SET SC=$ORDER(^TMP("SD",$JOB,SDIV,SDCP,SC))
if 'SC!SDOUT
QUIT
Begin DoDot:3
+4 SET SCNA=$PIECE($GET(^SC(SC,0)),U)
if '$LENGTH(SCNA)
SET SCNA="UNKNOWN"
+5 SET ^TMP("SDS",$JOB,SDCP,SCNA,SC)=""
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
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,SDAY,DFN
+6 SET (SDQUIT,SDCT)=0
SET SDT=SDBDT
+7 FOR
SET SDT=$ORDER(^SCE("B",SDT))
if 'SDT!(SDT>SDEDT)!SDOUT
QUIT
Begin DoDot:1
+8 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("B",SDT,SDOE))
if 'SDOE!SDOUT
QUIT
Begin DoDot:2
+9 SET SDCT=SDCT+1
IF SDCT#1000=0
DO STOP
if SDOUT
QUIT
+10 SET SDOE0=$$GETOE^SDOE(SDOE)
if $PIECE(SDOE0,U,6)
QUIT
if $PIECE(SDOE0,U,12)=12
QUIT
+11 SET DFN=$PIECE(SDOE0,U,2)
if 'DFN
QUIT
+12 ;exclude test patients
if $EXTRACT($PIECE($GET(^DPT(DFN,0)),U,9),1,5)="00000"
QUIT
+13 SET SC=$PIECE(SDOE0,U,4)
if 'SC
QUIT
if '$$DIV(+$PIECE(SDOE0,U,11))
QUIT
+14 SET SC0=$GET(^SC(SC,0))
if '$LENGTH($PIECE(SC0,U))
QUIT
+15 if $PIECE(SC0,U,17)="Y"
QUIT
if '$$CPAIR^SCRPW71(SC0,.SDCP)
QUIT
+16 IF 'SDEX
IF $DATA(SDSORT)
SET SDQUIT=0
Begin DoDot:3
+17 IF SDSORT="CL"!(SDSORT="CA")
IF '$DATA(SDSORT($PIECE(SC0,U)))
SET SDQUIT=1
QUIT
+18 IF SDSORT="CP"
IF '$DATA(SDSORT(SDCP))
SET SDQUIT=1
End DoDot:3
if SDQUIT
QUIT
+19 SET SDIV=$$DIV^SCRPW71(SC0)
if '$LENGTH(SDIV)
QUIT
+20 IF '$DATA(^TMP("SD",$JOB,SDIV,SDCP,SC))
DO ARRINI^SCRPW71(SDCP,SC,MAX,SDPAST)
+21 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)+1
+22 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)+1
+23 if SDFMT'="D"
QUIT
SET X1=$PIECE(SDT,".")
SET X2=SDBDT
DO ^%DTC
SET SDAY=X+1
+24 DO ARRSET(SDCP,SC,SDAY)
QUIT
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
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 ;
CA(SORT) ;Evaluate list of clinics for selected patient
+1 NEW SDCNAM,SC0,SDIV,XX,DFN,SDIV,SDCP,SDPNAME
SET SDI=0
+2 FOR XX=1:1:$GET(SDPAT)
SET DFN=+^TMP("SDPAT",SDJN,XX)
SET SDPNAME=$PIECE(^(XX),U,2)
Begin DoDot:1
+3 ; DATE/TIME APPT SCHEDULED
NEW SDDT
SET SDDT=SDBDT-1+.9999999
+4 FOR
SET SDDT=$ORDER(^DPT(DFN,"S",SDDT))
if 'SDDT!(SDDT>SDEDT)
QUIT
Begin DoDot:2
+5 SET SDI=SDI+1
IF SDI#10=0
DO STOP
if SDOUT
QUIT
+6 SET SC=+^DPT(DFN,"S",SDDT,0)
SET SC0=$GET(^SC(SC,0))
IF '$$DIV(+$PIECE(SC0,U,15))
QUIT
+7 ;non-count clinic
if $PIECE(SC0,U,17)="Y"
QUIT
+8 SET SDIV=$$DIV^SCRPW71(SC0)
+9 IF '$$CPAIR^SCRPW71(SC0,.SDCP)
QUIT
+10 ;selection by credit pairs
IF $GET(SORT)="CP"
IF '$DATA(SORT(SDCP))
QUIT
+11 ; selection by list of clinics
IF $GET(SORT)="CL"
IF '$DATA(SORT($PIECE(SC0,U)))
QUIT
+12 IF $GET(SDREPORT(5))
SET ^TMP("SDIPLST",$JOB,DFN,SC)=""
SET ^TMP("SDIP",$JOB,$PIECE(SDIV,U,2),SC)=SDCP_U_$PIECE(SDIV,U)
SET ^TMP("SDORD",$JOB,SDPNAME,DFN)=""
+13 SET SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
End DoDot:2
End DoDot:1
+14 QUIT
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 IF $GET(SDREPORT(4))
SET ^TMP("SDPLIST",$JOB,SC)=""
+6 SET SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
+7 IF $PIECE(SDX,U,3)=-1
Begin DoDot:2
+8 SET SDIV=$$DIV^SCRPW71(SC0)
+9 if $LENGTH(SDIV)
SET $PIECE(^TMP("SD",$JOB,SDIV,SDCNAM),U,3)=$PIECE(SDX,U,3,4)
QUIT
End DoDot:2
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 if '$$CPAIR^SCRPW71(SC0,.SDCCP)!'$DATA(SDSORT(SDCCP))
QUIT
+5 IF $GET(SDREPORT(4))
SET ^TMP("SDPLIST",$JOB,SC)=""
+6 SET SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
End DoDot:1
+7 QUIT
+8 ;
CNAME(SC) ;Massage clinic name
+1 NEW SDX
+2 ;Default name value
+3 SET SDX=$PIECE($GET(^SC(SC,0)),U)
if '$LENGTH(SDX)
QUIT "UNKNOWN"
+4 ;Remove extract formatting characters
+5 SET SDX=$TRANSLATE(SDX,"#$^~|")
+6 ;Uppercase name value
+7 SET SDX=$TRANSLATE(SDX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+8 QUIT SDX
+9 ;
SORT(SDSORT) ;Gather sort values for detailed report
+1 ;Input: SDSORT=sort category (pass by reference)
+2 ;Output: '1' if selection(s) made, '0' otherwise
+3 ; SDSORT(clinic name)=clinic ifn
+4 ; (or)
+5 ; SDSORT(credit pair)=credit pair
+6 ;
+7 NEW SDSX
SET SDSX="S"_SDSORT
+8 IF SDSORT="CA"
QUIT 1
+9 DO @SDSX
QUIT $DATA(SDSORT)>1
+10 ;
SCL ;Select clinics for detail
+1 NEW DIC,SDQUIT
SET (SDQUIT,SDOUT)=0
+2 SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Select CLINIC: "
SET DIC("S")="I $P(^(0),U,3)=""C"""
+3 WRITE !
FOR
if SDOUT!SDQUIT
QUIT
Begin DoDot:1
+4 DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+5 IF X=""
SET SDQUIT=1
QUIT
+6 IF Y>0
IF $LENGTH($PIECE(Y,U,2))
SET SDSORT($PIECE(Y,U,2))=+Y
End DoDot:1
+7 QUIT
+8 ;
SCP ;Get credit pairs for detail
+1 NEW DIR,SDQUIT
SET (SDQUIT,SDOUT)=0
+2 SET DIR(0)="NO:101000:999000:0"
SET DIR("A")="Select clinic DSS credit pair"
+3 SET DIR("?",1)="Specify a six digit number that represents the primary and secondary stop"
+4 SET DIR("?",2)="code of clinics you wish to evaluate. For clinics that do not have a"
+5 SET DIR("?",3)="secondary stop code, enter ""000"" as the second half of the credit pair"
+6 SET DIR("?")="(eg. ""323000"")."
+7 WRITE !
FOR
if SDOUT!SDQUIT
QUIT
Begin DoDot:1
+8 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+9 IF X=""
SET SDQUIT=1
QUIT
+10 IF '$$VCP(Y)
WRITE " Invalid credit pair!"
QUIT
+11 SET SDSORT(Y)=Y
End DoDot:1
+12 QUIT
+13 ;
VCP(Y) ;Validate credit pair
+1 ;Input: Y=credit pair
+2 ;Output: '1' if valid, '0' otherwise
+3 if Y'?6N
QUIT 0
+4 if '$DATA(^DIC(40.7,"C",$EXTRACT(Y,1,3)))
QUIT 0
+5 if $EXTRACT(Y,4,6)="000"
QUIT 1
+6 if '$DATA(^DIC(40.7,"C",$EXTRACT(Y,4,6)))
QUIT 0
+7 QUIT 1
+8 ;
STOP ;Check for stop task request
+1 if $DATA(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
ADDL(SDZ) ;Format additional data
+1 ;Input: SDZ=addl. data from ^TMP("SDNAVB",^J,SDCP,SC)
+2 ;
+3 NEW SDI,SDX
SET SDX=""
+4 FOR SDI=1:1:7
SET SDX=SDX_$SELECT(SDI=5:"^",1:"~")_+$PIECE(SDZ,U,SDI)
+5 QUIT SDX
+6 ;
+1 NEW SDBEG,SDEND,SDTIME,SDCP,SDX,SDY,SC,SCNA,SDI,SDFMT,SDOUT,SDXM,SDIOM,SDFOOT
+2 NEW SDEXDT,MAX,X1,X2,X
SET SDIOM=$GET(IOM,80)
+3 FOR SDI=1,2,3
SET SDREPORT(SDI)=1
+4 SET (SDOUT,SDCOL)=0
SET SDFMT="D"
SET SDBEG=$HOROLOG
SET SDEXDT=DT
DO INIT^SCRPW71
+5 KILL ^TMP("SD",$JOB),^TMP("SDS",$JOB),^TMP("SDTMP",$JOB),^TMP("SDXM",$JOB)
+6 SET X1=SDEDT
SET X2=SDBDT
DO ^%DTC
SET MAX=X+1
+7 DO HINI^SCRPW76
DO FOOT^SCRPW77(.SDFOOT)
+8 ;
+9 ;Get encounter workload
+10 ;encounter workload
IF SDPAST
DO OE(SDBDT,SDEDT_.9999,MAX,1)
+11 ;
+12 ;Get clinic availability data
+13 SET SC=0
FOR
SET SC=$ORDER(^SC(SC))
if 'SC
QUIT
SET SC0=$GET(^SC(SC,0))
Begin DoDot:1
+14 SET SDX=$$CLINIC^SCRPW71(SC,SDFMT,SDBDT,SDEDT,MAX,SDPAST)
End DoDot:1
+15 ;
+16 ;Get next available wait times
+17 SET SDMD=$ORDER(^TMP("SD",$JOB,""))
SET SDMD=$ORDER(^TMP("SD",$JOB,SDMD))
SET SDMD=$LENGTH(SDMD)
+18 ;next ava. wait times
IF SDPAST
DO NAVA^SCRPW75(SDBDT,SDEDT_.9999,1)
+19 ;
+20 ;Order by clinic, send extract data to Austin
+21 DO ORD
DO TXXM^SCRPW70
KILL ^TMP("SDXM",$JOB)
+22 ;
+23 ;Send summary bulletin to mail group
+24 SET SDFMT="S"
SET SDEND=$HOROLOG
SET SDTIME=$$TIME(SDBEG,SDEND)
+25 SET SDBEG=$$HTE^XLFDT(SDBEG)
SET SDEND=$$HTE^XLFDT(SDEND)
+26 SET SDY="*** Clinic Appointment "_$SELECT(SDPAST:"Utilization",1:"Availability")_" Extract ***"
+27 SET SDXM=1
SET SDX=""
SET $EXTRACT(SDX,(79-$LENGTH(SDY)\2))=SDY
DO XMTX^SCRPW73(SDX)
+28 DO XMTX^SCRPW73(" ")
+29 DO XMTX^SCRPW73(" For date range: "_SDPBDT_" to "_SDPEDT)
+30 DO XMTX^SCRPW73(" Extract start time: "_SDBEG)
+31 DO XMTX^SCRPW73(" Extract end time: "_SDEND)
+32 DO XMTX^SCRPW73(" Extract run time: "_SDTIME)
+33 DO XMTX^SCRPW73(" Task number: "_$GET(ZTSK))
+34 FOR SDI=1:1:4
DO XMTX^SCRPW73("")
+35 DO PRT^SCRPW73(SDXM,1)
DO EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
+36 IF SDPAST
FOR SDI=2,3
Begin DoDot:1
+37 KILL ^TMP("SDXM",$JOB)
SET SDXM=1
+38 DO PRT^SCRPW73(SDXM,SDI)
DO EXXM^SCRPW70("G.SC CLINIC WAIT TIME")
End DoDot:1
+39 GOTO EXIT^SCRPW74
+40 ;
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")
