- 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
- 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