- SROPDEL ;BIR/MAM - DELETE CASE ;06/14/05
- ;;3.0; Surgery ;**67,100,142,167**;24 Jun 93;Build 27
- DEL W !!,"Are you sure that you want to delete this case ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
- S:SRYN="" SRYN="N" S SRYN=$E(SRYN)
- I "YyNn"'[SRYN W !!,"Enter 'YES' to delete this surgical case from your records. If you have",!,"selected this option inadvertantly and do not want to remove this case,",!,"enter RETURN or 'NO'." G DEL
- I "Yy"'[SRYN S SRSOUT=1 Q
- S SRCC="",SROPCOM="Operation..."
- I $P($G(^SRF(SRTN,.2)),"^",12)'="" W !!,"This case has been completed and must remain in the file for your records." D RET Q
- I $D(^SRF(SRTN,"LOCK")),^("LOCK")=1 W !!,"This case has been verified and locked. It cannot be deleted unless unlocked",!,"by your Chief of Surgery, or someone appointed by him/her." D RET Q
- I $P($G(^SRF(SRTN,30)),"^") S SROPCAN=1
- I $P($G(^SRF(SRTN,31)),"^",8)'="" S SROPCAN=1
- I $D(SROPCAN) W !!,"This case has been cancelled and must remain in the file for your records." D RET Q
- I $P($G(^SRF(SRTN,31)),"^",4) W !!,"You cannot delete a procedure that has already been scheduled. If you",!,"would like to cancel this procedure, use the option 'Cancel Scheduled ",!,"Operation'." D RET Q
- S Y=$G(^SRF(SRTN,"TIU")) I $P(Y,"^")!$P(Y,"^",2)!$P(Y,"^",4) W !!,"You cannot delete a procedure that has one or more operative documents." D RET Q
- K ^TMP("SRTP",$J) D TP I SRSOUT=1 Q ;checking associated transplant assessments
- KILL ; delete entry
- Q:'$$LOCK^SROUTL(SRTN)
- S SRCONC=$P($G(^SRF(SRTN,"CON")),"^") I SRCONC K ^SRF(SRCONC,"CON")
- D DEL^SROERR
- W !!," Deleting "_SRCC_SROPCOM I $P($G(^SRF(SRTN,.2)),"^",10) S DIE=130,DA=SRTN,DR=".205///@" D ^DIE K DA
- S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL^SROPCEP ; delete visit
- I $D(^SRO(136,SRTN,0)) S DA=SRTN,DIK="^SRO(136," D ^DIK K DA,DIK ; remove entry in file 136
- S (DA,SRTN1)=SRTN,DIK="^SRF(" D ^DIK,UNLOCK^SROUTL(SRTN) K DA,DIK,SRTN
- I SRCONC D UNLOCK^SROUTL(SRCONC),CON I SRCONC D KILL
- I $D(^TMP("SRTP",$J)) D KTP
- Q
- CON ; delete concurrent case ?
- S SRTN=SRCONC W !!,"There is a concurrent procedure associated with this case. Do you want to",!,"delete it also ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRCONC=0 Q
- S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
- I "YyNn"'[SRYN W !!,"Enter RETURN to delete this concurrent case. If you are not sure whether to",!,"delete the other case, enter 'NO'. It can be removed later if necessary." G CON
- I "Nn"[SRYN S SRCONC=0
- Q
- RET W !!,"Press RETURN to continue " R X:DTIME K SRTN
- Q
- TP N SRATP,SRTPN,SRTPP S SRATP=0
- F S SRATP=$O(^SRT("B",DFN,SRATP)) Q:'SRATP S SRTPN=$G(^SRT(SRATP,0)) S:$P(SRTPN,"^",3)=SRTN ^TMP("SRTP",$J,SRATP)=""
- Q:'$D(^TMP("SRTP",$J))
- W !!,"Deleting this case will also delete the transplant assessment(s) associated",!,"with this case. Are you sure you want to delete this case? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
- S:SRYN="" SRYN="N" S SRYN=$E(SRYN)
- I "YyNn"'[SRYN W !!,"Enter YES to delete this case and its transplant assessment(s). Otherwise,",!,"enter NO." G TP
- I "Yy"'[SRYN S SRSOUT=1 Q
- Q
- KTP ; delete transplant assessments
- S SRTPP=0 F S SRTPP=$O(^TMP("SRTP",$J,SRTPP)) Q:'SRTPP D
- .K DA,DIK S DA=SRTPP,DIK="^SRT(" D ^DIK K DA,DIK W !!,"Deleting Transplant Assessment #",SRTPP
- K ^TMP("SRTP",$J)
- Q
- SROPDEL ;BIR/MAM - DELETE CASE ;06/14/05
- +1 ;;3.0; Surgery ;**67,100,142,167**;24 Jun 93;Build 27
- DEL WRITE !!,"Are you sure that you want to delete this case ? NO// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRSOUT=1
- QUIT
- +1 IF SRYN=""
- SET SRYN="N"
- SET SRYN=$EXTRACT(SRYN)
- +2 IF "YyNn"'[SRYN
- WRITE !!,"Enter 'YES' to delete this surgical case from your records. If you have",!,"selected this option inadvertantly and do not want to remove this case,",!,"enter RETURN or 'NO'."
- GOTO DEL
- +3 IF "Yy"'[SRYN
- SET SRSOUT=1
- QUIT
- +4 SET SRCC=""
- SET SROPCOM="Operation..."
- +5 IF $PIECE($GET(^SRF(SRTN,.2)),"^",12)'=""
- WRITE !!,"This case has been completed and must remain in the file for your records."
- DO RET
- QUIT
- +6 IF $DATA(^SRF(SRTN,"LOCK"))
- IF ^("LOCK")=1
- WRITE !!,"This case has been verified and locked. It cannot be deleted unless unlocked",!,"by your Chief of Surgery, or someone appointed by him/her."
- DO RET
- QUIT
- +7 IF $PIECE($GET(^SRF(SRTN,30)),"^")
- SET SROPCAN=1
- +8 IF $PIECE($GET(^SRF(SRTN,31)),"^",8)'=""
- SET SROPCAN=1
- +9 IF $DATA(SROPCAN)
- WRITE !!,"This case has been cancelled and must remain in the file for your records."
- DO RET
- QUIT
- +10 IF $PIECE($GET(^SRF(SRTN,31)),"^",4)
- WRITE !!,"You cannot delete a procedure that has already been scheduled. If you",!,"would like to cancel this procedure, use the option 'Cancel Scheduled ",!,"Operation'."
- DO RET
- QUIT
- +11 SET Y=$GET(^SRF(SRTN,"TIU"))
- IF $PIECE(Y,"^")!$PIECE(Y,"^",2)!$PIECE(Y,"^",4)
- WRITE !!,"You cannot delete a procedure that has one or more operative documents."
- DO RET
- QUIT
- +12 ;checking associated transplant assessments
- KILL ^TMP("SRTP",$JOB)
- DO TP
- IF SRSOUT=1
- QUIT
- KILL ; delete entry
- +1 IF '$$LOCK^SROUTL(SRTN)
- QUIT
- +2 SET SRCONC=$PIECE($GET(^SRF(SRTN,"CON")),"^")
- IF SRCONC
- KILL ^SRF(SRCONC,"CON")
- +3 DO DEL^SROERR
- +4 WRITE !!," Deleting "_SRCC_SROPCOM
- IF $PIECE($GET(^SRF(SRTN,.2)),"^",10)
- SET DIE=130
- SET DA=SRTN
- SET DR=".205///@"
- DO ^DIE
- KILL DA
- +5 ; delete visit
- SET SRX=$PIECE($GET(^SRF(SRTN,0)),"^",15)
- IF SRX
- SET SRVSIT=SRX
- DO DEL^SROPCEP
- +6 ; remove entry in file 136
- IF $DATA(^SRO(136,SRTN,0))
- SET DA=SRTN
- SET DIK="^SRO(136,"
- DO ^DIK
- KILL DA,DIK
- +7 SET (DA,SRTN1)=SRTN
- SET DIK="^SRF("
- DO ^DIK
- DO UNLOCK^SROUTL(SRTN)
- KILL DA,DIK,SRTN
- +8 IF SRCONC
- DO UNLOCK^SROUTL(SRCONC)
- DO CON
- IF SRCONC
- DO KILL
- +9 IF $DATA(^TMP("SRTP",$JOB))
- DO KTP
- +10 QUIT
- CON ; delete concurrent case ?
- +1 SET SRTN=SRCONC
- WRITE !!,"There is a concurrent procedure associated with this case. Do you want to",!,"delete it also ? YES// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRCONC=0
- QUIT
- +2 SET SRYN=$EXTRACT(SRYN)
- IF SRYN=""
- SET SRYN="Y"
- +3 IF "YyNn"'[SRYN
- WRITE !!,"Enter RETURN to delete this concurrent case. If you are not sure whether to",!,"delete the other case, enter 'NO'. It can be removed later if necessary."
- GOTO CON
- +4 IF "Nn"[SRYN
- SET SRCONC=0
- +5 QUIT
- RET WRITE !!,"Press RETURN to continue "
- READ X:DTIME
- KILL SRTN
- +1 QUIT
- TP NEW SRATP,SRTPN,SRTPP
- SET SRATP=0
- +1 FOR
- SET SRATP=$ORDER(^SRT("B",DFN,SRATP))
- IF 'SRATP
- QUIT
- SET SRTPN=$GET(^SRT(SRATP,0))
- IF $PIECE(SRTPN,"^",3)=SRTN
- SET ^TMP("SRTP",$JOB,SRATP)=""
- +2 IF '$DATA(^TMP("SRTP",$JOB))
- QUIT
- +3 WRITE !!,"Deleting this case will also delete the transplant assessment(s) associated",!,"with this case. Are you sure you want to delete this case? NO// "
- READ SRYN:DTIME
- IF '$TEST!(SRYN["^")
- SET SRSOUT=1
- QUIT
- +4 IF SRYN=""
- SET SRYN="N"
- SET SRYN=$EXTRACT(SRYN)
- +5 IF "YyNn"'[SRYN
- WRITE !!,"Enter YES to delete this case and its transplant assessment(s). Otherwise,",!,"enter NO."
- GOTO TP
- +6 IF "Yy"'[SRYN
- SET SRSOUT=1
- QUIT
- +7 QUIT
- KTP ; delete transplant assessments
- +1 SET SRTPP=0
- FOR
- SET SRTPP=$ORDER(^TMP("SRTP",$JOB,SRTPP))
- IF 'SRTPP
- QUIT
- Begin DoDot:1
- +2 KILL DA,DIK
- SET DA=SRTPP
- SET DIK="^SRT("
- DO ^DIK
- KILL DA,DIK
- WRITE !!,"Deleting Transplant Assessment #",SRTPP
- End DoDot:1
- +3 KILL ^TMP("SRTP",$JOB)
- +4 QUIT
