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

SDAMOWB.m

Go to the documentation of this file.
  1. SDAMOWB ;ALB/CAW - Waiting Times Build Arrays; 8-NOV-93
  1. ;;5.3;Scheduling;**12,1015**;Aug 13, 1993;Build 21
  1. ;
  1. STORE(HOW,DIV,CLIN,STOP,DATE,PAT) ;save data in tmp variable
  1. ;SDCLIN^SDSTOP^SDDAY^SDDIV^DFN^SDCHKIN^SDCHKOUT^SDWTTIME^SDOTIME^SDTTTIME
  1. ; 1 2 3 4 5 6 7 8 9 10
  1. ;calc times
  1. S SDWTTIME=$$MIN(SDCHKIN,SDT)
  1. S SDOTTIME=$$MIN(SDT,SDCHKOUT)
  1. S SDTTTIME=$$MIN(SDCHKIN,SDCHKOUT)
  1. D SET(HOW,CLIN,STOP,DATE,PAT)
  1. I "^1^2^5^"[(U_HOW_U) D
  1. .S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
  1. I "^3^4^"[(U_HOW_U) D
  1. .S ^TMP("SDWAIT",$J,DIV,LEVEL1,LEVEL2,LEVEL3,LEVEL4)=SDDATA_U_SDWTTIME_U_SDOTTIME_U_SDTTTIME
  1. S SDX=$G(^TMP("SDWTTOT",$J,DIV,LEVEL1,"PRIM")) S ^("PRIM")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
  1. S SDX=$G(^TMP("SDWTTOTG",$J,"GRAND")) S ^("GRAND")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
  1. S SDX=$G(^TMP("SDWTTOTD",$J,SDDIV,"DIV")) S ^("DIV")=$$AUGMENT(SDWTTIME,SDOTTIME,SDTTTIME,SDX)
  1. Q
  1. 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
  1. ; 1 2 3 4
  1. S $P(NODE,U,1)=$P(NODE,U,1)+1
  1. S $P(NODE,U,2)=$P(NODE,U,2)+WAIT
  1. S $P(NODE,U,3)=$P(NODE,U,3)+WAIT1
  1. S $P(NODE,U,4)=$P(NODE,U,4)+TOT
  1. Q NODE
  1. MIN(X,X1) ;difference between x & x1 in minutes
  1. ; for positive result, x is BEFORE x1
  1. ;
  1. N Y
  1. 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
  1. Q $G(Y)
  1. REJECT() ;set x conditions for rejection
  1. ; returns: 1|reject or 0|meets selection criteria
  1. N X
  1. I '$G(VAUTD),('$D(VAUTD(SDDIV))) S X=1 G QTRJ
  1. S X=1
  1. I $G(VAUTC)!($G(VAUTS)) S X=0 G QTRJ
  1. I $D(VAUTC(SDCLIN))!($D(VAUTS(SDSTOP))) S X=0 G QTRJ
  1. QTRJ Q X
  1. EXTERN(SORTV,X) ;returns the external value of sort variables
  1. ; SORTV: 1=CLINIC,2=STOP CODE,3=DAY OF WEEK
  1. ; X: Internal value
  1. N Y
  1. ;
  1. I SORTV=1 S Y=$P($G(^SC(X,0)),U,1)
  1. I SORTV=2 S Y=$P($G(^DIC(40.7,X,0)),U,2)
  1. I SORTV=3 S Y=$P($G(^DPT(DFN,0)),U)
  1. Q Y
  1. ;
  1. SET(HOW,CLIN,STOP,DATE,PAT) ; Set how the sort goes
  1. ; Input: HOW = which sort was selected
  1. ; CLIN = clinic ifn
  1. ; STOP = stop code ifn
  1. ; DATE = date in fm format
  1. ; PAT = patient ifn
  1. ; Output: LEVE1-LEVEL4 in external format
  1. ;
  1. I HOW=1 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=$$EXTERN(3,PAT),LEVEL3=DATE
  1. I HOW=2 S LEVEL1=$$EXTERN(1,CLIN),LEVEL2=DATE,LEVEL3=$$EXTERN(3,PAT)
  1. I HOW=3 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(1,CLIN),LEVEL3=$$EXTERN(3,PAT),LEVEL4=DATE
  1. I HOW=4 S LEVEL1=$$EXTERN(2,STOP),LEVEL2=$$EXTERN(3,PAT),LEVEL3=$$EXTERN(1,CLIN),LEVEL4=DATE
  1. I HOW=5 S LEVEL1=$$EXTERN(3,DFN),LEVEL2=DATE,LEVEL3=$$EXTERN(1,CLIN)
  1. Q