Return to DDS6.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS6.m, revision 1.1.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...