- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01A 1953 printed Feb 18, 2025@23:42:43 Page 2
- 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