| 1 | SCCVDEL1 ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98 09:39 AM ]
|
|---|
| 2 | ;;5.3;Scheduling;**211**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | DELDATA ; -- kill global
|
|---|
| 5 | N VALMY,SCCV
|
|---|
| 6 | D FULL^VALM1
|
|---|
| 7 | W !
|
|---|
| 8 | ;
|
|---|
| 9 | ; -- check for gaps
|
|---|
| 10 | IF '$$GAP^SCCVDEL() G DELDATAQ
|
|---|
| 11 | ;
|
|---|
| 12 | ; -- check for complete flag
|
|---|
| 13 | IF '$$COMPL^SCCVDEL() G DELDATAQ
|
|---|
| 14 | ;
|
|---|
| 15 | D EN^VALM2($G(XQORNOD(0)))
|
|---|
| 16 | S SCCV=0 F S SCCV=$O(VALMY(SCCV)) Q:'SCCV D
|
|---|
| 17 | . D KILL(+$G(^TMP("SCCV.DELETE.DX",$J,SCCV)))
|
|---|
| 18 | D BLD^SCCVDEL
|
|---|
| 19 | ;
|
|---|
| 20 | DELDATAQ ;
|
|---|
| 21 | S VALMBCK="R"
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | KILL(FNO) ; -- kill data global
|
|---|
| 25 | N SCGLB
|
|---|
| 26 | ;
|
|---|
| 27 | IF '$G(FNO) W !!,"Invalid file number '",$G(FNO),"' specified." G KILLQ
|
|---|
| 28 | ;
|
|---|
| 29 | 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
|
|---|
| 30 | ;
|
|---|
| 31 | S SCGLB=$$FGLB^SCCVDEL(FNO)
|
|---|
| 32 | IF $D(^DIC(FNO)) W !!,"Data global '",SCGLB,"' cannot be KILLed. ^DIC(",FNO,") still exists." G KILLQ
|
|---|
| 33 | ;
|
|---|
| 34 | IF $D(^DD(FNO)) W !!,"Data global '",SCGLB,"' cannot be KILLed. ^DD(",FNO,") still exists." G KILLQ
|
|---|
| 35 | ;
|
|---|
| 36 | IF $D(@SCGLB)=0 W !!,"Data global '",SCGLB,"' does not exist. Global does not need to be KILLed." G KILLQ
|
|---|
| 37 | ;
|
|---|
| 38 | IF $D(@SCGLB) D
|
|---|
| 39 | . IF $$PROT(SCGLB) D
|
|---|
| 40 | . . S Y=$$LOG^SCCVDEL(FNO,$G(DUZ),"DATA")
|
|---|
| 41 | . . IF 'Y D Q
|
|---|
| 42 | . . . W !!,"Cannot kill data global!"
|
|---|
| 43 | . . . W !,$P(Y,U,2)
|
|---|
| 44 | . . S X="ERR^SCCVDEL1",@^%ZOSF("TRAP")
|
|---|
| 45 | . . K @SCGLB
|
|---|
| 46 | . . W !!,"Data global '",SCGLB,"' successfully KILLed."
|
|---|
| 47 | . ELSE D
|
|---|
| 48 | . . W !!,"Data gloabl '",SCGLB,"' was not KILLed."
|
|---|
| 49 | ;
|
|---|
| 50 | KILLQ D PAUSE^SCCVU
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | PROT(SDGLB) ; -- ask if ok to kill and protection is off
|
|---|
| 54 | N DIR,Y
|
|---|
| 55 | W !
|
|---|
| 56 | S DIR(0)="YA"
|
|---|
| 57 | S DIR("A")="Are you sure you want to KILL the '"_SDGLB_"' global? "
|
|---|
| 58 | S DIR("B")="No"
|
|---|
| 59 | D ^DIR
|
|---|
| 60 | IF 'Y S SCOK=0 G PROTQ
|
|---|
| 61 | ;
|
|---|
| 62 | IF SDGLB="^SDD(409.43)"!(SCGLB="^SDD(409.44)") S SCOK=1 G PROTQ
|
|---|
| 63 | ;
|
|---|
| 64 | W !
|
|---|
| 65 | S DIR(0)="YA"
|
|---|
| 66 | S DIR("A")="Are you sure global root KILL protection is turned off? "
|
|---|
| 67 | S DIR("B")="No"
|
|---|
| 68 | D ^DIR
|
|---|
| 69 | IF 'Y S SCOK=0 G PROTQ
|
|---|
| 70 | S SCOK=1
|
|---|
| 71 | PROTQ Q SCOK
|
|---|
| 72 | ;
|
|---|
| 73 | ERR ; -- error trap routine
|
|---|
| 74 | ;
|
|---|
| 75 | ; -- check for 'protection' error and set $ECODE to null
|
|---|
| 76 | ; -- setting of $ECODE to null per Wally Fort instructions on 1/28/99
|
|---|
| 77 | IF $$EC^%ZOSV["PROT" D S $ECODE="" Q
|
|---|
| 78 | . W !!,">>> Protection error has occurred. Global has not been KILLed."
|
|---|
| 79 | . W !," You must removed root-level protection on global."
|
|---|
| 80 | D @^%ZOSF("ERRTN")
|
|---|
| 81 | Q
|
|---|
