| 1 | YSWX1 ;ALB/ASF-WAIT LIST CONT ; 10/7/88 16:06 ;
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from the top by MENU option YSWAITCR
|
|---|
| 5 | ;
|
|---|
| 6 | K DIC S DIC="^YSG(""WAIT"",",DIC(0)="AELQ",DLAYGO=617 D ^DIC Q:Y<1
|
|---|
| 7 | 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
|
|---|
| 8 | I '$D(^YSG("WAIT",N,0)) K ^YSG("WAIT",N,1,0)
|
|---|
| 9 | L -^YSG("WAIT",N) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
|
|---|
| 10 | Q
|
|---|
| 11 | SHUF ; Called by routine YSWX
|
|---|
| 12 | S YSELIG=$P(^YSG("WAIT",N,0),U,3)
|
|---|
| 13 | S E1=^YSG("WAIT",N,1,N1,0),S1=$P(E1,U,7),S2=$P(E1,U,8) S:YSELIG="N" S1=0
|
|---|
| 14 | RETRY ;
|
|---|
| 15 | 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
|
|---|
| 16 | S (W3,H1)="" F W4=1:1:W2 S W3=$O(^UTILITY($J,S1,W3)) Q:'W3 S ^UTILITY($J,W4)=W3
|
|---|
| 17 | 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
|
|---|
| 18 | E S H1=H1-.00000001 S:$D(^UTILITY($J,S1,H1)) H1=H1-.00000001 Q
|
|---|
| 19 | ERR ;
|
|---|
| 20 | W !!,$C(7),"YOU MUST ENTER A NUMBER BETWEEN 1 AND THE LAST NUMBER ON THE WAIT LIST"
|
|---|
| 21 | W !," (INCLUSIVE) OR (^) TO EXIT." G RETRY
|
|---|
| 22 | Q
|
|---|
