- 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
- 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
