SCCVDEL1.m

SCCVDEL1 ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98  09:39 AM ]

 ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21

 ;

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

SCCVDEL1  ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98  09:39 AM ]

 +1       ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21

 +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