SDAMOWB ;ALB/CAW - Waiting Times Build Arrays; 8-NOV-93
;;5.3;Scheduling;**12**;Aug 13, 1993
;
STORE(HOW,DIV,CLIN,STOP,DATE,PAT) ;save data in tmp variable
;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTIME^SDTTTIME
; 1 2 3 4 5 6 7 8 9 10
;calc times
S SDWTTIME=$$MIN(SDCHKIN,SDT)
S SDOTTIME=$$MIN(SDT,SDCHKOUT)
S SDTTTIME=$$MIN(SDCHKIN,SDCHKOUT)
D SET(HOW,CLIN,STOP,DATE,PAT)
I "^1^2^5^"[(U_HOW_U) D
.S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
I "^3^4^"[(U_HOW_U) D
.S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
S SDX=$G(^TMP("SDWTTOT",$J,DIV,LEVEL1,"PRIM")) S ^("PRIM")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
S SDX=$G(^TMP("SDWTTOTG",$J,"GRAND")) S ^("GRAND")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
S SDX=$G(^TMP("SDWTTOTD",$J,SDDIV,"DIV")) S ^("DIV")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
Q
AUGMENT(WAIT,WAIT1,TOT,NODE) ;increment summary node
;NODE=#appts^cum min fm ci to appt^cum min fm appt to co^cum total min
; 1 2 3 4
S $P(NODE,U,1)=$P(NODE,U,1)+1
S $P(NODE,U,2)=$P(NODE,U,2)+WAIT
S $P(NODE,U,3)=$P(NODE,U,3)+WAIT1
S $P(NODE,U,4)=$P(NODE,U,4)+TOT
Q NODE
MIN(X,X1) ;difference between x & x1 in minutes
; for positive result, x is BEFORE x1
;
N Y
S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X I $P(X,".",1)'=$P(X1,".",1) S X2=X D ^%DTC S Y=X*1440+Y
Q $G(Y)
REJECT() ;set x conditions for rejection
; returns: 1|reject or 0|meets selection criteria
N X
I '$G(VAUTD),('$D(VAUTD(SDDIV))) S X=1 G QTRJ
S X=1
I $G(VAUTC)!($G(VAUTS)) S X=0 G QTRJ
I $D(VAUTC(SDCLIN))!($D(VAUTS(SDSTOP))) S X=0 G QTRJ
QTRJ Q X
EXTERN(SORTV,X) ;returns the external value of sort variables
; SORTV: 1=CLINIC,2=STOP CODE,3=DAY OF WEEK
; X: Internal value
N Y
;
I SORTV=1 S Y=$P($G(^SC(X,0)),U,1)
I SORTV=2 S Y=$P($G(^DIC(40.7,X,0)),U,2)
I SORTV=3 S Y=$P($G(^DPT(DFN,0)),U)
Q Y
;
SET(HOW,CLIN,STOP,DATE,PAT) ; Set how the sort goes
; Input: HOW = which sort was selected
; CLIN = clinic ifn
; STOP = stop code ifn
; DATE = date in fm format
; PAT = patient ifn
; Output: LEVE1-LEVEL4 in external format
;
I HOW=1 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=$$EXTERN(3,PAT),LEVEL3=DATE
I HOW=2 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=DATE,LEVEL3=$$EXTERN(3,PAT)
I HOW=3 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(1,CLIN),LEVEL3=$$EXTERN(3,PAT),LEVEL4=DATE
I HOW=4 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(3,PAT),LEVEL3=$$EXTERN(1,CLIN),LEVEL4=DATE
I HOW=5 S LEVEL1=$$EXTERN(3,DFN),LEVEL2=DATE,LEVEL3=$$EXTERN(1,CLIN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOWB 2815 printed Oct 16, 2024@18:48:42 Page 2
SDAMOWB ;ALB/CAW - Waiting Times Build Arrays; 8-NOV-93
+1 ;;5.3;Scheduling;**12**;Aug 13, 1993
+2 ;
STORE(HOW,DIV,CLIN,STOP,DATE,PAT) ;save data in tmp variable
+1 ;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTIME^SDTTTIME
+2 ; 1 2 3 4 5 6 7 8 9 10
+3 ;calc times
+4 SET SDWTTIME=$$MIN(SDCHKIN,SDT)
+5 SET SDOTTIME=$$MIN(SDT,SDCHKOUT)
+6 SET SDTTTIME=$$MIN(SDCHKIN,SDCHKOUT)
+7 DO SET(HOW,CLIN,STOP,DATE,PAT)
+8 IF "^1^2^5^"[(U_HOW_U)
Begin DoDot:1
+9 SET ^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2,LEVEL3)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
End DoDot:1
+10 IF "^3^4^"[(U_HOW_U)
Begin DoDot:1
+11 SET ^TMP("SDWAIT",$JOB,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
End DoDot:1
+12 SET SDX=$GET(^TMP("SDWTTOT",$JOB,DIV,LEVEL1,"PRIM"))
SET ^("PRIM")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
+13 SET SDX=$GET(^TMP("SDWTTOTG",$JOB,"GRAND"))
SET ^("GRAND")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
+14 SET SDX=$GET(^TMP("SDWTTOTD",$JOB,SDDIV,"DIV"))
SET ^("DIV")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
+15 QUIT
AUGMENT(WAIT,WAIT1,TOT,NODE) ;increment summary node
+1 ;NODE=#appts^cum min fm ci to appt^cum min fm appt to co^cum total min
+2 ; 1 2 3 4
+3 SET $PIECE(NODE,U,1)=$PIECE(NODE,U,1)+1
+4 SET $PIECE(NODE,U,2)=$PIECE(NODE,U,2)+WAIT
+5 SET $PIECE(NODE,U,3)=$PIECE(NODE,U,3)+WAIT1
+6 SET $PIECE(NODE,U,4)=$PIECE(NODE,U,4)+TOT
+7 QUIT NODE
MIN(X,X1) ;difference between x & x1 in minutes
+1 ; for positive result, x is BEFORE x1
+2 ;
+3 NEW Y
+4 SET Y=$EXTRACT(X1_"000",9,10)-$EXTRACT(X_"000",9,10)*60+$EXTRACT(X1_"00000",11,12)-$EXTRACT(X_"00000",11,12)
SET X2=X
IF $PIECE(X,".",1)'=$PIECE(X1,".",1)
SET X2=X
DO ^%DTC
SET Y=X*1440+Y
+5 QUIT $GET(Y)
REJECT() ;set x conditions for rejection
+1 ; returns: 1|reject or 0|meets selection criteria
+2 NEW X
+3 IF '$GET(VAUTD)
IF ('$DATA(VAUTD(SDDIV)))
SET X=1
GOTO QTRJ
+4 SET X=1
+5 IF $GET(VAUTC)!($GET(VAUTS))
SET X=0
GOTO QTRJ
+6 IF $DATA(VAUTC(SDCLIN))!($DATA(VAUTS(SDSTOP)))
SET X=0
GOTO QTRJ
QTRJ QUIT X
EXTERN(SORTV,X) ;returns the external value of sort variables
+1 ; SORTV: 1=CLINIC,2=STOP CODE,3=DAY OF WEEK
+2 ; X: Internal value
+3 NEW Y
+4 ;
+5 IF SORTV=1
SET Y=$PIECE($GET(^SC(X,0)),U,1)
+6 IF SORTV=2
SET Y=$PIECE($GET(^DIC(40.7,X,0)),U,2)
+7 IF SORTV=3
SET Y=$PIECE($GET(^DPT(DFN,0)),U)
+8 QUIT Y
+9 ;
SET(HOW,CLIN,STOP,DATE,PAT) ; Set how the sort goes
+1 ; Input: HOW = which sort was selected
+2 ; CLIN = clinic ifn
+3 ; STOP = stop code ifn
+4 ; DATE = date in fm format
+5 ; PAT = patient ifn
+6 ; Output: LEVE1-LEVEL4 in external format
+7 ;
+8 IF HOW=1
SET LEVEL1=$$EXTERN(1,CLIN)
SET LEVEL2=$$EXTERN(3,PAT)
SET LEVEL3=DATE
+9 IF HOW=2
SET LEVEL1=$$EXTERN(1,CLIN)
SET LEVEL2=DATE
SET LEVEL3=$$EXTERN(3,PAT)
+10 IF HOW=3
SET LEVEL1=$$EXTERN(2,STOP)
SET LEVEL2=$$EXTERN(1,CLIN)
SET LEVEL3=$$EXTERN(3,PAT)
SET LEVEL4=DATE
+11 IF HOW=4
SET LEVEL1=$$EXTERN(2,STOP)
SET LEVEL2=$$EXTERN(3,PAT)
SET LEVEL3=$$EXTERN(1,CLIN)
SET LEVEL4=DATE
+12 IF HOW=5
SET LEVEL1=$$EXTERN(3,DFN)
SET LEVEL2=DATE
SET LEVEL3=$$EXTERN(1,CLIN)
+13 QUIT
