SROWL0 ;B'HAM ISC/MAM - EDIT OR DELETE WAITING LIST ; 16 OCT 1989 08:00
;;3.0; Surgery ;**58**;24 Jun 93
DEL S SRDEL=1
EDIT S:'$D(SRDEL) SRDEL=0
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),"^")
LIST W @IOF,!,"Procedures entered on the Waiting List for "_SRSDPT,!!
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
I '$D(SRW(1)) W !!,"There are no entries on the Waiting List for "_SRSDPT_".",!! G END
I '$D(SRW(2)) S SRW=1 G DIE
W !!!,"Select Number: " R X:DTIME I "^"[X S SRSOUT=1 G END
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
S SRW=X
DIE I SRDEL G DIK
D NOW^%DTC S SRNOW=$E(%,1,12),SRSS=$P(SRW(SRW),"^"),SROFN=$P(SRW(SRW),"^",2)
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
G END
DIK ; delete entry
W !!,"Are you sure that you want to delete this entry ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
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
I "Yy"'[SRYN W !!,"No action taken." G END
S DA(1)=$P(SRW(SRW),"^"),DA=$P(SRW(SRW),"^",2),DIK="^SRO(133.8,"_DA(1)_",1," D ^DIK
W !!,SRSDPT_" has been removed from the Waiting List."
END I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME
D ^SRSKILL W @IOF
Q
ARRAY ; set array containing waiting list info
S CNT=CNT+1,SRSNM=$P(^SRO(133.8,SRSS,0),"^"),SRSNM=$P(^SRO(137.45,SRSNM,0),"^")
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)
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=""
S SRW(CNT)=SRSS_"^"_SROFN_"^"_SRSNM_"^"_SRDT_"^"_SROPER_"^"_SROPDT
W !,CNT_". "_SRSNM,?40,"Date Entered on List:",?66,SRDT,!,?3,SROP(1),?40,"Tentative Operation Date: ",?66,SROPDT
I $D(SROP(2)) W !,?3,SROP(2)
W !
Q
LOOP ; break procedure if greater than 36 characters
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROWL0 2643 printed Dec 13, 2024@02:46:41 Page 2
SROWL0 ;B'HAM ISC/MAM - EDIT OR DELETE WAITING LIST ; 16 OCT 1989 08:00
+1 ;;3.0; Surgery ;**58**;24 Jun 93
DEL SET SRDEL=1
EDIT if '$DATA(SRDEL)
SET SRDEL=0
+1 SET SRSOUT=0
WRITE @IOF,!
KILL DIC
SET DIC=2
SET DIC(0)="QEAMZ"
SET DIC("A")=$SELECT(SRDEL:"Delete ",1:"Edit ")_"which Patient ? "
DO ^DIC
if Y<0
GOTO END
SET DFN=+Y
SET SRSDPT=$PIECE(Y(0),"^")
LIST WRITE @IOF,!,"Procedures entered on the Waiting List for "_SRSDPT,!!
+1 KILL SRW
SET (CNT,SRSS)=0
FOR I=0:0
SET SRSS=$ORDER(^SRO(133.8,"AP",DFN,SRSS))
if 'SRSS
QUIT
SET SROFN=0
FOR I=0:0
SET SROFN=$ORDER(^SRO(133.8,"AP",DFN,SRSS,SROFN))
if 'SROFN
QUIT
DO ARRAY
+2 IF '$DATA(SRW(1))
WRITE !!,"There are no entries on the Waiting List for "_SRSDPT_".",!!
GOTO END
+3 IF '$DATA(SRW(2))
SET SRW=1
GOTO DIE
+4 WRITE !!!,"Select Number: "
READ X:DTIME
IF "^"[X
SET SRSOUT=1
GOTO END
+5 IF '$DATA(SRW(X))
WRITE !!,"Select the number corresponding to the entry you want to "_$SELECT(SRDEL:"delete",1:"edit")_". Enter '^'",!,"to quit this option.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO LIST
+6 SET SRW=X
DIE IF SRDEL
GOTO DIK
+1 DO NOW^%DTC
SET SRNOW=$EXTRACT(%,1,12)
SET SRSS=$PIECE(SRW(SRW),"^")
SET SROFN=$PIECE(SRW(SRW),"^",2)
+2 KILL DR,DIE,DA
SET DA(1)=SRSS
SET DA=SROFN
SET DIE="^SRO(133.8,"_DA(1)_",1,"
SET DR="1T;4T;5T;6T;W !;3T"
SET DR(2,133.8013)=".01T;1T;2T;3T;4T;5T"
DO ^DIE
KILL DR,DIE,DA
DO WL^SROPCE1
+3 GOTO END
DIK ; delete entry
+1 WRITE !!,"Are you sure that you want to delete this entry ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+2 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
IF "YyNn"'[SRYN
WRITE !!,"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."
GOTO DIE
+3 IF "Yy"'[SRYN
WRITE !!,"No action taken."
GOTO END
+4 SET DA(1)=$PIECE(SRW(SRW),"^")
SET DA=$PIECE(SRW(SRW),"^",2)
SET DIK="^SRO(133.8,"_DA(1)_",1,"
DO ^DIK
+5 WRITE !!,SRSDPT_" has been removed from the Waiting List."
END IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+1 DO ^SRSKILL
WRITE @IOF
+2 QUIT
ARRAY ; set array containing waiting list info
+1 SET CNT=CNT+1
SET SRSNM=$PIECE(^SRO(133.8,SRSS,0),"^")
SET SRSNM=$PIECE(^SRO(137.45,SRSNM,0),"^")
+2 SET SROPER=$PIECE(^SRO(133.8,SRSS,1,SROFN,0),"^",2)
SET SRDT=$PIECE(^(0),"^",3)
SET SROPDT=$PIECE(^(0),"^",5)
SET Y=SRDT
DO D^DIQ
SET SRDT=$EXTRACT(Y,1,12)
IF SROPDT
SET Y=SROPDT
DO D^DIQ
SET SROPDT=$EXTRACT(Y,1,12)
+3 KILL SROP,MM,MMM
if $LENGTH(SROPER)<36
SET SROP(1)=SROPER
IF $LENGTH(SROPER)>35
SET SROPER=SROPER_" "
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+4 SET SRW(CNT)=SRSS_"^"_SROFN_"^"_SRSNM_"^"_SRDT_"^"_SROPER_"^"_SROPDT
+5 WRITE !,CNT_". "_SRSNM,?40,"Date Entered on List:",?66,SRDT,!,?3,SROP(1),?40,"Tentative Operation Date: ",?66,SROPDT
+6 IF $DATA(SROP(2))
WRITE !,?3,SROP(2)
+7 WRITE !
+8 QUIT
LOOP ; break procedure if greater than 36 characters
+1 SET SROP(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SROPER," ")
SET MMM=$PIECE(SROPER," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROP(M))+$LENGTH(MM)'<36
QUIT
SET SROP(M)=SROP(M)_MM_" "
SET SROPER=MMM
+2 QUIT
