SCCVDEL1 ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98 09:39 AM ]
;;5.3;Scheduling;**211**;Aug 13, 1993
;
DELDATA ; -- kill global
N VALMY,SCCV
D FULL^VALM1
W !
;
; -- check for gaps
IF '$$GAP^SCCVDEL() G DELDATAQ
;
; -- check for complete flag
IF '$$COMPL^SCCVDEL() G DELDATAQ
;
D EN^VALM2($G(XQORNOD(0)))
S SCCV=0 F S SCCV=$O(VALMY(SCCV)) Q:'SCCV D
. D KILL(+$G(^TMP("SCCV.DELETE.DX",$J,SCCV)))
D BLD^SCCVDEL
;
DELDATAQ ;
S VALMBCK="R"
Q
;
KILL(FNO) ; -- kill data global
N SCGLB
;
IF '$G(FNO) W !!,"Invalid file number '",$G(FNO),"' specified." G KILLQ
;
IF FNO'=40.1,FNO'=40.15,FNO'=409.5,FNO'=409.43,FNO'=409.44 W !!,"Invalid file number '",$G(FNO),"' specified." G KILLQ
;
S SCGLB=$$FGLB^SCCVDEL(FNO)
IF $D(^DIC(FNO)) W !!,"Data global '",SCGLB,"' cannot be KILLed. ^DIC(",FNO,") still exists." G KILLQ
;
IF $D(^DD(FNO)) W !!,"Data global '",SCGLB,"' cannot be KILLed. ^DD(",FNO,") still exists." G KILLQ
;
IF $D(@SCGLB)=0 W !!,"Data global '",SCGLB,"' does not exist. Global does not need to be KILLed." G KILLQ
;
IF $D(@SCGLB) D
. IF $$PROT(SCGLB) D
. . S Y=$$LOG^SCCVDEL(FNO,$G(DUZ),"DATA")
. . IF 'Y D Q
. . . W !!,"Cannot kill data global!"
. . . W !,$P(Y,U,2)
. . S X="ERR^SCCVDEL1",@^%ZOSF("TRAP")
. . K @SCGLB
. . W !!,"Data global '",SCGLB,"' successfully KILLed."
. ELSE D
. . W !!,"Data gloabl '",SCGLB,"' was not KILLed."
;
KILLQ D PAUSE^SCCVU
Q
;
PROT(SDGLB) ; -- ask if ok to kill and protection is off
N DIR,Y
W !
S DIR(0)="YA"
S DIR("A")="Are you sure you want to KILL the '"_SDGLB_"' global? "
S DIR("B")="No"
D ^DIR
IF 'Y S SCOK=0 G PROTQ
;
IF SDGLB="^SDD(409.43)"!(SCGLB="^SDD(409.44)") S SCOK=1 G PROTQ
;
W !
S DIR(0)="YA"
S DIR("A")="Are you sure global root KILL protection is turned off? "
S DIR("B")="No"
D ^DIR
IF 'Y S SCOK=0 G PROTQ
S SCOK=1
PROTQ Q SCOK
;
ERR ; -- error trap routine
;
; -- check for 'protection' error and set $ECODE to null
; -- setting of $ECODE to null per Wally Fort instructions on 1/28/99
IF $$EC^%ZOSV["PROT" D S $ECODE="" Q
. W !!,">>> Protection error has occurred. Global has not been KILLed."
. W !," You must removed root-level protection on global."
D @^%ZOSF("ERRTN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVDEL1 2304 printed Apr 09, 2024@21:52:38 Page 2
SCCVDEL1 ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98 09:39 AM ]
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+2 ;
DELDATA ; -- kill global
+1 NEW VALMY,SCCV
+2 DO FULL^VALM1
+3 WRITE !
+4 ;
+5 ; -- check for gaps
+6 IF '$$GAP^SCCVDEL()
GOTO DELDATAQ
+7 ;
+8 ; -- check for complete flag
+9 IF '$$COMPL^SCCVDEL()
GOTO DELDATAQ
+10 ;
+11 DO EN^VALM2($GET(XQORNOD(0)))
+12 SET SCCV=0
FOR
SET SCCV=$ORDER(VALMY(SCCV))
if 'SCCV
QUIT
Begin DoDot:1
+13 DO KILL(+$GET(^TMP("SCCV.DELETE.DX",$JOB,SCCV)))
End DoDot:1
+14 DO BLD^SCCVDEL
+15 ;
DELDATAQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
KILL(FNO) ; -- kill data global
+1 NEW SCGLB
+2 ;
+3 IF '$GET(FNO)
WRITE !!,"Invalid file number '",$GET(FNO),"' specified."
GOTO KILLQ
+4 ;
+5 IF FNO'=40.1
IF FNO'=40.15
IF FNO'=409.5
IF FNO'=409.43
IF FNO'=409.44
WRITE !!,"Invalid file number '",$GET(FNO),"' specified."
GOTO KILLQ
+6 ;
+7 SET SCGLB=$$FGLB^SCCVDEL(FNO)
+8 IF $DATA(^DIC(FNO))
WRITE !!,"Data global '",SCGLB,"' cannot be KILLed. ^DIC(",FNO,") still exists."
GOTO KILLQ
+9 ;
+10 IF $DATA(^DD(FNO))
WRITE !!,"Data global '",SCGLB,"' cannot be KILLed. ^DD(",FNO,") still exists."
GOTO KILLQ
+11 ;
+12 IF $DATA(@SCGLB)=0
WRITE !!,"Data global '",SCGLB,"' does not exist. Global does not need to be KILLed."
GOTO KILLQ
+13 ;
+14 IF $DATA(@SCGLB)
Begin DoDot:1
+15 IF $$PROT(SCGLB)
Begin DoDot:2
+16 SET Y=$$LOG^SCCVDEL(FNO,$GET(DUZ),"DATA")
+17 IF 'Y
Begin DoDot:3
+18 WRITE !!,"Cannot kill data global!"
+19 WRITE !,$PIECE(Y,U,2)
End DoDot:3
QUIT
+20 SET X="ERR^SCCVDEL1"
SET @^%ZOSF("TRAP")
+21 KILL @SCGLB
+22 WRITE !!,"Data global '",SCGLB,"' successfully KILLed."
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 WRITE !!,"Data gloabl '",SCGLB,"' was not KILLed."
End DoDot:2
End DoDot:1
+25 ;
KILLQ DO PAUSE^SCCVU
+1 QUIT
+2 ;
PROT(SDGLB) ; -- ask if ok to kill and protection is off
+1 NEW DIR,Y
+2 WRITE !
+3 SET DIR(0)="YA"
+4 SET DIR("A")="Are you sure you want to KILL the '"_SDGLB_"' global? "
+5 SET DIR("B")="No"
+6 DO ^DIR
+7 IF 'Y
SET SCOK=0
GOTO PROTQ
+8 ;
+9 IF SDGLB="^SDD(409.43)"!(SCGLB="^SDD(409.44)")
SET SCOK=1
GOTO PROTQ
+10 ;
+11 WRITE !
+12 SET DIR(0)="YA"
+13 SET DIR("A")="Are you sure global root KILL protection is turned off? "
+14 SET DIR("B")="No"
+15 DO ^DIR
+16 IF 'Y
SET SCOK=0
GOTO PROTQ
+17 SET SCOK=1
PROTQ QUIT SCOK
+1 ;
ERR ; -- error trap routine
+1 ;
+2 ; -- check for 'protection' error and set $ECODE to null
+3 ; -- setting of $ECODE to null per Wally Fort instructions on 1/28/99
+4 IF $$EC^%ZOSV["PROT"
Begin DoDot:1
+5 WRITE !!,">>> Protection error has occurred. Global has not been KILLed."
+6 WRITE !," You must removed root-level protection on global."
End DoDot:1
SET $ECODE=""
QUIT
+7 DO @^%ZOSF("ERRTN")
+8 QUIT
