| [613] | 1 | SROWL0 ;B'HAM ISC/MAM - EDIT OR DELETE WAITING LIST ; 16 OCT 1989 08:00
|
|---|
| 2 | ;;3.0; Surgery ;**58**;24 Jun 93
|
|---|
| 3 | DEL S SRDEL=1
|
|---|
| 4 | EDIT S:'$D(SRDEL) SRDEL=0
|
|---|
| 5 | S SRSOUT=0 W @IOF,! K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")=$S(SRDEL:"Delete ",1:"Edit ")_"which Patient ? " D ^DIC G:Y<0 END S DFN=+Y,SRSDPT=$P(Y(0),"^")
|
|---|
| 6 | LIST W @IOF,!,"Procedures entered on the Waiting List for "_SRSDPT,!!
|
|---|
| 7 | K SRW S (CNT,SRSS)=0 F I=0:0 S SRSS=$O(^SRO(133.8,"AP",DFN,SRSS)) Q:'SRSS S SROFN=0 F I=0:0 S SROFN=$O(^SRO(133.8,"AP",DFN,SRSS,SROFN)) Q:'SROFN D ARRAY
|
|---|
| 8 | I '$D(SRW(1)) W !!,"There are no entries on the Waiting List for "_SRSDPT_".",!! G END
|
|---|
| 9 | I '$D(SRW(2)) S SRW=1 G DIE
|
|---|
| 10 | W !!!,"Select Number: " R X:DTIME I "^"[X S SRSOUT=1 G END
|
|---|
| 11 | I '$D(SRW(X)) W !!,"Select the number corresponding to the entry you want to "_$S(SRDEL:"delete",1:"edit")_". Enter '^'",!,"to quit this option.",!!,"Press RETURN to continue " R X:DTIME G LIST
|
|---|
| 12 | S SRW=X
|
|---|
| 13 | DIE I SRDEL G DIK
|
|---|
| 14 | D NOW^%DTC S SRNOW=$E(%,1,12),SRSS=$P(SRW(SRW),"^"),SROFN=$P(SRW(SRW),"^",2)
|
|---|
| 15 | K DR,DIE,DA S DA(1)=SRSS,DA=SROFN,DIE="^SRO(133.8,"_DA(1)_",1,",DR="1T;4T;5T;6T;W !;3T",DR(2,133.8013)=".01T;1T;2T;3T;4T;5T" D ^DIE K DR,DIE,DA D WL^SROPCE1
|
|---|
| 16 | G END
|
|---|
| 17 | DIK ; delete entry
|
|---|
| 18 | W !!,"Are you sure that you want to delete this entry ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
|
|---|
| 19 | S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter 'NO' if you have made a mistake and do not want to remove this",!,"procedure from the list, or 'YES' to delete the entry." G DIE
|
|---|
| 20 | I "Yy"'[SRYN W !!,"No action taken." G END
|
|---|
| 21 | S DA(1)=$P(SRW(SRW),"^"),DA=$P(SRW(SRW),"^",2),DIK="^SRO(133.8,"_DA(1)_",1," D ^DIK
|
|---|
| 22 | W !!,SRSDPT_" has been removed from the Waiting List."
|
|---|
| 23 | END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 24 | D ^SRSKILL W @IOF
|
|---|
| 25 | Q
|
|---|
| 26 | ARRAY ; set array containing waiting list info
|
|---|
| 27 | S CNT=CNT+1,SRSNM=$P(^SRO(133.8,SRSS,0),"^"),SRSNM=$P(^SRO(137.45,SRSNM,0),"^")
|
|---|
| 28 | S SROPER=$P(^SRO(133.8,SRSS,1,SROFN,0),"^",2),SRDT=$P(^(0),"^",3),SROPDT=$P(^(0),"^",5),Y=SRDT D D^DIQ S SRDT=$E(Y,1,12) I SROPDT S Y=SROPDT D D^DIQ S SROPDT=$E(Y,1,12)
|
|---|
| 29 | K SROP,MM,MMM S:$L(SROPER)<36 SROP(1)=SROPER I $L(SROPER)>35 S SROPER=SROPER_" " S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
|---|
| 30 | S SRW(CNT)=SRSS_"^"_SROFN_"^"_SRSNM_"^"_SRDT_"^"_SROPER_"^"_SROPDT
|
|---|
| 31 | W !,CNT_". "_SRSNM,?40,"Date Entered on List:",?66,SRDT,!,?3,SROP(1),?40,"Tentative Operation Date: ",?66,SROPDT
|
|---|
| 32 | I $D(SROP(2)) W !,?3,SROP(2)
|
|---|
| 33 | W !
|
|---|
| 34 | Q
|
|---|
| 35 | LOOP ; break procedure if greater than 36 characters
|
|---|
| 36 | S SROP(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROP(M))+$L(MM)'<36 S SROP(M)=SROP(M)_MM_" ",SROPER=MMM
|
|---|
| 37 | Q
|
|---|
