source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDS6.m@ 1582

Last change on this file since 1582 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1DDS6 ;SFISC/MKO-DELETIONS ;2:09 PM 9 Feb 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
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(DDSDA,DIE) 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(DDP,DDSPTB,DDSDA,.DA)
19 . E S DDACT="Q",DA="",DDSDAORG=DA,DDSDA="0,"
20 . I '$D(DDSPTB),'$P(DDSSC(DDSSC),U,4),'$D(DDSREP) D
21 .. D PG^DDSRSEL
22 .. I $G(DDSSEL) D
23 ... D CLRDAT^DDSRSEL
24 ... D R^DDSR
25 ... D PUT^DDSVALF(1,1,$P(^DIST(.403,+DDS,21),U),"","","0,")
26 Q
27 ;
28DM ;Enter here if user deleted record from the Select prompt
29 ;(called from DDS5)
30 ;In: DDSU array, DDSOLD, DDSFLD
31 ;
32 ;Get DA and DIE for subfile level and delete
33 D DDA^DDS5(DDSOLD,.DA,.DDSDL)
34 D
35 . N DIE,DDSDA
36 . S DIE=U_$P(DDSU("M"),U,2)
37 . S DDSDA=DA_"," F DDSI=1:1:DDSDL S DDSDA=DDSDA_DA(DDSI)_","
38 . K DDSI
39 . D D
40 . D:Y K(DDSDA,DIE)
41 ;
42 I 'Y D
43 . S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"D")=DDSOLD
44 . S:$D(DDSU("X"))#2 @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=DDSU("X")
45 . D UDA^DDS5(.DA,.DDSDL)
46 E D
47 . D LST^DDS5(.DA,.DDSDL,DDP,DDSDA,DDSFLD)
48 . D UDA^DDS5(.DA,.DDSDL)
49 Q
50 ;
51D ;Delete the subrecord
52 ;In: DA array, DIE, DDSDL; Out: Y=1 if successful
53 N DR,DDS6DA,DDSI
54 D:DDM CLRMSG^DDS
55 S DDM=1
56 ;
57 K DIR S DIR(0)="YO"
58 D BLD^DIALOG(8080,$$EZBLD^DIALOG(8078+(DDSDL>0)),"","DIR(""A"")")
59 D BLD^DIALOG(9038,"","","DIR(""?"")")
60 ;
61 S DIR0=IOSL-1_U_($L(DIR("A"))+1)_"^3^"_(IOSL-3)_"^0"
62 D ^DIR K DIR
63 D CLRMSG^DDS
64 I X=""!$D(DIRUT)!'Y S Y=0 K DIRUT,DUOUT,DIROUT,DTOUT Q
65 ;
66 S DDS6DA=DA N D0
67 F DDSI=1:1 Q:$D(DA(DDSI))[0 S DDS6DA(DDSI)=DA(DDSI) N @("D"_DDSI)
68 W $P(DDGLVID,DDGLDEL,9) S X=IOM X $G(^%ZOSF("RM"))
69 S DR=".01///@" D ^DIE K DI
70 W $P(DDGLVID,DDGLDEL,8) S X=0 X ^%ZOSF("RM")
71 ;
72 ;I $D(DA) H 2 W $P(DDGLCLR,DDGLDEL,2) D R^DDSR S Y=0 Q
73 I $D(DA) S:$Y>(DDSHBX+1) DDSKM=1,DDM=1 S Y=0 Q
74 ;
75 S Y=1,DA=DDS6DA
76 I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
77 F DDSI=1:1 Q:$D(DDS6DA(DDSI))[0 S DA(DDSI)=DDS6DA(DDSI)
78 Q
79 ;
80K(DDSIEN,DIE) ;Remove all data pertaining to the (sub)record from @DDSREFT
81 ;In: DDSIEN = IENS of record being deleted
82 ; DIE = global root
83 ;
84 N B,P,FN,PAT,PDA,IENS
85 S PAT=".E1"""_DDSIEN_""""
86 ;
87 ;Loop through all pages/blocks in ^TMP
88 S P=0 F S P=$O(@DDSREFT@(P)) Q:'P D
89 . S B=0 F S B=$O(@DDSREFT@(P,B)) Q:'B D
90 .. ;Get file number of the block
91 .. S FN="F"_$P(@DDSREFS@(P,B),U,3)
92 .. ;
93 .. ;Loop through all records loaded for that block
94 .. S IENS=" "
95 .. F S IENS=$O(@DDSREFT@(P,B,IENS)) Q:'IENS D
96 ... ;
97 ... ;If the data pertains to the current or ancestor file, kill it
98 ... ;Get the parent IENS (also indicates the block is repeating)
99 ... S PDA=$P($G(@DDSREFT@(P,B,IENS)),U,2)
100 ... ;
101 ... I 'PDA,IENS?@PAT,$P(@DDSREFT@(P,B,IENS,"GL"),DIE)="" D
102 .... K @DDSREFT@(P,B,IENS)
103 .... K @DDSREFT@(FN,IENS)
104 ... E I PDA,@DDSREFT@(P,B,IENS,"GL")=DIE D
105 .... D DELP(P,B,PDA,DDSIEN)
106 .... K @DDSREFT@(FN,DDSIEN)
107 Q
108 ;
109DELP(P,B,PDA,IENS) ;Delete subrecord from parent's list
110 ;In: P = page number
111 ; B = block number
112 ; PDA = parent IENS
113 ; IENS = IENS of record to remove
114 N R,S
115 ;
116 S S=$G(@DDSREFT@(P,B,PDA,"B",IENS)) Q:'S
117 K @DDSREFT@(P,B,PDA,"B",IENS)
118 ;
119 F S=S:1 Q:$D(@DDSREFT@(P,B,PDA,S+1))[0 D
120 . S R=@DDSREFT@(P,B,PDA,S+1)
121 . S @DDSREFT@(P,B,PDA,S)=R
122 . S @DDSREFT@(P,B,PDA,"B",R)=S
123 K @DDSREFT@(P,B,PDA,S)
124 Q
125 ;
126DEL ;Delete (sub)records added between saves
127 ;(user quit without saving)
128 N DA,DIK
129 S DDSI=0
130 F S DDSI=$O(@DDSREFT@("ADD",DDSI)) Q:'DDSI D
131 . K DA
132 . S DA=$P(@DDSREFT@("ADD",DDSI),U),DIK=U_$P(^(DDSI),U,2)
133 . F DDSX=2:1:$L(DA,",")-1 S DA(DDSX-1)=$P(DA,",",DDSX)
134 . S DA=+DA
135 . D ^DIK
136 K DDSI,DDSX
137 Q
138 ;#8078 record
139 ;#8079 subrecord
140 ;#8080 WARNING: DELETIONS ARE DONE...
141 ;#9038 Enter 'Y' to delete...
Note: See TracBrowser for help on using the repository browser.