MCPOS01G ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:54
;;2.3;Medicine;;09/13/1996
;;
F700 ; FILE 700
K ^MCAR(700,"B") ; "B" Cross
K ^MCAR(700,"AV") ; Volume Study
K ^MCAR(700,"AF") ; Flow Study
K ^MCAR(700,"ADI") ; DLCO-SB
K ^MCAR(700,"AS") ; Special Study
K ^MCAR(700,"C") ; Medical Patient
K ^MCAR(700,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(700,MCI)) Q:MCI<1 D
..K ^MCAR(700,MCI,1,"B") ; "B" Cross
..K ^MCAR(700,MCI,3,"B") ; "B" Cross
..K ^MCAR(700,MCI,4,"B") ; "B" Cross
..K ^MCAR(700,MCI,6,"B") ; "B" Cross
..K ^MCAR(700,MCI,7,"B") ; "B" Cross
..K ^MCAR(700,MCI,8,"B") ; "B" Cross
..K ^MCAR(700,MCI,9,"B") ; "B" Cross
..K ^MCAR(700,MCI,10,"B") ; "B" Cross
..K ^MCAR(700,MCI,12,"B") ; "B" Cross
..K ^MCAR(700,MCI,13,"B") ; "B" Cross
..K ^MCAR(700,MCI,15,"B") ; "B" Cross
..K ^MCAR(700,MCI,"S","B") ; "B" Cross
..D
...N MCII
...S MCII=0
...F S MCII=$O(^MCAR(700,MCI,"S",MCII)) Q:MCII<1 D
....K ^MCAR(700,MCI,"S",MCII,3,"B") ; "B" Cross
....Q
...Q
..K ^MCAR(700,MCI,24,"B") ; "B" Cross
..K ^MCAR(700,MCI,"ICD","B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(700)
F700P1 ; FILE 700.1
K ^MCAR(700.1,"B") ; "B" Cross
K ^MCAR(700.1,"AC") ; Sex Type
D EN1^MCPOS01(700.1)
F700P2 ; FILE 700.2
K ^MCAR(700.2,"B") ; "B" Cross
K ^MCAR(700.2,"D") ; Type
K ^MCAR(700.2,"C") ; Reference
K ^MCAR(700.2,"E") ; Sex Type
D EN1^MCPOS01(700.2)
F700P5 ; FILE 700.5
K ^MCAR(700.5,"B") ; "B" Cross
K ^MCAR(700.5,"C") ; Date/Time Latest
K ^MCAR(700.5,"PT") ; Patient
D EN1^MCPOS01(700.5)
F701 ; FILE 701
K ^MCAR(701,"B") ; "B" Cross
K ^MCAR(701,"C") ; Medical Patient
K ^MCAR(701,"D") ; SSN
K ^MCAR(701,"PCC") ; PCC Pointer
D
.N MCI
.S MCI=0
.F S MCI=$O(^MCAR(701,MCI)) Q:MCI<1 D
..K ^MCAR(701,MCI,6,"B") ; "B" Cross
..K ^MCAR(701,MCI,13,"B") ; "B" Cross
..K ^MCAR(701,MCI,"ICD","B") ; "B" Cross
..K ^MCAR(701,MCI,2005,"B") ; "B" Cross
..Q
.Q
D EN1^MCPOS01(701)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01G 2013 printed Dec 13, 2024@02:16:21 Page 2
MCPOS01G ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 14:54
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
F700 ; FILE 700
+1 ; "B" Cross
KILL ^MCAR(700,"B")
+2 ; Volume Study
KILL ^MCAR(700,"AV")
+3 ; Flow Study
KILL ^MCAR(700,"AF")
+4 ; DLCO-SB
KILL ^MCAR(700,"ADI")
+5 ; Special Study
KILL ^MCAR(700,"AS")
+6 ; Medical Patient
KILL ^MCAR(700,"C")
+7 ; PCC Pointer
KILL ^MCAR(700,"PCC")
+8 Begin DoDot:1
+9 NEW MCI
+10 SET MCI=0
+11 FOR
SET MCI=$ORDER(^MCAR(700,MCI))
if MCI<1
QUIT
Begin DoDot:2
+12 ; "B" Cross
KILL ^MCAR(700,MCI,1,"B")
+13 ; "B" Cross
KILL ^MCAR(700,MCI,3,"B")
+14 ; "B" Cross
KILL ^MCAR(700,MCI,4,"B")
+15 ; "B" Cross
KILL ^MCAR(700,MCI,6,"B")
+16 ; "B" Cross
KILL ^MCAR(700,MCI,7,"B")
+17 ; "B" Cross
KILL ^MCAR(700,MCI,8,"B")
+18 ; "B" Cross
KILL ^MCAR(700,MCI,9,"B")
+19 ; "B" Cross
KILL ^MCAR(700,MCI,10,"B")
+20 ; "B" Cross
KILL ^MCAR(700,MCI,12,"B")
+21 ; "B" Cross
KILL ^MCAR(700,MCI,13,"B")
+22 ; "B" Cross
KILL ^MCAR(700,MCI,15,"B")
+23 ; "B" Cross
KILL ^MCAR(700,MCI,"S","B")
+24 Begin DoDot:3
+25 NEW MCII
+26 SET MCII=0
+27 FOR
SET MCII=$ORDER(^MCAR(700,MCI,"S",MCII))
if MCII<1
QUIT
Begin DoDot:4
+28 ; "B" Cross
KILL ^MCAR(700,MCI,"S",MCII,3,"B")
+29 QUIT
End DoDot:4
+30 QUIT
End DoDot:3
+31 ; "B" Cross
KILL ^MCAR(700,MCI,24,"B")
+32 ; "B" Cross
KILL ^MCAR(700,MCI,"ICD","B")
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 DO EN1^MCPOS01(700)
F700P1 ; FILE 700.1
+1 ; "B" Cross
KILL ^MCAR(700.1,"B")
+2 ; Sex Type
KILL ^MCAR(700.1,"AC")
+3 DO EN1^MCPOS01(700.1)
F700P2 ; FILE 700.2
+1 ; "B" Cross
KILL ^MCAR(700.2,"B")
+2 ; Type
KILL ^MCAR(700.2,"D")
+3 ; Reference
KILL ^MCAR(700.2,"C")
+4 ; Sex Type
KILL ^MCAR(700.2,"E")
+5 DO EN1^MCPOS01(700.2)
F700P5 ; FILE 700.5
+1 ; "B" Cross
KILL ^MCAR(700.5,"B")
+2 ; Date/Time Latest
KILL ^MCAR(700.5,"C")
+3 ; Patient
KILL ^MCAR(700.5,"PT")
+4 DO EN1^MCPOS01(700.5)
F701 ; FILE 701
+1 ; "B" Cross
KILL ^MCAR(701,"B")
+2 ; Medical Patient
KILL ^MCAR(701,"C")
+3 ; SSN
KILL ^MCAR(701,"D")
+4 ; PCC Pointer
KILL ^MCAR(701,"PCC")
+5 Begin DoDot:1
+6 NEW MCI
+7 SET MCI=0
+8 FOR
SET MCI=$ORDER(^MCAR(701,MCI))
if MCI<1
QUIT
Begin DoDot:2
+9 ; "B" Cross
KILL ^MCAR(701,MCI,6,"B")
+10 ; "B" Cross
KILL ^MCAR(701,MCI,13,"B")
+11 ; "B" Cross
KILL ^MCAR(701,MCI,"ICD","B")
+12 ; "B" Cross
KILL ^MCAR(701,MCI,2005,"B")
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 DO EN1^MCPOS01(701)
+16 QUIT
