MCPOS01E ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:53
;;2.3;Medicine;;09/13/1996
;;
F698 ; FILE 698
K ^MCAR(698,"B") ; "B" Cross
K ^MCAR(698,"C") ; Medical Patient
K ^MCAR(698,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(698,MCI)) Q:MCI<1 D
..K ^MCAR(698,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(698)
F698P1 ; FILE 698.1
K ^MCAR(698.1,"B") ; "B" Cross
K ^MCAR(698.1,"C") ; Medical Patient
K ^MCAR(698.1,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(698.1,MCI)) Q:MCI<1 D
..K ^MCAR(698.1,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(698.1)
F698P2 ; FILE 698.2
K ^MCAR(698.2,"B") ; "B" Cross
K ^MCAR(698.2,"C") ; Medical Patient
K ^MCAR(698.2,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(698.2,MCI)) Q:MCI<1 D
..K ^MCAR(698.2,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(698.2)
F698P3 ; FILE 698.3
K ^MCAR(698.3,"B") ; "B" Cross
K ^MCAR(698.3,"C") ; Medical Patient
K ^MCAR(698.3,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(698.3,MCI)) Q:MCI<1 D
..K ^MCAR(698.3,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(698.3)
F698P4 ; FILE 698.4
K ^MCAR(698.4,"B") ; "B" Cross
K ^MCAR(698.4,"C") ; Type of Equipment
K ^MCAR(698.4,"D") ; Manufacture
D EN1^MCPOS01(698.4)
F698P6 ; FILE 698.6
K ^MCAR(698.6,"B") ; "B" Cross
K ^MCAR(698.6,"C") ; Mnemonic
D EN1^MCPOS01(698.6)
F698P9 ; FILE 698.9
K ^MCAR(698.9,"B") ; "B" Cross
K ^MCAR(698.9,"D") ; Abbreviation
D EN1^MCPOS01(698.9)
G F699^MCPOS01F
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01E 1596 printed Dec 13, 2024@02:16:19 Page 2
MCPOS01E ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:53
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
F698 ; FILE 698
+1 ; "B" Cross
KILL ^MCAR(698,"B")
+2 ; Medical Patient
KILL ^MCAR(698,"C")
+3 ; PCC Pointer
KILL ^MCAR(698,"PCC")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(698,MCI))
if MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(698,MCI,"ICD","B")
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 DO EN1^MCPOS01(698)
F698P1 ; FILE 698.1
+1 ; "B" Cross
KILL ^MCAR(698.1,"B")
+2 ; Medical Patient
KILL ^MCAR(698.1,"C")
+3 ; PCC Pointer
KILL ^MCAR(698.1,"PCC")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(698.1,MCI))
if MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(698.1,MCI,"ICD","B")
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 DO EN1^MCPOS01(698.1)
F698P2 ; FILE 698.2
+1 ; "B" Cross
KILL ^MCAR(698.2,"B")
+2 ; Medical Patient
KILL ^MCAR(698.2,"C")
+3 ; PCC Pointer
KILL ^MCAR(698.2,"PCC")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(698.2,MCI))
if MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(698.2,MCI,"ICD","B")
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 DO EN1^MCPOS01(698.2)
F698P3 ; FILE 698.3
+1 ; "B" Cross
KILL ^MCAR(698.3,"B")
+2 ; Medical Patient
KILL ^MCAR(698.3,"C")
+3 ; PCC Pointer
KILL ^MCAR(698.3,"PCC")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(698.3,MCI))
if MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(698.3,MCI,"ICD","B")
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 DO EN1^MCPOS01(698.3)
F698P4 ; FILE 698.4
+1 ; "B" Cross
KILL ^MCAR(698.4,"B")
+2 ; Type of Equipment
KILL ^MCAR(698.4,"C")
+3 ; Manufacture
KILL ^MCAR(698.4,"D")
+4 DO EN1^MCPOS01(698.4)
F698P6 ; FILE 698.6
+1 ; "B" Cross
KILL ^MCAR(698.6,"B")
+2 ; Mnemonic
KILL ^MCAR(698.6,"C")
+3 DO EN1^MCPOS01(698.6)
F698P9 ; FILE 698.9
+1 ; "B" Cross
KILL ^MCAR(698.9,"B")
+2 ; Abbreviation
KILL ^MCAR(698.9,"D")
+3 DO EN1^MCPOS01(698.9)
+4 GOTO F699^MCPOS01F
