MCPOS01D ;HIRMFO/WAA - Kill all cross reference in a file - ;5/31/96 08:08
;;2.3;Medicine;;09/13/1996
;;
F695 ; FILE 695
K ^MCAR(695,"B") ; "B" Cross
K ^MCAR(695,"C") ; Medical Package Use
D EN1^MCPOS01(695)
F695P1 ; FILE 695.1
K ^MCAR(695.1,"B") ; "B" Cross
D EN1^MCPOS01(695.1)
F695P3 ; FILE 695.3
K ^MCAR(695.3,"B") ; "B" Cross
D EN1^MCPOS01(695.3)
F695P4 ; FILE 695.4
K ^MCAR(695.4,"B") ; "B" Cross
D EN1^MCPOS01(695.4)
F695P5 ; FILE 695.5
K ^MCAR(695.5,"B") ; "B" Cross
K ^MCAR(695.5,"BA") ; "BA" Cross
K ^MCAR(695.5,"C") ; Medical Use
D EN1^MCPOS01(695.5)
F695P6 ; FILE 695.6
K ^MCAR(695.6,"B") ; "B" Cross
D EN1^MCPOS01(695.6)
F695P8 ; FILE 695.8
K ^MCAR(695.8,"B") ; "B" Cross
K ^MCAR(695.8,"AC") ; Medical Package Used
D EN1^MCPOS01(695.8)
F695P9 ; FILE 695.9
K ^MCAR(695.9,"B") ; "B" Cross
D EN1^MCPOS01(695.9)
F696 ; FILE 696
K ^MCAR(696,"B") ; "B" Cross
D EN1^MCPOS01(696)
F696P1 ; FILE 696.1
K ^MCAR(696.1,"B") ; "B" Cross
D EN1^MCPOS01(696.1)
F696P2 ; FILE 696.2
K ^MCAR(696.2,"B") ; "B" Cross
D EN1^MCPOS01(696.2)
F696P3 ; FILE 696.3
K ^MCAR(696.3,"B") ; "B" Cross
D EN1^MCPOS01(696.3)
F696P4 ; FILE 696.4
K ^MCAR(696.4,"B") ; "B" Cross
D EN1^MCPOS01(696.4)
F696P5 ; FILE 696.5
K ^MCAR(696.5,"B") ; "B" Cross
K ^MCAR(696.5,"D") ; Display Code
D EN1^MCPOS01(696.5)
F696P7 ; FILE 696.7
K ^MCAR(696.7,"B") ; "B" Cross
D EN1^MCPOS01(696.7)
F696P9 ; FILE 696.9
K ^MCAR(696.9,"B") ; "B" Cross
K ^MCAR(696.9,"C") ; Medical Package Use
D EN1^MCPOS01(696.9)
F697 ; FILE 697
K ^MCAR(697,"B") ; "B" Cross
K ^MCAR(697,"C") ; Procedure
K ^MCAR(697,"D") ; Procedure Name
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(697,MCI)) Q:MCI<1 D
..K ^MCAR(697,MCI,1,"B") ; "B" Cross
..K ^MCAR(697,MCI,2,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(697)
F697P1 ; FILE 697.1
K ^MCAR(697.1,"B") ; "B" Cross
D EN1^MCPOS01(697.1)
F697P2 ; FILE 697.2
K ^MCAR(697.2,"B") ; "B" Cross
K ^MCAR(697.2,"C") ; Global Location
K ^MCAR(697.2,"D") ; Type of Procedure
D EN1^MCPOS01(697.2)
F697P3 ; FILE 697.3
K ^MCAR(697.3,"B") ; "B" Cross
K ^MCAR(697.3,"C") ; Description
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(697.3,MCI)) Q:MCI<1 D
..K ^MCAR(697.3,MCI,1,"B") ; "B" Cross
..K ^MCAR(697.3,MCI,1,"A") ; Entry Num
..Q
.Q
D EN1^MCPOS01(697.3)
F697P5 ; FILE 697.5
K ^MCAR(697.5,"B") ; "B" Cross
K ^MCAR(697.5,"C") ; .01 KWIC
K ^MCAR(697.5,"D") ; Procedures
D ; Diagnosis Code
.N MCI
.S MCI="A."
.F S MCI=$O(^MCAR(697.5,MCI)) Q:$P(MCI,".")'="A" D
..K ^MCAR(697.5,MCI)
..Q
.Q
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(697.5,MCI)) Q:MCI<1 D
..K ^MCAR(697.5,MCI,2,"B") ; "B" Cross
..K ^MCAR(697.5,MCI,1,"B") ; "B" Cross
..K ^MCAR(697.5,MCI,4,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(697.5)
G F698^MCPOS01E
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01D 2857 printed Dec 13, 2024@02:16:18 Page 2
MCPOS01D ;HIRMFO/WAA - Kill all cross reference in a file - ;5/31/96 08:08
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
F695 ; FILE 695
+1 ; "B" Cross
KILL ^MCAR(695,"B")
+2 ; Medical Package Use
KILL ^MCAR(695,"C")
+3 DO EN1^MCPOS01(695)
F695P1 ; FILE 695.1
+1 ; "B" Cross
KILL ^MCAR(695.1,"B")
+2 DO EN1^MCPOS01(695.1)
F695P3 ; FILE 695.3
+1 ; "B" Cross
KILL ^MCAR(695.3,"B")
+2 DO EN1^MCPOS01(695.3)
F695P4 ; FILE 695.4
+1 ; "B" Cross
KILL ^MCAR(695.4,"B")
+2 DO EN1^MCPOS01(695.4)
F695P5 ; FILE 695.5
+1 ; "B" Cross
KILL ^MCAR(695.5,"B")
+2 ; "BA" Cross
KILL ^MCAR(695.5,"BA")
+3 ; Medical Use
KILL ^MCAR(695.5,"C")
+4 DO EN1^MCPOS01(695.5)
F695P6 ; FILE 695.6
+1 ; "B" Cross
KILL ^MCAR(695.6,"B")
+2 DO EN1^MCPOS01(695.6)
F695P8 ; FILE 695.8
+1 ; "B" Cross
KILL ^MCAR(695.8,"B")
+2 ; Medical Package Used
KILL ^MCAR(695.8,"AC")
+3 DO EN1^MCPOS01(695.8)
F695P9 ; FILE 695.9
+1 ; "B" Cross
KILL ^MCAR(695.9,"B")
+2 DO EN1^MCPOS01(695.9)
F696 ; FILE 696
+1 ; "B" Cross
KILL ^MCAR(696,"B")
+2 DO EN1^MCPOS01(696)
F696P1 ; FILE 696.1
+1 ; "B" Cross
KILL ^MCAR(696.1,"B")
+2 DO EN1^MCPOS01(696.1)
F696P2 ; FILE 696.2
+1 ; "B" Cross
KILL ^MCAR(696.2,"B")
+2 DO EN1^MCPOS01(696.2)
F696P3 ; FILE 696.3
+1 ; "B" Cross
KILL ^MCAR(696.3,"B")
+2 DO EN1^MCPOS01(696.3)
F696P4 ; FILE 696.4
+1 ; "B" Cross
KILL ^MCAR(696.4,"B")
+2 DO EN1^MCPOS01(696.4)
F696P5 ; FILE 696.5
+1 ; "B" Cross
KILL ^MCAR(696.5,"B")
+2 ; Display Code
KILL ^MCAR(696.5,"D")
+3 DO EN1^MCPOS01(696.5)
F696P7 ; FILE 696.7
+1 ; "B" Cross
KILL ^MCAR(696.7,"B")
+2 DO EN1^MCPOS01(696.7)
F696P9 ; FILE 696.9
+1 ; "B" Cross
KILL ^MCAR(696.9,"B")
+2 ; Medical Package Use
KILL ^MCAR(696.9,"C")
+3 DO EN1^MCPOS01(696.9)
F697 ; FILE 697
+1 ; "B" Cross
KILL ^MCAR(697,"B")
+2 ; Procedure
KILL ^MCAR(697,"C")
+3 ; Procedure Name
KILL ^MCAR(697,"D")
+4 Begin DoDot:1
+5 NEW MCI
+6 SET MCI=0
+7 FOR
SET MCI=$ORDER(^MCAR(697,MCI))
if MCI<1
QUIT
Begin DoDot:2
+8 ; "B" Cross
KILL ^MCAR(697,MCI,1,"B")
+9 ; "B" Cross
KILL ^MCAR(697,MCI,2,"B")
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 DO EN1^MCPOS01(697)
F697P1 ; FILE 697.1
+1 ; "B" Cross
KILL ^MCAR(697.1,"B")
+2 DO EN1^MCPOS01(697.1)
F697P2 ; FILE 697.2
+1 ; "B" Cross
KILL ^MCAR(697.2,"B")
+2 ; Global Location
KILL ^MCAR(697.2,"C")
+3 ; Type of Procedure
KILL ^MCAR(697.2,"D")
+4 DO EN1^MCPOS01(697.2)
F697P3 ; FILE 697.3
+1 ; "B" Cross
KILL ^MCAR(697.3,"B")
+2 ; Description
KILL ^MCAR(697.3,"C")
+3 Begin DoDot:1
+4 NEW MCI
+5 SET MCI=0
+6 FOR
SET MCI=$ORDER(^MCAR(697.3,MCI))
if MCI<1
QUIT
Begin DoDot:2
+7 ; "B" Cross
KILL ^MCAR(697.3,MCI,1,"B")
+8 ; Entry Num
KILL ^MCAR(697.3,MCI,1,"A")
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 DO EN1^MCPOS01(697.3)
F697P5 ; FILE 697.5
+1 ; "B" Cross
KILL ^MCAR(697.5,"B")
+2 ; .01 KWIC
KILL ^MCAR(697.5,"C")
+3 ; Procedures
KILL ^MCAR(697.5,"D")
+4 ; Diagnosis Code
Begin DoDot:1
+5 NEW MCI
+6 SET MCI="A."
+7 FOR
SET MCI=$ORDER(^MCAR(697.5,MCI))
if $PIECE(MCI,".")'="A"
QUIT
Begin DoDot:2
+8 KILL ^MCAR(697.5,MCI)
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 Begin DoDot:1
+12 NEW MCI
+13 SET MCI=0
+14 FOR
SET MCI=$ORDER(^MCAR(697.5,MCI))
if MCI<1
QUIT
Begin DoDot:2
+15 ; "B" Cross
KILL ^MCAR(697.5,MCI,2,"B")
+16 ; "B" Cross
KILL ^MCAR(697.5,MCI,1,"B")
+17 ; "B" Cross
KILL ^MCAR(697.5,MCI,4,"B")
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 DO EN1^MCPOS01(697.5)
+21 GOTO F698^MCPOS01E
