source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS01C.m@ 660

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1MCPOS01C ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 11:05
2 ;;2.3;Medicine;;09/13/1996
3 ;;
4F692 ; FILE 692
5 K ^MCAR(692,"B") ; "B" Cross
6 K ^MCAR(692,"C") ; EP Record
7 D
8 .N MCI
9 .S MCI=0
10 .F S MCI=$O(^MCAR(692,MCI)) Q:MCI<1 D
11 ..D
12 ...N MCII
13 ...S MCII=0
14 ...F S MCII=$O(^MCAR(692,MCI,6,MCII)) Q:MCII<1 D
15 ....K ^MCAR(692,MCI,6,MCII,1,"B") ; "B" Cross
16 ....Q
17 ...Q
18 ..Q
19 .Q
20 D EN1^MCPOS01(692)
21F693 ; FILE 693
22 K ^MCAR(693,"B") ; "B" Cross
23 K ^MCAR(693,"C") ; SYNONYM
24 D EN1^MCPOS01(693)
25F693P2 ; FILE 693.2
26 K ^MCAR(693.2,"B") ; "B" Cross
27 D EN1^MCPOS01(693.2)
28F693P3 ; FILE 693.3
29 K ^MCAR(693.3,"B") ; "B" Cross
30 K ^MCAR(693.3,"C") ; Code Number
31 D EN1^MCPOS01(693.3)
32F693P5 ; FILE 693.5
33 K ^MCAR(693.5,"B") ; "B" Cross
34 D EN1^MCPOS01(693.5)
35F693P6 ; FILE 693.6
36 K ^MCAR(693.6,"B") ; "B" Cross
37 D EN1^MCPOS01(693.6)
38F694 ; FILE 694
39 K ^MCAR(694,"B") ; "B" Cross
40 K ^MCAR(694,"C") ; Medical patient
41 K ^MCAR(694,"PCC") ; PCC Pointer
42 K ^MCAR(694,"ES") ; Release Code
43 D
44 .N MCI
45 .S MCI=0
46 .F S MCI=$O(^MCAR(694,MCI)) Q:MCI<1 D
47 ..K ^MCAR(694,MCI,8,"B") ; "B" Cross
48 ..K ^MCAR(694,MCI,10,"B") ; "B" Cross
49 ..K ^MCAR(694,MCI,5,"B") ; "B" Cross
50 ..K ^MCAR(694,MCI,2,"B") ; "B" Cross
51 ..K ^MCAR(694,MCI,"ICD","B") ; "B" Cross
52 ..K ^MCAR(694,MCI,2005,"B") ; "B" Cross
53 ..Q
54 .Q
55 D EN1^MCPOS01(694)
56F694P1 ; FILE 694.1
57 K ^MCAR(694.1,"B") ; "B" Cross
58 K ^MCAR(694.1,"C") ; Medical Type
59 D EN1^MCPOS01(694.1)
60F694P5 ; FILE 694.5
61 K ^MCAR(694.5,"B") ; "B" Cross
62 K ^MCAR(694.5,"C") ; Patient
63 D
64 .N MCI
65 .S MCI=0
66 .F S MCI=$O(^MCAR(694.5,MCI)) Q:MCI<1 D
67 ..K ^MCAR(694.5,MCI,11,"B") ; "B" Cross
68 ..Q
69 .Q
70 D EN1^MCPOS01(694.5)
71F694P9 ; FILE 694.8
72 K ^MCAR(694.8,"B") ; "B" Cross
73 K ^MCAR(694.8,"C") ; SYNONYM
74 K ^MCAR(694.8,"PAR") ; PARENT
75 K ^MCAR(684.8,"PS") ;Procedure/Subspecialty
76 D
77 .N MCI
78 .S MCI=0
79 .F S MCI=$O(^MCAR(694.8,MCI)) Q:MCI<1 D
80 ..K ^MCAR(694.8,MCI,1,"B") ; "B" Cross
81 ..K ^MCAR(694.8,MCI,3,"B") ; "B" Cross
82 ..Q
83 .Q
84 D EN1^MCPOS01(694.8)
85 G F695^MCPOS01D
Note: See TracBrowser for help on using the repository browser.