Return to DDSDEL.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSDEL.m, revision 1.1

1.1     ! snw         1: DDSDEL ;SFISC/MKO-DELETE FORMS FOR A FILE ;07:36 AM  2 Aug 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: FORM(DDSFILE,DDSECHO)  ;
        !             6:        ;Delete all forms/blocks associated with file DDSFILE
        !             7:        N %,DIK,DIOVRD,DA,D0,X,Y
        !             8:        I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !             9:        S DIOVRD=1
        !            10:        D SETUP,GETFORMS(DDSFILE,DDSREF)
        !            11:        ;
        !            12:        ;Delete forms
        !            13:        W:DDSECHO !?3,"Deleting the FORMS..."
        !            14:        S DDSFRM="",DIK="^DIST(.403,"
        !            15:        F  S DDSFRM=$O(@DDSREF@("FRM",DDSFRM)) Q:'DDSFRM  S DA=DDSFRM D ^DIK
        !            16:        K DIK,DA
        !            17:        ;
        !            18:        ;Delete blocks
        !            19:        W:DDSECHO !?3,"Deleting the BLOCKS..."
        !            20:        S DDSBLK="",DIK="^DIST(.404,"
        !            21:        F  S DDSBLK=$O(@DDSREF@("BLK",DDSBLK)) Q:'DDSBLK  D
        !            22:        . S DDSLN=@DDSREF@("BLK",DDSBLK)
        !            23:        . S DDSBNAM=$P(DDSLN,U),DDSOFRM=$P(DDSLN,U,2),DDSPDD=$P(DDSLN,U,3)
        !            24:        . ;
        !            25:        . I DDSOFRM,DDSPDD D
        !            26:        .. I DDSECHO D
        !            27:        ... W !!?3,$C(7)_"***  Warning  ***"
        !            28:        ... W !!?3,"Block "_DDSBNAM_" (#"_DDSBLK_")"
        !            29:        ... W !?3,"was deleted from the Block file."
        !            30:        ... W !!?3,"I'm deleting pointers to that block from"
        !            31:        .. S DDSFRM=""
        !            32:        .. F  S DDSFRM=$O(@DDSREF@("BLK",DDSBLK,DDSFRM)) Q:'DDSFRM  D
        !            33:        ... W:DDSECHO !?6,"Form "_$P(^DIST(.403,DDSFRM,0),U)_" (#"_DDSFRM_") ..."
        !            34:        ... D DELBLK(DDSBLK,DDSFRM)
        !            35:        .. W:DDSECHO !!?3,"The above form(s) need to be redesigned.",!
        !            36:        . ;
        !            37:        . E  I 'DDSOFRM D
        !            38:        .. S DA=DDSBLK D ^DIK
        !            39:        ;
        !            40: QUIT   ;Cleanup and quit
        !            41:        K @DDSREF,DDSREF
        !            42:        K DDSBLK,DDSBNAM,DDSFRM,DDSOFRM,DDSLN,DDSPDD,DDSPG
        !            43:        Q
        !            44:        ;
        !            45: SETUP  ;Setup local variables
        !            46:        S:$D(DDSECHO)[0 DDSECHO=0
        !            47:        S DDSREF="^TMP(""DDSDEL"","_$J_")"
        !            48:        K @DDSREF
        !            49:        Q
        !            50:        ;
        !            51: GETFORMS(FILE,REF)     ;
        !            52:        ;Get all forms and blocks associated with file number FILE
        !            53:        ;and all subfiles associated with FILE
        !            54:        ;Put results in
        !            55:        ;  @REF@("DD",file#)         = null
        !            56:        ;       ("FRM",form#)        = form name
        !            57:        ;       ("BLK",block#)       = block name^used on forms not being
        !            58:        ;                              deleted^dd of block is being deleted
        !            59:        ;       ("BLK",block#,form#) = null for all blocks that are found
        !            60:        ;                              on a form not being deleted
        !            61:        ;
        !            62:        N B,F,P,FNAM
        !            63:        ;Get DDs of file and subfiles
        !            64:        D DD(FILE,REF)
        !            65:        ;
        !            66:        ;Get all forms associated with file
        !            67:        S FNAM="" F  S FNAM=$O(^DIST(.403,"F"_FILE,FNAM)) Q:FNAM=""  D
        !            68:        . S F="" F  S F=$O(^DIST(.403,"F"_FILE,FNAM,F)) Q:F=""  D
        !            69:        .. Q:$D(^DIST(.403,F,0))[0
        !            70:        .. S @REF@("FRM",F)=$P(^DIST(.403,F,0),U)
        !            71:        ;
        !            72:        ;Get all blocks associated with each form
        !            73:        S F="" F  S F=$O(@REF@("FRM",F)) Q:F=""  D
        !            74:        . S P=0 F  S P=$O(^DIST(.403,F,40,P)) Q:'P  D
        !            75:        .. S B=$P($G(^DIST(.403,F,40,P,0)),U,2)
        !            76:        .. I B D SETBLK(B,REF)
        !            77:        .. S B=0 F  S B=$O(^DIST(.403,F,40,P,40,B)) Q:'B  D SETBLK(B,REF)
        !            78:        Q
        !            79:        ;
        !            80: SETBLK(B,REF)  ;
        !            81:        ;Put block info into @REF
        !            82:        N B0
        !            83:        S B0=$G(^DIST(.404,B,0)) Q:B0?."^"
        !            84:        S @REF@("BLK",B)=$P(B0,U)_U_$$OTHER(B,REF)_U_($D(@REF@("DD",+$P(B0,U,2)))#2)
        !            85:        Q
        !            86:        ;
        !            87: DELBLK(DDSBLK,DDSFRM)  ;
        !            88:        ;Delete block DDSBLK from form DDSFRM
        !            89:        N DIK,DA,D0
        !            90:        S DDSPG=0 F  S DDSPG=$O(^DIST(.403,DDSFRM,40,DDSPG)) Q:'DDSPG  D
        !            91:        . I $D(^DIST(.403,DDSFRM,40,DDSPG,40,"B",DDSBLK)) D
        !            92:        .. S DIK="^DIST(.403,"_DDSFRM_",40,"_DDSPG_",40,"
        !            93:        .. S DA(2)=DDSFRM,DA(1)=DDSPG,DA=DDSBLK
        !            94:        .. D ^DIK
        !            95:        Q
        !            96:        ;
        !            97: DD(F,REF,K)    ;
        !            98:        ;Put file # and all its subfile #s into array @REF@("DD")
        !            99:        ;Kill REF first if $G(K)=""
        !           100:        N SB
        !           101:        K:$G(K)="" @REF@("DD")
        !           102:        S @REF@("DD",F)=""
        !           103:        S SB="" F  S SB=$O(^DD(F,"SB",SB)) Q:SB=""  D DD(SB,REF,1)
        !           104:        Q
        !           105:        ;
        !           106: OTHER(B,REF)   ;
        !           107:        ;Is block B found on forms other than what's in @REF@("FRM",F)=""
        !           108:        ;If so, put form numbers in @REF@("BLK",B,F)
        !           109:        N F,O,C
        !           110:        S O=0,F=""
        !           111:        F C="AB","AC" F  S F=$O(^DIST(.403,C,B,F)) Q:F=""  D
        !           112:        . I $D(@REF@("FRM",F))[0 S O=1,@REF@("BLK",B,F)=""
        !           113:        Q O