| [613] | 1 | MCPOS01A ;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 | ;
|
|---|
| 15 | EN1 ; Main Entry point
|
|---|
| 16 | F690 ; 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)
|
|---|
| 29 | F690P1 ; 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)
|
|---|
| 40 | F690P2 ; 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)
|
|---|
| 61 | F690P5 ; 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)
|
|---|
| 65 | F690P97 ; FILE 690.97
|
|---|
| 66 | K ^MCAR(690.97,"B") ; "B" Cross
|
|---|
| 67 | D EN1^MCPOS01(690.97)
|
|---|
| 68 | F690P99 ; 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
|
|---|
