| [613] | 1 | SDAMOWB ;ALB/CAW - Waiting Times Build Arrays; 8-NOV-93
|
|---|
| 2 | ;;5.3;Scheduling;**12**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | STORE(HOW,DIV,CLIN,STOP,DATE,PAT) ;save data in tmp variable
|
|---|
| 5 | ;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTIME^SDTTTIME
|
|---|
| 6 | ; 1 2 3 4 5 6 7 8 9 10
|
|---|
| 7 | ;calc times
|
|---|
| 8 | S SDWTTIME=$$MIN(SDCHKIN,SDT)
|
|---|
| 9 | S SDOTTIME=$$MIN(SDT,SDCHKOUT)
|
|---|
| 10 | S SDTTTIME=$$MIN(SDCHKIN,SDCHKOUT)
|
|---|
| 11 | D SET(HOW,CLIN,STOP,DATE,PAT)
|
|---|
| 12 | I "^1^2^5^"[(U_HOW_U) D
|
|---|
| 13 | .S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
|
|---|
| 14 | I "^3^4^"[(U_HOW_U) D
|
|---|
| 15 | .S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
|
|---|
| 16 | S SDX=$G(^TMP("SDWTTOT",$J,DIV,LEVEL1,"PRIM")) S ^("PRIM")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
|
|---|
| 17 | S SDX=$G(^TMP("SDWTTOTG",$J,"GRAND")) S ^("GRAND")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
|
|---|
| 18 | S SDX=$G(^TMP("SDWTTOTD",$J,SDDIV,"DIV")) S ^("DIV")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
|
|---|
| 19 | Q
|
|---|
| 20 | AUGMENT(WAIT,WAIT1,TOT,NODE) ;increment summary node
|
|---|
| 21 | ;NODE=#appts^cum min fm ci to appt^cum min fm appt to co^cum total min
|
|---|
| 22 | ; 1 2 3 4
|
|---|
| 23 | S $P(NODE,U,1)=$P(NODE,U,1)+1
|
|---|
| 24 | S $P(NODE,U,2)=$P(NODE,U,2)+WAIT
|
|---|
| 25 | S $P(NODE,U,3)=$P(NODE,U,3)+WAIT1
|
|---|
| 26 | S $P(NODE,U,4)=$P(NODE,U,4)+TOT
|
|---|
| 27 | Q NODE
|
|---|
| 28 | MIN(X,X1) ;difference between x & x1 in minutes
|
|---|
| 29 | ; for positive result, x is BEFORE x1
|
|---|
| 30 | ;
|
|---|
| 31 | N Y
|
|---|
| 32 | 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
|
|---|
| 33 | Q $G(Y)
|
|---|
| 34 | REJECT() ;set x conditions for rejection
|
|---|
| 35 | ; returns: 1|reject or 0|meets selection criteria
|
|---|
| 36 | N X
|
|---|
| 37 | I '$G(VAUTD),('$D(VAUTD(SDDIV))) S X=1 G QTRJ
|
|---|
| 38 | S X=1
|
|---|
| 39 | I $G(VAUTC)!($G(VAUTS)) S X=0 G QTRJ
|
|---|
| 40 | I $D(VAUTC(SDCLIN))!($D(VAUTS(SDSTOP))) S X=0 G QTRJ
|
|---|
| 41 | QTRJ Q X
|
|---|
| 42 | EXTERN(SORTV,X) ;returns the external value of sort variables
|
|---|
| 43 | ; SORTV: 1=CLINIC,2=STOP CODE,3=DAY OF WEEK
|
|---|
| 44 | ; X: Internal value
|
|---|
| 45 | N Y
|
|---|
| 46 | ;
|
|---|
| 47 | I SORTV=1 S Y=$P($G(^SC(X,0)),U,1)
|
|---|
| 48 | I SORTV=2 S Y=$P($G(^DIC(40.7,X,0)),U,2)
|
|---|
| 49 | I SORTV=3 S Y=$P($G(^DPT(DFN,0)),U)
|
|---|
| 50 | Q Y
|
|---|
| 51 | ;
|
|---|
| 52 | SET(HOW,CLIN,STOP,DATE,PAT) ; Set how the sort goes
|
|---|
| 53 | ; Input: HOW = which sort was selected
|
|---|
| 54 | ; CLIN = clinic ifn
|
|---|
| 55 | ; STOP = stop code ifn
|
|---|
| 56 | ; DATE = date in fm format
|
|---|
| 57 | ; PAT = patient ifn
|
|---|
| 58 | ; Output: LEVE1-LEVEL4 in external format
|
|---|
| 59 | ;
|
|---|
| 60 | I HOW=1 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=$$EXTERN(3,PAT),LEVEL3=DATE
|
|---|
| 61 | I HOW=2 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=DATE,LEVEL3=$$EXTERN(3,PAT)
|
|---|
| 62 | I HOW=3 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(1,CLIN),LEVEL3=$$EXTERN(3,PAT),LEVEL4=DATE
|
|---|
| 63 | I HOW=4 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(3,PAT),LEVEL3=$$EXTERN(1,CLIN),LEVEL4=DATE
|
|---|
| 64 | I HOW=5 S LEVEL1=$$EXTERN(3,DFN),LEVEL2=DATE,LEVEL3=$$EXTERN(1,CLIN)
|
|---|
| 65 | Q
|
|---|
