source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS01E.m@ 1093

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1MCPOS01E ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:53
2 ;;2.3;Medicine;;09/13/1996
3 ;;
4F698 ; FILE 698
5 K ^MCAR(698,"B") ; "B" Cross
6 K ^MCAR(698,"C") ; Medical Patient
7 K ^MCAR(698,"PCC") ; PCC Pointer
8 D
9 .N MCI
10 .S MCI=0
11 .F S MCI=$O(^MCAR(698,MCI)) Q:MCI<1 D
12 ..K ^MCAR(698,MCI,"ICD","B") ; "B" Cross
13 ..Q
14 .Q
15 D EN1^MCPOS01(698)
16F698P1 ; FILE 698.1
17 K ^MCAR(698.1,"B") ; "B" Cross
18 K ^MCAR(698.1,"C") ; Medical Patient
19 K ^MCAR(698.1,"PCC") ; PCC Pointer
20 D
21 .N MCI
22 .S MCI=0
23 .F S MCI=$O(^MCAR(698.1,MCI)) Q:MCI<1 D
24 ..K ^MCAR(698.1,MCI,"ICD","B") ; "B" Cross
25 ..Q
26 .Q
27 D EN1^MCPOS01(698.1)
28F698P2 ; FILE 698.2
29 K ^MCAR(698.2,"B") ; "B" Cross
30 K ^MCAR(698.2,"C") ; Medical Patient
31 K ^MCAR(698.2,"PCC") ; PCC Pointer
32 D
33 .N MCI
34 .S MCI=0
35 .F S MCI=$O(^MCAR(698.2,MCI)) Q:MCI<1 D
36 ..K ^MCAR(698.2,MCI,"ICD","B") ; "B" Cross
37 ..Q
38 .Q
39 D EN1^MCPOS01(698.2)
40F698P3 ; FILE 698.3
41 K ^MCAR(698.3,"B") ; "B" Cross
42 K ^MCAR(698.3,"C") ; Medical Patient
43 K ^MCAR(698.3,"PCC") ; PCC Pointer
44 D
45 .N MCI
46 .S MCI=0
47 .F S MCI=$O(^MCAR(698.3,MCI)) Q:MCI<1 D
48 ..K ^MCAR(698.3,MCI,"ICD","B") ; "B" Cross
49 ..Q
50 .Q
51 D EN1^MCPOS01(698.3)
52F698P4 ; FILE 698.4
53 K ^MCAR(698.4,"B") ; "B" Cross
54 K ^MCAR(698.4,"C") ; Type of Equipment
55 K ^MCAR(698.4,"D") ; Manufacture
56 D EN1^MCPOS01(698.4)
57F698P6 ; FILE 698.6
58 K ^MCAR(698.6,"B") ; "B" Cross
59 K ^MCAR(698.6,"C") ; Mnemonic
60 D EN1^MCPOS01(698.6)
61F698P9 ; FILE 698.9
62 K ^MCAR(698.9,"B") ; "B" Cross
63 K ^MCAR(698.9,"D") ; Abbreviation
64 D EN1^MCPOS01(698.9)
65 G F699^MCPOS01F
Note: See TracBrowser for help on using the repository browser.