source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS01A.m@ 846

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1MCPOS01A ;HIRMFO/WAA - Kill all cross reference in a file - ;8/6/96 07:23
2 ;;2.3;Medicine;;09/13/1996
3 ;;
4 ;
5 ; These routines will loop through a list of file number
6 ; and delete all the cross references for that file.
7 ; Then these routines will use file manager to reindex all
8 ; the cross references in that same file.
9 ;
10 ; This program is the master control program. It
11 ; will loop through a list of file number and pass that
12 ; number to the kill routine then it will pass to the reindex
13 ; routine
14 ;
15EN1 ; Main Entry point
16F690 ; FILE 690
17 K ^MCAR(690,"B") ; "B" Cross
18 K ^MCAR(690,"AC") ; Procedures
19 D
20 .N MCI
21 .S MCI=0
22 .F S MCI=$O(^MCAR(690,MCI)) Q:MCI<1 D
23 ..K ^MCAR(690,MCI,"P","B") ; "B" Cross
24 ..K ^MCAR(690,MCI,"P1","B") ; "B" Cross
25 ..K ^MCAR(690,MCI,"P4","B") ; "B" Cross
26 ..Q
27 .Q
28 D EN1^MCPOS01(690)
29F690P1 ; FILE 690.1
30 K ^MCAR(690.1,"B") ; "B" Cross
31 D
32 .N MCI
33 .S MCI=0
34 .F S MCI=$O(^MCAR(690.1,MCI)) Q:MCI<1 D
35 ..K ^MCAR(690.1,MCI,1,"B") ; "B" Cross
36 ..K ^MCAR(690.1,MCI,2,"B") ; "B" Cross
37 ..Q
38 .Q
39 D EN1^MCPOS01(690.1)
40F690P2 ; FILE 690.2
41 K ^MCAR(690.2,"B") ; "B" Cross
42 K ^MCAR(690.2,"C") ; File number cross
43 K ^MCAR(690.2,"D") ; Procedure
44 D
45 .N MCI
46 .S MCI=0
47 .F S MCI=$O(^MCAR(690.2,MCI)) Q:MCI<1 D
48 ..K ^MCAR(690.2,MCI,1,"B") ; "B" Cross
49 ..K ^MCAR(690.2,MCI,2,"B") ; "B" Cross
50 ..D
51 ...N MCII
52 ...S MCII=0
53 ...F S MCII=$O(^MCAR(690.2,MCI,2,MCII)) Q:MCII<1 D
54 ....K ^MCAR(690.2,MCI,2,MCII,1,"B") ; "B" Cross
55 ....Q
56 ...Q
57 ..K ^MCAR(690.1,MCI,3,"B") ; "B" Cross
58 ..Q
59 .Q
60 D EN1^MCPOS01(690.2)
61F690P5 ; FILE 690.5
62 K ^MCAR(690.5,"B") ; "B" Cross
63 K ^MCAR(690.5,"C") ; ASTM cross
64 D EN1^MCPOS01(690.5)
65F690P97 ; FILE 690.97
66 K ^MCAR(690.97,"B") ; "B" Cross
67 D EN1^MCPOS01(690.97)
68F690P99 ; FILE 690.99
69 K ^MCAR(690.99,"B") ; "B" Cross
70 K ^MCAR(690.99,"AA") ; IEN
71 K ^MCAR(690.99,"AB") ; SUB-IEN
72 D EN1^MCPOS01(690.99)
73 G F691^MCPOS01B
Note: See TracBrowser for help on using the repository browser.