source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCCVDEL.m@ 623

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

initial load of WorldVistAEHR
File size: 7.1 KB
RevLine 
[613]1SCCVDEL ;ALB/TMP - OLD SCHED VISITS FILE DELETE; [ 03/04/98 09:39 AM ]
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4EN ; Main entry point - display scheduling files to delete
5 N Z
6 D DT^DICRW
7 D FULL^VALM1
8 W !!,*7," *** WARNING ***"
9 W !,"This action allows PERMANENT DELETION of old Scheduling files!"
10 W !,"If you are at all uncertain about this option, DO NOT delete any files.",!!
11 D PAUSE^SCCVU
12 D EN^VALM("SCCV CONV DELETE FILE MENU")
13 Q
14 ;
15INIT ; -- set up initial variables
16 D FNL
17 S U="^",VALMCNT=0,VALMBG=1
18 D BLD
19 Q
20 ;
21FNL ; Clean up
22 K ^TMP("SCCV.DELETE",$J),^TMP("SCCV.DELETE.DX",$J)
23 K SCCVFIL
24 S VALMBCK="Q"
25 Q
26 ;
27BLD ;Build parameter display
28 N SCCVFIL,SCCVFNM,SCCVGBL,SCCVST,SCCVDDT,SCCVEDT
29 S SCCVEDT=+$G(^SD(404.91,1,"CNV")) IF 'SCCVEDT S SCCVEDT=9999999 ; earliest date
30 S VALMBG=1
31 K ^TMP("SCCV.DELETE",$J),^TMP("SCCV.DELETE.DX",$J)
32 S VALMCNT=0
33 F SCCVFIL=40.1,40.15,409.5,409.43,409.44 D
34 . S VALMCNT=VALMCNT+1,X=""
35 . S SCCVFNM=$$FNAME(SCCVFIL)
36 . S SCCVGBL=$$FGLB(SCCVFIL)
37 . S SCCVDDT=$$FDELDT(SCCVFIL)
38 . S SCCVST=2 ; nothing deleted
39 . IF SCCVDDT<SCCVEDT S SCCVST=3 ; can't delete
40 . IF $D(@SCCVGBL)=0 S SCCVST=0 ; data deleted
41 . IF SCCVST,$D(^DIC(SCCVFIL,0))=0 S SCCVST=1 ; dd deleted
42 . S X=$$SETFLD^VALM1(VALMCNT,X,"NUMBER")
43 . S X=$$SETFLD^VALM1(SCCVFIL,X,"FNUMBER")
44 . S X=$$SETFLD^VALM1(SCCVFNM,X,"FNAME")
45 . S X=$$SETFLD^VALM1(SCCVGBL,X,"GLOBAL")
46 . S X=$$SETFLD^VALM1($S('SCCVST:"Data and DD Deleted",SCCVST=1:"DD Deleted Only",SCCVST=2:"Nothing Deleted",1:"Deletion Not Allowed"),X,"STATUS")
47 . ;
48 . S ^TMP("SCCV.DELETE",$J,VALMCNT,0)=X
49 . S ^TMP("SCCV.DELETE",$J,"IDX",VALMCNT,VALMCNT)=""
50 . S ^TMP("SCCV.DELETE"_".DX",$J,VALMCNT)=SCCVFIL_U_SCCVST_U_"("_SCCVFNM_")"
51 Q
52 ;
53DELDD ; Delete DDs and templates for files
54 N VALMY,SCCV,SCCVFIL
55 D FULL^VALM1
56 W !
57 ;
58 IF '$$GAP() G DELDDQ
59 ;
60 IF '$$COMPL() G DELDDQ
61 ;
62 I '$O(^SD(404.98,0))!'$$COMPL^SCCVPAR(1) D G:'SCOK DELDDQ
63 . N DIR,Y
64 . S DIR("B")="NO"
65 . S DIR(0)="YA"
66 . S DIR("A",1)="It appears that no conversion was completed at your site."
67 . S DIR("A",2)="If you choose to continue, all data in the old Scheduling files could be lost."
68 . S DIR("A")="Are you sure you want to do this?: "
69 . D ^DIR K DIR
70 . S SCOK=(Y=1)
71 ;
72 S DIR(0)="YA"
73 S DIR("A",1)="This action will PERMANENTLY DELETE any selected files!"
74 S DIR("A")="Are you absolutely sure you want to do this?: "
75 S DIR("B")="NO"
76 D ^DIR K DIR
77 G:Y'=1 DELDDQ
78 ;
79 W !
80 D EN^VALM2($G(XQORNOD(0)))
81 S SCCV=0 F S SCCV=$O(VALMY(SCCV)) Q:'SCCV D
82 . S SCCVFIL=$G(^TMP("SCCV.DELETE.DX",$J,SCCV))
83 . IF $P(SCCVFIL,U,2)=3 D Q
84 . . W !!,"Deleting File # "_+SCCVFIL_" "_$P(SCCVFIL,U,3)," is not allowed."
85 . . W !,"You did not convert back to '"_$$FMTE^XLFDT($$FDELDT(+SCCVFIL),"5Z")_"'."
86 . . D PAUSE^SCCVU
87 . . ;
88 . IF $P(SCCVFIL,U,2)'=2 D Q
89 . . W !!,"DD and templates for File # "_+SCCVFIL_" "_$P(SCCVFIL,U,3)
90 . . W !,"have already been deleted!"
91 . . D PAUSE^SCCVU
92 . D DELFIL(+SCCVFIL,$P(SCCVFIL,U,3))
93 D BLD
94DELDDQ S VALMBCK="R"
95 Q
96 ;
97GAP() ; -- check to see if there gaps in conversion
98 ; -- return: 1 - no gap | 0 - gaps exist
99 N SCOK
100 S SCOK=0
101 I $$SEQGAP^SCCVPAR() D G GAPQ
102 . N DIR,Y,SCDT1
103 . S SCDT1=$P($G(^SD(404.91,1,"CNV")),U)
104 . S:SCDT1 SCDT1=$$FMTE^XLFDT(SCDT1,"5Z")
105 . W !,"You have one or more gaps in conversion dates from your earliest"
106 . W !,"date to convert ("_$S(SCDT1'="":SCDT1,1:"NOT ENTERED")_") to 09/30/1996."
107 . W !,"You must finish converting before you can delete any of these files."
108 . D PAUSE^SCCVU
109 S SCOK=1
110GAPQ Q SCOK
111 ;
112COMPL() ; -- check if conversion complete flag is set
113 ; -- return: 1 - set | 0 - not set
114 N SCOK
115 S SCOK=0
116 I '$P($G(^SD(404.91,1,"CNV")),U,4) D G COMPLQ
117 . W !,"No file deletes can be performed until a date has been"
118 . W !,"recorded in the conversion site parameters indicating"
119 . W !,"that the conversion is complete."
120 . D PAUSE^SCCVU
121 S SCOK=1
122COMPLQ Q SCOK
123 ;
124DELFIL(FNO,FNM) ;Delete dd and templates for the specified file #FNO
125 ; FNM = the file name in ()
126 N DIR,Y,SCOK
127 S SCOK=0
128 ;
129 S DIR(0)="YA"
130 S DIR("B")="NO"
131 S DIR("A",1)="I am about to PERMANENTLY DELETE file #"_FNO_" "_FNM_"!"
132 S DIR("A")="Are you absolutely sure you want to do this? "
133 D ^DIR
134 K DIR
135 S SCOK=Y
136 ;
137 IF SCOK=1 D
138 . S DIR(0)="YA"
139 . S DIR("B")="NO"
140 . S DIR("A")="Does your site have a backup/archive of this file? "
141 . D ^DIR
142 . K DIR
143 . S SCOK=Y
144 . ;
145 . ; -- log user and date/time info
146 . IF SCOK=1 D
147 . . S Y=$$LOG(FNO,$G(DUZ),"DD")
148 . . S SCOK=+Y
149 . . IF 'Y D
150 . . . W !,"Cannot delete data dictionary and templates for file!"
151 . . . W !,$P(Y,U,2)
152 ;
153 I SCOK=1 D G DFQ
154 . W !!,"Data Dictionary and Template Deletion of"
155 . W !,"file # "_FNO_" "_FNM_" is in process...",!
156 . S DIU=FNO
157 . S DIU(0)="ET"
158 . D EN^DIU2
159 . W !!,"Data Dictionary and Templates for File # "_FNO_" "_FNM
160 . W !,"have been deleted."
161 . D MSG(FNO)
162 ;
163 W !,"Data Dictionary and Templates for File # "_FNO_" "_FNM
164 W !,"have NOT been deleted."
165 ;
166DFQ D PAUSE^SCCVU
167 Q
168 ;
169MSG(FNO) ; -- display protect message
170 N SCGLB
171 S SCGLB=$$FGLB(FNO)
172 W !
173 W !,"NOTE: Only the data dictionary and templates have been"
174 W !," deleted."
175 W !
176 W !," In order to delete the data, execute the following action:"
177 W !," Data Global Deletion"
178 W !
179 ;
180 IF FNO=409.43!(FNO=409.44) G MSGQ
181 ;
182 W !," However, you must first determine if KILLing at the global"
183 W !," root level is allowed for this global '",SCGLB,"' on your"
184 W !," system."
185 W !
186 W !," Unfortunately, there is no programmer API to check this"
187 W !," global characteristic using Kernel tools."
188 W !
189 W !," If you need help checking and setting this global parameter,"
190 W !," please contact National VistA Support (NVS)."
191 W !
192MSGQ Q
193 ;
194LOG(FILE,USER,TYPE) ; -- log file deletion
195 N SCFIN,SCRET,SCDEL,DIE,DA,Y,DR,X
196 S SCRET="1^Log data successfully filed."
197 ;
198 IF $G(TYPE)="DD"!(TYPE="DATA") D
199 . S SCDEL("TYPE")=TYPE
200 ELSE D
201 . S SCRET="0^Not a valid deletion type"
202 ;
203 IF 'SCRET G LOGQ
204 ;
205 IF $G(FILE) D
206 . IF FILE=409.5!(FILE=409.43)!(FILE=409.44)!(FILE=40.1)!(FILE=40.15) D
207 . . S SCDEL("FILE")=FILE
208 . ELSE D
209 . . S SCRET="0^Not a file that can be deleted."
210 ELSE D
211 . S SCRET="0^No file specified."
212 ;
213 IF 'SCRET G LOGQ
214 ;
215 IF $G(USER) D
216 . S SCDEL("USER")=USER
217 ELSE D
218 . S SCRET="0^No user specified."
219 ;
220 IF 'SCRET G LOGQ
221 ;
222 S SCDEL("DATE/TIME")=$$NOW^XLFDT
223 ;
224 L +^SD(404.91,1):2
225 IF '$T S SCRET="0^Unable to lock SCHEDULING PARAMETER file." G LOGQ
226 S DIE="^SD(404.91,",DA=1,DR="[SCCV CONV FILE DELETION LOG]" D ^DIE
227 L -^SD(404.91,1)
228 IF '$G(SCFIN) S SCRET="0^Filing of deletion log data failed." G LOGQ
229 ;
230LOGQ Q SCRET
231 ;
232FNAME(FNO) ; -- get file name
233 N F
234 S F(40.1)="OPC"
235 S F(40.15)="OPC ERRORS"
236 S F(409.5)="SCHEDULING VISITS"
237 S F(409.43)="OUTPATIENT DIAGNOSIS"
238 S F(409.44)="OUTPATIENT PROVIDER"
239 Q F(FNO)
240 ;
241FGLB(FNO) ; -- get data global for file
242 N F
243 S F(40.1)="^SDASF"
244 S F(40.15)="^SDASE"
245 S F(409.5)="^SDV"
246 S F(409.43)="^SDD(409.43)"
247 S F(409.44)="^SDD(409.44)"
248 Q F(FNO)
249 ;
250FDELDT(FNO) ; -- get date the site must convert back to in order to delete
251 ; file dd and data
252 N F
253 S F(40.1)=9999998
254 S F(40.15)=9999998
255 S F(409.5)=2871001
256 S F(409.43)=2931001
257 S F(409.44)=2931001
258 Q F(FNO)
259 ;
Note: See TracBrowser for help on using the repository browser.