MCPOS01A ;HIRMFO/WAA - Kill all cross reference in a file - ;8/6/96 07:23
;;2.3;Medicine;;09/13/1996
;;
;
; These routines will loop through a list of file number
; and delete all the cross references for that file.
; Then these routines will use file manager to reindex all
; the cross references in that same file.
;
; This program is the master control program. It
; will loop through a list of file number and pass that
; number to the kill routine then it will pass to the reindex
; routine
;
EN1 ; Main Entry point
F690 ; FILE 690
K ^MCAR(690,"B") ; "B" Cross
K ^MCAR(690,"AC") ; Procedures
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(690,MCI)) Q:MCI<1 D
..K ^MCAR(690,MCI,"P","B") ; "B" Cross
..K ^MCAR(690,MCI,"P1","B") ; "B" Cross
..K ^MCAR(690,MCI,"P4","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(690)
F690P1 ; FILE 690.1
K ^MCAR(690.1,"B") ; "B" Cross
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(690.1,MCI)) Q:MCI<1 D
..K ^MCAR(690.1,MCI,1,"B") ; "B" Cross
..K ^MCAR(690.1,MCI,2,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(690.1)
F690P2 ; FILE 690.2
K ^MCAR(690.2,"B") ; "B" Cross
K ^MCAR(690.2,"C") ; File number cross
K ^MCAR(690.2,"D") ; Procedure
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(690.2,MCI)) Q:MCI<1 D
..K ^MCAR(690.2,MCI,1,"B") ; "B" Cross
..K ^MCAR(690.2,MCI,2,"B") ; "B" Cross
..D
...N MCII
...S MCII=0
...F S MCII=$O(^MCAR(690.2,MCI,2,MCII)) Q:MCII<1 D
....K ^MCAR(690.2,MCI,2,MCII,1,"B") ; "B" Cross
....Q
...Q
..K ^MCAR(690.1,MCI,3,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(690.2)
F690P5 ; FILE 690.5
K ^MCAR(690.5,"B") ; "B" Cross
K ^MCAR(690.5,"C") ; ASTM cross
D EN1^MCPOS01(690.5)
F690P97 ; FILE 690.97
K ^MCAR(690.97,"B") ; "B" Cross
D EN1^MCPOS01(690.97)
F690P99 ; FILE 690.99
K ^MCAR(690.99,"B") ; "B" Cross
K ^MCAR(690.99,"AA") ; IEN
K ^MCAR(690.99,"AB") ; SUB-IEN
D EN1^MCPOS01(690.99)
G F691^MCPOS01B
MCPOS01A ;HIRMFO/WAA - Kill all cross reference in a file - ;8/6/96 07:23
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
+3 ;
+4 ; These routines will loop through a list of file number
+5 ; and delete all the cross references for that file.
+6 ; Then these routines will use file manager to reindex all
+7 ; the cross references in that same file.
+8 ;
+9 ; This program is the master control program. It
+10 ; will loop through a list of file number and pass that
+11 ; number to the kill routine then it will pass to the reindex
+12 ; routine
+13 ;
EN1 ; Main Entry point
F690 ; FILE 690
+1 ; "B" Cross
KILL ^MCAR(690,"B")
+2 ; Procedures
KILL ^MCAR(690,"AC")
+3 Begin DoDot:1
+4 NEW MCI
+5 SET MCI=0
+6 FOR
SET MCI=$ORDER(^MCAR(690,MCI))
IF MCI<1
QUIT
Begin DoDot:2
+7 ; "B" Cross
KILL ^MCAR(690,MCI,"P","B")
+8 ; "B" Cross
KILL ^MCAR(690,MCI,"P1","B")
+9 ; "B" Cross
KILL ^MCAR(690,MCI,"P4","B")
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 DO EN1^MCPOS01(690)
F690P1 ; FILE 690.1
+1 ; "B" Cross
KILL ^MCAR(690.1,"B")
+2 Begin DoDot:1
+3 NEW MCI
+4 SET MCI=0
+5 FOR
SET MCI=$ORDER(^MCAR(690.1,MCI))
IF MCI<1
QUIT
Begin DoDot:2
+6 ; "B" Cross
KILL ^MCAR(690.1,MCI,1,"B")
+7 ; "B" Cross
KILL ^MCAR(690.1,MCI,2,"B")
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 DO EN1^MCPOS01(690.1)
F690P2 ; FILE 690.2
+1 ; "B" Cross
KILL ^MCAR(690.2,"B")
+2 ; File number cross
KILL ^MCAR(690.2,"C")
+3 ; Procedure
KILL ^MCAR(690.2,"D")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(690.2,MCI))
IF MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(690.2,MCI,1,"B")
+9 ; "B" Cross
KILL ^MCAR(690.2,MCI,2,"B")
+10 Begin DoDot:3
+11 NEW MCII
+12 SET MCII=0
+13 FOR
SET MCII=$ORDER(^MCAR(690.2,MCI,2,MCII))
IF MCII<1
QUIT
Begin DoDot:4
+14 ; "B" Cross
KILL ^MCAR(690.2,MCI,2,MCII,1,"B")
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 ; "B" Cross
KILL ^MCAR(690.1,MCI,3,"B")
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 DO EN1^MCPOS01(690.2)
F690P5 ; FILE 690.5
+1 ; "B" Cross
KILL ^MCAR(690.5,"B")
+2 ; ASTM cross
KILL ^MCAR(690.5,"C")
+3 DO EN1^MCPOS01(690.5)
F690P97 ; FILE 690.97
+1 ; "B" Cross
KILL ^MCAR(690.97,"B")
+2 DO EN1^MCPOS01(690.97)
F690P99 ; FILE 690.99
+1 ; "B" Cross
KILL ^MCAR(690.99,"B")
+2 ; IEN
KILL ^MCAR(690.99,"AA")
+3 ; SUB-IEN
KILL ^MCAR(690.99,"AB")
+4 DO EN1^MCPOS01(690.99)
+5 GOTO F691^MCPOS01B
