source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS01G.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1MCPOS01G ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:54
2 ;;2.3;Medicine;;09/13/1996
3 ;;
4F700 ; FILE 700
5 K ^MCAR(700,"B") ; "B" Cross
6 K ^MCAR(700,"AV") ; Volume Study
7 K ^MCAR(700,"AF") ; Flow Study
8 K ^MCAR(700,"ADI") ; DLCO-SB
9 K ^MCAR(700,"AS") ; Special Study
10 K ^MCAR(700,"C") ; Medical Patient
11 K ^MCAR(700,"PCC") ; PCC Pointer
12 D
13 .N MCI
14 .S MCI=0
15 .F S MCI=$O(^MCAR(700,MCI)) Q:MCI<1 D
16 ..K ^MCAR(700,MCI,1,"B") ; "B" Cross
17 ..K ^MCAR(700,MCI,3,"B") ; "B" Cross
18 ..K ^MCAR(700,MCI,4,"B") ; "B" Cross
19 ..K ^MCAR(700,MCI,6,"B") ; "B" Cross
20 ..K ^MCAR(700,MCI,7,"B") ; "B" Cross
21 ..K ^MCAR(700,MCI,8,"B") ; "B" Cross
22 ..K ^MCAR(700,MCI,9,"B") ; "B" Cross
23 ..K ^MCAR(700,MCI,10,"B") ; "B" Cross
24 ..K ^MCAR(700,MCI,12,"B") ; "B" Cross
25 ..K ^MCAR(700,MCI,13,"B") ; "B" Cross
26 ..K ^MCAR(700,MCI,15,"B") ; "B" Cross
27 ..K ^MCAR(700,MCI,"S","B") ; "B" Cross
28 ..D
29 ...N MCII
30 ...S MCII=0
31 ...F S MCII=$O(^MCAR(700,MCI,"S",MCII)) Q:MCII<1 D
32 ....K ^MCAR(700,MCI,"S",MCII,3,"B") ; "B" Cross
33 ....Q
34 ...Q
35 ..K ^MCAR(700,MCI,24,"B") ; "B" Cross
36 ..K ^MCAR(700,MCI,"ICD","B") ; "B" Cross
37 ..Q
38 .Q
39 D EN1^MCPOS01(700)
40F700P1 ; FILE 700.1
41 K ^MCAR(700.1,"B") ; "B" Cross
42 K ^MCAR(700.1,"AC") ; Sex Type
43 D EN1^MCPOS01(700.1)
44F700P2 ; FILE 700.2
45 K ^MCAR(700.2,"B") ; "B" Cross
46 K ^MCAR(700.2,"D") ; Type
47 K ^MCAR(700.2,"C") ; Reference
48 K ^MCAR(700.2,"E") ; Sex Type
49 D EN1^MCPOS01(700.2)
50F700P5 ; FILE 700.5
51 K ^MCAR(700.5,"B") ; "B" Cross
52 K ^MCAR(700.5,"C") ; Date/Time Latest
53 K ^MCAR(700.5,"PT") ; Patient
54 D EN1^MCPOS01(700.5)
55F701 ; FILE 701
56 K ^MCAR(701,"B") ; "B" Cross
57 K ^MCAR(701,"C") ; Medical Patient
58 K ^MCAR(701,"D") ; SSN
59 K ^MCAR(701,"PCC") ; PCC Pointer
60 D
61 .N MCI
62 .S MCI=0
63 .F S MCI=$O(^MCAR(701,MCI)) Q:MCI<1 D
64 ..K ^MCAR(701,MCI,6,"B") ; "B" Cross
65 ..K ^MCAR(701,MCI,13,"B") ; "B" Cross
66 ..K ^MCAR(701,MCI,"ICD","B") ; "B" Cross
67 ..K ^MCAR(701,MCI,2005,"B") ; "B" Cross
68 ..Q
69 .Q
70 D EN1^MCPOS01(701)
71 Q
Note: See TracBrowser for help on using the repository browser.