source: IHS-VA_UTILITIES-XB/trunk/XBPKDEL1.m@ 1119

XBPKDEL1        ; IHS/ADC/GTH - DELETE RETIRED AND REPLACED PACKAGES ; [ 10/29/2002   7:42 AM ]
        ;;4.0;XB;;Jul 20, 2009;Build 2
        ; XB*3*8 - IHS/ASDST/GTH - 12-07-00 - New routine with patch 8.
        ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Use $GLOBAL.
        ;
        ; DECERT subroutine processes a list of retired/replaced
        ; packages, and gives the user the opportunity to delete all
        ; the package components, the routines, and globals, in the
        ; namspace of the package.
        ;
Q       Q
        ; -------------------------------------------------------------
DECERT  ;EP - Delete de-certified packages.
        I '$D(^DIC(0)) W !,*7,"Filemanager does not exist in this UCI!" Q
        I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) W !,"PROGRAMMER ACCESS REQUIRED",! Q
        ;
        W @IOF,!!,"You'll be given the opportunity to delete the following packages,",!,"Routines, and Globals in the indicated namespace, in 3 steps."
L1      ;
        W !,"NAMESPACE--DESCRIPTION----------------------------RTNS-----GBLS------"
        ;
        NEW C,G,L,R
        ;
        F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###"  D
        . W !,$P(L,"^",1),?11,$P(L,"^",2),?50,$J($$RSEL^ZIBRSEL($P(L,"^",1)_"*"),4),?59,$J($$CG($P(L,"^",1)),4)
        . I $Y>(IOSL-3),$$DIR^XBDIR("E","Press RETURN for the rest of the list") W @IOF
        .Q
        ;
        Q:$G(XBLIST)
        ;
        I '$$DIR^XBDIR("Y","Are you sure you want to continue","NO",$G(DTIME,300)) Q
        ;
        W !!,"There will be 3 steps:"
        W !?10,"1)  Delete package via call to XBPKDEL;"
        W !?10,"2)  Delete Routines (not asked if 0 routines);"
        W !?10,"3)  Delete Globals (not asked if 0 globals)."
        W !,"Of course, your wisdom will be questioned if you do this w/o a full b/u...",!
        ;
        Q:'$$DIR^XBDIR("E")
        ;
        F C=1:1 S L=$T(KILLEM+C),L=$P(L,";",3) Q:L="###"  D  Q:$G(XBPKSTP)
        . W !!,$P(L,"^",1),?11,$P(L,"^",2)
        . S XBPKEY=1,XBPKNSP=$P(L,"^",1)
        . D DEL(XBPKNSP)
        . Q:$G(XBPKSTP)
        . D RTNS(XBPKNSP)
        . Q:$G(XBPKSTP)
        . D GBLS(XBPKNSP)
        . Q:$G(XBPKSTP)
        .Q
        ;
        D EOJ^XBPKDEL
        Q
        ;
        ; -------------------------------------------------------------
DEL(XBPKNSP)    ;
        W !,"Deleting the ",XBPKNSP," package components via call to XBPKDEL"
        NEW C,G,L,R
        S XBPKRUN=""
        D ^XBPKDEL
        Q
        ; -------------------------------------------------------------
RTNS(XBPKNSP)   ;
        NEW C,G,L,R,XB
        S XB=$$RSEL^ZIBRSEL(XBPKNSP_"*")
        Q:'XB
        I '$$DIR^XBDIR("Y","Delete "_XB_" routines in the "_XBPKNSP_" namespace","NO","","If you answer 'YES', the routines will be deleted") S:X=U XBPKSTP=1 Q
        W !,"Deleting ",XB," ",XBPKNSP," routines",!
        S X=""
        F  S X=$O(^TMP("ZIBRSEL",$J,X)) Q:X=""  W X,$J("",10-$L(X)) X ^%ZOSF("DEL")
        KILL ^TMP("ZIBRSEL",$J)
        Q
        ; -------------------------------------------------------------
GBLS(XBPKNSP)   ;
        NEW C,G,L,R,XB
        S XB=$$CG(XBPKNSP)
        Q:'XB
        I '$$DIR^XBDIR("Y","Delete "_XB_" globals in the "_XBPKNSP_" namespace","NO","","If you answer 'YES', the globals will be deleted") S:X=U XBPKSTP=1 Q
        W !,"Kill'ing ",$$CG(XBPKNSP)," ",XBPKNSP," globals",!
        S G="^"_XBPKNSP,L=$L(XBPKNSP)
        ;I '$$KILLOK^ZIBGCHAR(G) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
        I '$$KILLOK^ZIBGCHAR(XBPKNSP) KILL @G ;IHS/SET/GTH XB*3*9 10/29/2002
        ;F  S G=$O(@G) Q:'($E(G,1,L)=XBPKNSP)  S G="^"_G W G,$J("",10-$L(G)) D ;IHS/SET/GTH XB*3*9 10/29/2002
        F  S G=$O(^$G(G)) Q:'($E(G,2,L+1)=XBPKNSP)  W G,$J("",10-$L(G)) D  ;IHS/SET/GTH XB*3*9 10/29/2002
        . I '$$KILLOK^ZIBGCHAR($E(G,2,$L(G))) KILL @G Q
        . W !,"<KILL UNSUCCESSFUL>: ",$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($E(G,2,$L(G))))
        .Q
        Q
        ; -------------------------------------------------------------
CG(N)   ; Count the globals in the N namespace.    
        NEW C,G,L,R
        S C=0,G="^"_N,L=$L(N)
        I $D(@G) S C=1
        ;F  S G=$O(@G) Q:'($E(G,1,L)=N)  S G="^"_G,C=C+1 ;IHS/SET/GTH XB*3*9 10/29/2002
        F  S G=$O(^$G(G)) Q:'($E(G,2,L+1)=N)  S C=C+1 ;IHS/SET/GTH XB*3*9 10/29/2002
        Q C
        ; -------------------------------------------------------------
LIST    ;EP - List retired/replaced packages.
        NEW XBLIST
        S XBLIST=1
        W @IOF
        D L1
        Q
        ; -------------------------------------------------------------
KILLEM  ; Add the packages to be deleted, below: Namespace^Description
        ;;AAPC^Ambulatory Patient Care Data Entry
        ;;ACI^Injury Report
        ;;ACHA^Community Health Nursing
        ;;ADB^Diabetic Tracking System
        ;;AMAL^Malpractice Claims
        ;;APCM^PCC Table Maintenance
        ;;AMCP^Women's Health/Pap Smear
        ;;AMR^Management Status
        ;;AMS^Management Referral
        ;;APCQ^PCC Quality Assurance
        ;;APCG^Family Genetic Linkage
        ;;APCR^PCC Register
        ;;APCS^PCC Surveillance
        ;;APCT^PCC Clinic Training
        ;;APHR^Physician Tracking
        ;;ATA^Original Time and Attendance
        ;;ALP^Mainframe to RPMS data insertion
        ;;BRB^Institutional Review Board
        ;;###
        ;