source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS01D.m@ 1154

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1MCPOS01D ;HIRMFO/WAA - Kill all cross reference in a file - ;5/31/96 08:08
2 ;;2.3;Medicine;;09/13/1996
3 ;;
4F695 ; FILE 695
5 K ^MCAR(695,"B") ; "B" Cross
6 K ^MCAR(695,"C") ; Medical Package Use
7 D EN1^MCPOS01(695)
8F695P1 ; FILE 695.1
9 K ^MCAR(695.1,"B") ; "B" Cross
10 D EN1^MCPOS01(695.1)
11F695P3 ; FILE 695.3
12 K ^MCAR(695.3,"B") ; "B" Cross
13 D EN1^MCPOS01(695.3)
14F695P4 ; FILE 695.4
15 K ^MCAR(695.4,"B") ; "B" Cross
16 D EN1^MCPOS01(695.4)
17F695P5 ; FILE 695.5
18 K ^MCAR(695.5,"B") ; "B" Cross
19 K ^MCAR(695.5,"BA") ; "BA" Cross
20 K ^MCAR(695.5,"C") ; Medical Use
21 D EN1^MCPOS01(695.5)
22F695P6 ; FILE 695.6
23 K ^MCAR(695.6,"B") ; "B" Cross
24 D EN1^MCPOS01(695.6)
25F695P8 ; FILE 695.8
26 K ^MCAR(695.8,"B") ; "B" Cross
27 K ^MCAR(695.8,"AC") ; Medical Package Used
28 D EN1^MCPOS01(695.8)
29F695P9 ; FILE 695.9
30 K ^MCAR(695.9,"B") ; "B" Cross
31 D EN1^MCPOS01(695.9)
32F696 ; FILE 696
33 K ^MCAR(696,"B") ; "B" Cross
34 D EN1^MCPOS01(696)
35F696P1 ; FILE 696.1
36 K ^MCAR(696.1,"B") ; "B" Cross
37 D EN1^MCPOS01(696.1)
38F696P2 ; FILE 696.2
39 K ^MCAR(696.2,"B") ; "B" Cross
40 D EN1^MCPOS01(696.2)
41F696P3 ; FILE 696.3
42 K ^MCAR(696.3,"B") ; "B" Cross
43 D EN1^MCPOS01(696.3)
44F696P4 ; FILE 696.4
45 K ^MCAR(696.4,"B") ; "B" Cross
46 D EN1^MCPOS01(696.4)
47F696P5 ; FILE 696.5
48 K ^MCAR(696.5,"B") ; "B" Cross
49 K ^MCAR(696.5,"D") ; Display Code
50 D EN1^MCPOS01(696.5)
51F696P7 ; FILE 696.7
52 K ^MCAR(696.7,"B") ; "B" Cross
53 D EN1^MCPOS01(696.7)
54F696P9 ; FILE 696.9
55 K ^MCAR(696.9,"B") ; "B" Cross
56 K ^MCAR(696.9,"C") ; Medical Package Use
57 D EN1^MCPOS01(696.9)
58F697 ; FILE 697
59 K ^MCAR(697,"B") ; "B" Cross
60 K ^MCAR(697,"C") ; Procedure
61 K ^MCAR(697,"D") ; Procedure Name
62 D
63 .N MCI
64 .S MCI=0
65 .F S MCI=$O(^MCAR(697,MCI)) Q:MCI<1 D
66 ..K ^MCAR(697,MCI,1,"B") ; "B" Cross
67 ..K ^MCAR(697,MCI,2,"B") ; "B" Cross
68 ..Q
69 .Q
70 D EN1^MCPOS01(697)
71F697P1 ; FILE 697.1
72 K ^MCAR(697.1,"B") ; "B" Cross
73 D EN1^MCPOS01(697.1)
74F697P2 ; FILE 697.2
75 K ^MCAR(697.2,"B") ; "B" Cross
76 K ^MCAR(697.2,"C") ; Global Location
77 K ^MCAR(697.2,"D") ; Type of Procedure
78 D EN1^MCPOS01(697.2)
79F697P3 ; FILE 697.3
80 K ^MCAR(697.3,"B") ; "B" Cross
81 K ^MCAR(697.3,"C") ; Description
82 D
83 .N MCI
84 .S MCI=0
85 .F S MCI=$O(^MCAR(697.3,MCI)) Q:MCI<1 D
86 ..K ^MCAR(697.3,MCI,1,"B") ; "B" Cross
87 ..K ^MCAR(697.3,MCI,1,"A") ; Entry Num
88 ..Q
89 .Q
90 D EN1^MCPOS01(697.3)
91F697P5 ; FILE 697.5
92 K ^MCAR(697.5,"B") ; "B" Cross
93 K ^MCAR(697.5,"C") ; .01 KWIC
94 K ^MCAR(697.5,"D") ; Procedures
95 D ; Diagnosis Code
96 .N MCI
97 .S MCI="A."
98 .F S MCI=$O(^MCAR(697.5,MCI)) Q:$P(MCI,".")'="A" D
99 ..K ^MCAR(697.5,MCI)
100 ..Q
101 .Q
102 D
103 .N MCI
104 .S MCI=0
105 .F S MCI=$O(^MCAR(697.5,MCI)) Q:MCI<1 D
106 ..K ^MCAR(697.5,MCI,2,"B") ; "B" Cross
107 ..K ^MCAR(697.5,MCI,1,"B") ; "B" Cross
108 ..K ^MCAR(697.5,MCI,4,"B") ; "B" Cross
109 ..Q
110 .Q
111 D EN1^MCPOS01(697.5)
112 G F698^MCPOS01E
Note: See TracBrowser for help on using the repository browser.