Return to DDS6.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS6.m, revision 1.1

1.1     ! snw         1: DDS6   ;SFISC/MKO-DELETIONS ;02:49 PM  9 Nov 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;Enter here if user deleted record from the .01 of the (sub)record
        !             5:        ;(called from DDS01)
        !             6:        ;In:  DDSU array, DDSOLD, DDSFLD
        !             7:        D D
        !             8:        I 'Y D
        !             9:        . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
        !            10:        . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
        !            11:        E  D
        !            12:        . I $D(DDSREP) D
        !            13:        .. D DEL^DDSM1(DDSDA)
        !            14:        . E  D K I $D(DDSPTB) D
        !            15:        .. S DDACT="NB"
        !            16:        .. S $P(@DDSREFT@(DDSPG,DDSBK),U)=""
        !            17:        .. D DB^DDSR(DDSPG,DDSBK)
        !            18:        .. D RPF^DDS7
        !            19:        . E  S DDACT="Q",DA=""
        !            20:        ;
        !            21:        I '$P(DDSSC(DDSSC),U,4),'$D(DDSREP) D
        !            22:        . D PG^DDSRSEL
        !            23:        . D:$G(DDSSEL) PUT^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U),"")
        !            24:        Q
        !            25:        ;
        !            26: DM     ;Enter here if user deleted record from the Select prompt
        !            27:        ;(called from DDS5)
        !            28:        ;In:  DDSU array, DDSOLD, DDSFLD
        !            29:        ;
        !            30:        ;Get DA and DIE for subfile level and delete
        !            31:        D DDA^DDS5(DDSOLD,.DA,.DDSDL)
        !            32:        D
        !            33:        . N DIE,DDSDA
        !            34:        . S DIE=U_$P(DDSU("M"),U,2)
        !            35:        . S DDSDA=DA_"," F DDSI=1:1:DDSDL S DDSDA=DDSDA_DA(DDSI)_","
        !            36:        . K DDSI
        !            37:        . D D
        !            38:        . D:Y K
        !            39:        ;
        !            40:        I 'Y D
        !            41:        . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
        !            42:        . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
        !            43:        . D UDA^DDS5(.DA,.DDSDL)
        !            44:        E  D
        !            45:        . D LST^DDS5(.DA,.DDSDL,DDP,DDSDA,DDSFLD)
        !            46:        . D UDA^DDS5(.DA,.DDSDL)
        !            47:        Q
        !            48:        ;
        !            49: D      ;Delete the subrecord
        !            50:        ;In: DA array, DIE, DDSDL; Out: Y=1 if successful
        !            51:        N DR,DDS6DA,DDSI
        !            52:        D:DDM CLRMSG^DDS
        !            53:        S DDM=1
        !            54:        ;
        !            55:        K DIR S DIR(0)="YO"
        !            56:        D BLD^DIALOG(8080,$$EZBLD^DIALOG(8078+(DDSDL>0)),"","DIR(""A"")")
        !            57:        D BLD^DIALOG(9038,"","","DIR(""?"")")
        !            58:        ;
        !            59:        S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-3)_"^0"
        !            60:        D ^DIR K DIR
        !            61:        D CLRMSG^DDS
        !            62:        I X=""!$D(DIRUT)!'Y S Y=0 K DIRUT,DUOUT,DIROUT,DTOUT Q
        !            63:        ;
        !            64:        S DDS6DA=DA N D0
        !            65:        F DDSI=1:1 Q:$D(DA(DDSI))[0  S DDS6DA(DDSI)=DA(DDSI) N @("D"_DDSI)
        !            66:        W $P(DDGLVID,DDGLDEL,9) S X=IOM X $G(^%ZOSF("RM"))
        !            67:        S DR=".01///@" D ^DIE K DI
        !            68:        W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM")
        !            69:        ;
        !            70:        ;I $D(DA) H 2 W $P(DDGLCLR,DDGLDEL,2) D R^DDSR S Y=0 Q
        !            71:        I $D(DA) S:$Y>(DDSHBX+1) DDSKM=1,DDM=1 S Y=0 Q
        !            72:        ;
        !            73:        S Y=1,DA=DDS6DA
        !            74:        I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
        !            75:        F DDSI=1:1 Q:$D(DDS6DA(DDSI))[0  S DA(DDSI)=DDS6DA(DDSI)
        !            76:        Q
        !            77:        ;
        !            78: K      ;Remove all data pertaining to the (sub)record from DDSREFT
        !            79:        ;In: DDSDA, DIE at subfile level
        !            80:        ;
        !            81:        N B,P,FN,PAT,PDA
        !            82:        S PAT=".E1"""_DDSDA_""""
        !            83:        S PDA=$P(DDSDA,",",2,999)
        !            84:        S P=0
        !            85:        F  S P=$O(@DDSREFT@(P)) Q:'P  D
        !            86:        . S B=0 F  S B=$O(@DDSREFT@(P,B)) Q:'B  D
        !            87:        .. S FN="F"_$P(@DDSREFS@(P,B),U,3),DDS6DA=" "
        !            88:        .. F  S DDS6DA=$O(@DDSREFT@(P,B,DDS6DA)) Q:'DDS6DA  D
        !            89:        ... I DDS6DA?@PAT,$P(@DDSREFT@(P,B,DDS6DA,"GL"),DIE)="" D
        !            90:        .... K @DDSREFT@(P,B,DDS6DA)
        !            91:        .... K @DDSREFT@(FN,DDS6DA)
        !            92:        ... E  I DDS6DA=PDA,DIE=@DDSREFT@(P,B,PDA,"GL") D DELP
        !            93:        K DDS6DA
        !            94:        Q
        !            95:        ;
        !            96: DELP   ;Delete subrecord from parent's list
        !            97:        N R,S
        !            98:        S S=$G(@DDSREFT@(P,B,PDA,"B",DDSDA)) Q:'S
        !            99:        K @DDSREFT@(P,B,PDA,"B",DDSDA)
        !           100:        ;
        !           101:        F S=S:1 Q:$D(@DDSREFT@(P,B,PDA,S+1))[0  D
        !           102:        . S R=@DDSREFT@(P,B,PDA,S+1)
        !           103:        . S @DDSREFT@(P,B,PDA,S)=R
        !           104:        . S @DDSREFT@(P,B,PDA,"B",R)=S
        !           105:        K @DDSREFT@(P,B,PDA,S)
        !           106:        Q
        !           107:        ;
        !           108: DEL    ;Delete (sub)records added between saves
        !           109:        ;(user quit without saving)
        !           110:        N DA,DIK
        !           111:        S DDSI=0
        !           112:        F  S DDSI=$O(@DDSREFT@("ADD",DDSI)) Q:'DDSI  D
        !           113:        . K DA
        !           114:        . S DA=$P(@DDSREFT@("ADD",DDSI),U),DIK=U_$P(^(DDSI),U,2)
        !           115:        . F DDSX=2:1:$L(DA,",")-1 S DA(DDSX-1)=$P(DA,",",DDSX)
        !           116:        . S DA=+DA
        !           117:        . D ^DIK
        !           118:        K DDSI,DDSX
        !           119:        Q
        !           120:        ;#8078  record
        !           121:        ;#8079  subrecord
        !           122:        ;#8080  WARNING: DELETIONS ARE DONE...
        !           123:        ;#9038  Enter 'Y' to delete...