MCPOS01B ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 11:05
;;2.3;Medicine;;09/13/1996
;;
F691 ; FILE 691
K ^MCAR(691,"B") ; "B" Cross
K ^MCAR(691,"C") ; Medical patient
K ^MCAR(691,"PCC") ; PCC Pointer
K ^MCAR(691,"ES") ; Release Code
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691,MCI)) Q:MCI<1 D
..K ^MCAR(691,MCI,.3,"B") ; "B" Cross
..K ^MCAR(691,MCI,.4,"B") ; "B" Cross
..K ^MCAR(691,MCI,1,"B") ; "B" Cross
..K ^MCAR(691,MCI,14,"B") ; "B" Cross
..K ^MCAR(691,MCI,"ICD","B") ; "B" Cross
..K ^MCAR(691,MCI,2005,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(691)
F691P1 ; FILE 691.1
K ^MCAR(691.1,"B") ; "B" Cross
K ^MCAR(691.1,"C") ; Medical Patient
K ^MCAR(691.1,"PCC") ; PCC Pointer
K ^MCAR(691.1,"ES") ; Release Code
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.1,MCI)) Q:MCI<1 D
..K ^MCAR(691.1,MCI,.3,"B") ; "B" Cross
..K ^MCAR(691.1,MCI,.4,"B") ; "B" Cross
..K ^MCAR(691.1,MCI,6,"B") ; "B" Cross
..K ^MCAR(691.1,MCI,"ICD","B") ; "B" Cross
..K ^MCAR(691.1,MCI,2005,"B") ; "B" Cross
.Q
D EN1^MCPOS01(691.1)
F691P5 ; FILE 691.5
K ^MCAR(691.5,"B") ; "B" Cross
K ^MCAR(691.5,"C") ; Medical Patient
K ^MCAR(691.5,"PCC") ; PCC pointer
K ^MCAR(691.5,"ES") ; Release Status
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.5,MCI)) Q:MCI<1 D
..K ^MCAR(691.5,MCI,.3,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,.4,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,.5,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,3,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,5,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,6,"B") ; "B" Cross
..K ^MCAR(691.5,MCI,"ICD","B") ; "B" Cross
..K ^MCAR(691.5,MCI,2005,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(691.5)
F691P6 ; FILE 691.6
K ^MCAR(691.6,"B") ; "B" Cross
K ^MCAR(691.6,"C") ; Medical Patient
K ^MCAR(691.6,"PCC") ; PCC Pointer
K ^MCAR(691.6,"ES") ; Release Code
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.6,MCI)) Q:MCI<1 D
..K ^MCAR(691.6,MCI,.3,"B") ; "B" Cross
..K ^MCAR(691.6,MCI,.4,"B") ; "B" Cross
..K ^MCAR(691.6,MCI,1,"B") ; "B" Cross
..K ^MCAR(691.6,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(691.6)
F691P7 ; FILE 691.7
K ^MCAR(691.7,"B") ; "B" Cross
K ^MCAR(691.7,"C") ; Medical Patient
K ^MCAR(691.7,"PCC") ; PCC Pointer
K ^MCAR(691.7,"ES") ; Release Code
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.7,MCI)) Q:MCI<1 D
..K ^MCAR(691.7,MCI,.3,"B") ; "B" Cross
..K ^MCAR(691.7,MCI,.4,"B") ; "B" Cross
..K ^MCAR(691.7,MCI,1,"B") ; "B" Cross
..K ^MCAR(691.7,MCI,11,"B") ; "B" Cross
..K ^MCAR(691.7,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(691.7)
F691P8 ; FILE 691.8
K ^MCAR(691.8,"B") ; "B" Cross
K ^MCAR(691.8,"C") ; Medical Patient
K ^MCAR(691.8,"PCC") ; PCC Pointer
K ^MCAR(691.8,"ES") ; Release Code
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.8,MCI)) Q:MCI<1 D
..K ^MCAR(691.8,MCI,1,"B") ; "B" Cross
..K ^MCAR(691.8,MCI,2,"B") ; "B" Cross
..K ^MCAR(691.8,MCI,3,"B") ; "B" Cross
..K ^MCAR(691.8,MCI,5,"B") ; "B" Cross
..K ^MCAR(691.8,MCI,11,"B") ; "B" Cross
..K ^MCAR(691.8,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(691.8)
F691P9 ; FILE 691.9
K ^MCAR(691.9,"B") ; "B" Cross
K ^MCAR(691.9,"C") ; "C" EP Record
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(691.9,MCI)) Q:MCI<1 D
..K ^MCAR(691.9,MCI,"IDC","B") ; "B" Cross
..D
...N MCII
...S MCII=0
...F S MCII=$O(^MCAR(691.9,MCI,7,MCII)) Q:MCII<1 D
....K ^MCAR(691.9,MCI,7,MCII,1,"B") ; "B" Cross
....Q
...Q
..Q
.Q
D EN1^MCPOS01(691.9)
G F692^MCPOS01C
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01B 3542 printed Dec 13, 2024@02:16:17 Page 2
MCPOS01B ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 11:05
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
F691 ; FILE 691
+1 ; "B" Cross
KILL ^MCAR(691,"B")
+2 ; Medical patient
KILL ^MCAR(691,"C")
+3 ; PCC Pointer
KILL ^MCAR(691,"PCC")
+4 ; Release Code
KILL ^MCAR(691,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691,MCI,.3,"B")
+10 ; "B" Cross
KILL ^MCAR(691,MCI,.4,"B")
+11 ; "B" Cross
KILL ^MCAR(691,MCI,1,"B")
+12 ; "B" Cross
KILL ^MCAR(691,MCI,14,"B")
+13 ; "B" Cross
KILL ^MCAR(691,MCI,"ICD","B")
+14 ; "B" Cross
KILL ^MCAR(691,MCI,2005,"B")
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO EN1^MCPOS01(691)
F691P1 ; FILE 691.1
+1 ; "B" Cross
KILL ^MCAR(691.1,"B")
+2 ; Medical Patient
KILL ^MCAR(691.1,"C")
+3 ; PCC Pointer
KILL ^MCAR(691.1,"PCC")
+4 ; Release Code
KILL ^MCAR(691.1,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691.1,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691.1,MCI,.3,"B")
+10 ; "B" Cross
KILL ^MCAR(691.1,MCI,.4,"B")
+11 ; "B" Cross
KILL ^MCAR(691.1,MCI,6,"B")
+12 ; "B" Cross
KILL ^MCAR(691.1,MCI,"ICD","B")
+13 ; "B" Cross
KILL ^MCAR(691.1,MCI,2005,"B")
End DoDot:2
+14 QUIT
End DoDot:1
+15 DO EN1^MCPOS01(691.1)
F691P5 ; FILE 691.5
+1 ; "B" Cross
KILL ^MCAR(691.5,"B")
+2 ; Medical Patient
KILL ^MCAR(691.5,"C")
+3 ; PCC pointer
KILL ^MCAR(691.5,"PCC")
+4 ; Release Status
KILL ^MCAR(691.5,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691.5,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691.5,MCI,.3,"B")
+10 ; "B" Cross
KILL ^MCAR(691.5,MCI,.4,"B")
+11 ; "B" Cross
KILL ^MCAR(691.5,MCI,.5,"B")
+12 ; "B" Cross
KILL ^MCAR(691.5,MCI,3,"B")
+13 ; "B" Cross
KILL ^MCAR(691.5,MCI,5,"B")
+14 ; "B" Cross
KILL ^MCAR(691.5,MCI,6,"B")
+15 ; "B" Cross
KILL ^MCAR(691.5,MCI,"ICD","B")
+16 ; "B" Cross
KILL ^MCAR(691.5,MCI,2005,"B")
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 DO EN1^MCPOS01(691.5)
F691P6 ; FILE 691.6
+1 ; "B" Cross
KILL ^MCAR(691.6,"B")
+2 ; Medical Patient
KILL ^MCAR(691.6,"C")
+3 ; PCC Pointer
KILL ^MCAR(691.6,"PCC")
+4 ; Release Code
KILL ^MCAR(691.6,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691.6,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691.6,MCI,.3,"B")
+10 ; "B" Cross
KILL ^MCAR(691.6,MCI,.4,"B")
+11 ; "B" Cross
KILL ^MCAR(691.6,MCI,1,"B")
+12 ; "B" Cross
KILL ^MCAR(691.6,MCI,"ICD","B")
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 DO EN1^MCPOS01(691.6)
F691P7 ; FILE 691.7
+1 ; "B" Cross
KILL ^MCAR(691.7,"B")
+2 ; Medical Patient
KILL ^MCAR(691.7,"C")
+3 ; PCC Pointer
KILL ^MCAR(691.7,"PCC")
+4 ; Release Code
KILL ^MCAR(691.7,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691.7,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691.7,MCI,.3,"B")
+10 ; "B" Cross
KILL ^MCAR(691.7,MCI,.4,"B")
+11 ; "B" Cross
KILL ^MCAR(691.7,MCI,1,"B")
+12 ; "B" Cross
KILL ^MCAR(691.7,MCI,11,"B")
+13 ; "B" Cross
KILL ^MCAR(691.7,MCI,"ICD","B")
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 DO EN1^MCPOS01(691.7)
F691P8 ; FILE 691.8
+1 ; "B" Cross
KILL ^MCAR(691.8,"B")
+2 ; Medical Patient
KILL ^MCAR(691.8,"C")
+3 ; PCC Pointer
KILL ^MCAR(691.8,"PCC")
+4 ; Release Code
KILL ^MCAR(691.8,"ES")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(691.8,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(691.8,MCI,1,"B")
+10 ; "B" Cross
KILL ^MCAR(691.8,MCI,2,"B")
+11 ; "B" Cross
KILL ^MCAR(691.8,MCI,3,"B")
+12 ; "B" Cross
KILL ^MCAR(691.8,MCI,5,"B")
+13 ; "B" Cross
KILL ^MCAR(691.8,MCI,11,"B")
+14 ; "B" Cross
KILL ^MCAR(691.8,MCI,"ICD","B")
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO EN1^MCPOS01(691.8)
F691P9 ; FILE 691.9
+1 ; "B" Cross
KILL ^MCAR(691.9,"B")
+2 ; "C" EP Record
KILL ^MCAR(691.9,"C")
+3 Begin DoDot:1
+4 NEW MCI
+5 SET MCI=0
+6 FOR
SET MCI=$ORDER(^MCAR(691.9,MCI))
if MCI<1
QUIT
Begin DoDot:2
+7 ; "B" Cross
KILL ^MCAR(691.9,MCI,"IDC","B")
+8 Begin DoDot:3
+9 NEW MCII
+10 SET MCII=0
+11 FOR
SET MCII=$ORDER(^MCAR(691.9,MCI,7,MCII))
if MCII<1
QUIT
Begin DoDot:4
+12 ; "B" Cross
KILL ^MCAR(691.9,MCI,7,MCII,1,"B")
+13 QUIT
End DoDot:4
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO EN1^MCPOS01(691.9)
+18 GOTO F692^MCPOS01C
