23 lines
1.2 KiB
Mathematica
23 lines
1.2 KiB
Mathematica
YSWX1 ;ALB/ASF-WAIT LIST CONT ; 10/7/88 16:06 ;
|
|
;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|
;
|
|
; Called from the top by MENU option YSWAITCR
|
|
;
|
|
K DIC S DIC="^YSG(""WAIT"",",DIC(0)="AELQ",DLAYGO=617 D ^DIC Q:Y<1
|
|
S N=+Y,DA=+Y,DIE=DIC,DIE("NO^")=1,DR="0:1;1.5" L +^YSG("WAIT",DA) D ^DIE S ^YSG("WAIT",N,1,0)="^617.01P^^" K DIC,DIE,X,Y
|
|
I '$D(^YSG("WAIT",N,0)) K ^YSG("WAIT",N,1,0)
|
|
L -^YSG("WAIT",N) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
|
|
Q
|
|
SHUF ; Called by routine YSWX
|
|
S YSELIG=$P(^YSG("WAIT",N,0),U,3)
|
|
S E1=^YSG("WAIT",N,1,N1,0),S1=$P(E1,U,7),S2=$P(E1,U,8) S:YSELIG="N" S1=0
|
|
RETRY ;
|
|
S H1="" R !,"Move patient to which numeric position on the wait list = ",W2:DTIME S YSTOUT='$T,YSUOUT=W2["^" Q:YSTOUT!YSUOUT G:(W2?1"?"."?")!(W2'?1N.N)!(W2=0) ERR
|
|
S (W3,H1)="" F W4=1:1:W2 S W3=$O(^UTILITY($J,S1,W3)) Q:'W3 S ^UTILITY($J,W4)=W3
|
|
G ERR:W2>W4 G ERR:'$D(^UTILITY($J,W2)) S H1=^UTILITY($J,W2) Q:H1=S2 I S2<H1 S H1=H1+.00000001 S:$D(^UTILITY($J,S1,H1)) H1=H1+.00000001 Q
|
|
E S H1=H1-.00000001 S:$D(^UTILITY($J,S1,H1)) H1=H1-.00000001 Q
|
|
ERR ;
|
|
W !!,$C(7),"YOU MUST ENTER A NUMBER BETWEEN 1 AND THE LAST NUMBER ON THE WAIT LIST"
|
|
W !," (INCLUSIVE) OR (^) TO EXIT." G RETRY
|
|
Q
|