- MCPOS01C ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 11:05
- ;;2.3;Medicine;;09/13/1996
- ;;
- F692 ; FILE 692
- K ^MCAR(692,"B") ; "B" Cross
- K ^MCAR(692,"C") ; EP Record
- D
- .N MCI
- .S MCI=0
- .F S MCI=$O(^MCAR(692,MCI)) Q:MCI<1 D
- ..D
- ...N MCII
- ...S MCII=0
- ...F S MCII=$O(^MCAR(692,MCI,6,MCII)) Q:MCII<1 D
- ....K ^MCAR(692,MCI,6,MCII,1,"B") ; "B" Cross
- ....Q
- ...Q
- ..Q
- .Q
- D EN1^MCPOS01(692)
- F693 ; FILE 693
- K ^MCAR(693,"B") ; "B" Cross
- K ^MCAR(693,"C") ; SYNONYM
- D EN1^MCPOS01(693)
- F693P2 ; FILE 693.2
- K ^MCAR(693.2,"B") ; "B" Cross
- D EN1^MCPOS01(693.2)
- F693P3 ; FILE 693.3
- K ^MCAR(693.3,"B") ; "B" Cross
- K ^MCAR(693.3,"C") ; Code Number
- D EN1^MCPOS01(693.3)
- F693P5 ; FILE 693.5
- K ^MCAR(693.5,"B") ; "B" Cross
- D EN1^MCPOS01(693.5)
- F693P6 ; FILE 693.6
- K ^MCAR(693.6,"B") ; "B" Cross
- D EN1^MCPOS01(693.6)
- F694 ; FILE 694
- K ^MCAR(694,"B") ; "B" Cross
- K ^MCAR(694,"C") ; Medical patient
- K ^MCAR(694,"PCC") ; PCC Pointer
- K ^MCAR(694,"ES") ; Release Code
- D
- .N MCI
- .S MCI=0
- .F S MCI=$O(^MCAR(694,MCI)) Q:MCI<1 D
- ..K ^MCAR(694,MCI,8,"B") ; "B" Cross
- ..K ^MCAR(694,MCI,10,"B") ; "B" Cross
- ..K ^MCAR(694,MCI,5,"B") ; "B" Cross
- ..K ^MCAR(694,MCI,2,"B") ; "B" Cross
- ..K ^MCAR(694,MCI,"ICD","B") ; "B" Cross
- ..K ^MCAR(694,MCI,2005,"B") ; "B" Cross
- ..Q
- .Q
- D EN1^MCPOS01(694)
- F694P1 ; FILE 694.1
- K ^MCAR(694.1,"B") ; "B" Cross
- K ^MCAR(694.1,"C") ; Medical Type
- D EN1^MCPOS01(694.1)
- F694P5 ; FILE 694.5
- K ^MCAR(694.5,"B") ; "B" Cross
- K ^MCAR(694.5,"C") ; Patient
- D
- .N MCI
- .S MCI=0
- .F S MCI=$O(^MCAR(694.5,MCI)) Q:MCI<1 D
- ..K ^MCAR(694.5,MCI,11,"B") ; "B" Cross
- ..Q
- .Q
- D EN1^MCPOS01(694.5)
- F694P9 ; FILE 694.8
- K ^MCAR(694.8,"B") ; "B" Cross
- K ^MCAR(694.8,"C") ; SYNONYM
- K ^MCAR(694.8,"PAR") ; PARENT
- K ^MCAR(684.8,"PS") ;Procedure/Subspecialty
- D
- .N MCI
- .S MCI=0
- .F S MCI=$O(^MCAR(694.8,MCI)) Q:MCI<1 D
- ..K ^MCAR(694.8,MCI,1,"B") ; "B" Cross
- ..K ^MCAR(694.8,MCI,3,"B") ; "B" Cross
- ..Q
- .Q
- D EN1^MCPOS01(694.8)
- G F695^MCPOS01D
- MCPOS01C ;HIRMFO/WAA - Kill all cross reference in a file - ;4/29/96 11:05
- +1 ;;2.3;Medicine;;09/13/1996
- +2 ;;
- F692 ; FILE 692
- +1 ; "B" Cross
- KILL ^MCAR(692,"B")
- +2 ; EP Record
- KILL ^MCAR(692,"C")
- +3 Begin DoDot:1
- +4 NEW MCI
- +5 SET MCI=0
- +6 FOR
- SET MCI=$ORDER(^MCAR(692,MCI))
- IF MCI<1
- QUIT
- Begin DoDot:2
- +7 Begin DoDot:3
- +8 NEW MCII
- +9 SET MCII=0
- +10 FOR
- SET MCII=$ORDER(^MCAR(692,MCI,6,MCII))
- IF MCII<1
- QUIT
- Begin DoDot:4
- +11 ; "B" Cross
- KILL ^MCAR(692,MCI,6,MCII,1,"B")
- +12 QUIT
- End DoDot:4
- +13 QUIT
- End DoDot:3
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 DO EN1^MCPOS01(692)
- F693 ; FILE 693
- +1 ; "B" Cross
- KILL ^MCAR(693,"B")
- +2 ; SYNONYM
- KILL ^MCAR(693,"C")
- +3 DO EN1^MCPOS01(693)
- F693P2 ; FILE 693.2
- +1 ; "B" Cross
- KILL ^MCAR(693.2,"B")
- +2 DO EN1^MCPOS01(693.2)
- F693P3 ; FILE 693.3
- +1 ; "B" Cross
- KILL ^MCAR(693.3,"B")
- +2 ; Code Number
- KILL ^MCAR(693.3,"C")
- +3 DO EN1^MCPOS01(693.3)
- F693P5 ; FILE 693.5
- +1 ; "B" Cross
- KILL ^MCAR(693.5,"B")
- +2 DO EN1^MCPOS01(693.5)
- F693P6 ; FILE 693.6
- +1 ; "B" Cross
- KILL ^MCAR(693.6,"B")
- +2 DO EN1^MCPOS01(693.6)
- F694 ; FILE 694
- +1 ; "B" Cross
- KILL ^MCAR(694,"B")
- +2 ; Medical patient
- KILL ^MCAR(694,"C")
- +3 ; PCC Pointer
- KILL ^MCAR(694,"PCC")
- +4 ; Release Code
- KILL ^MCAR(694,"ES")
- +5 Begin DoDot:1
- +6 NEW MCI
- +7 SET MCI=0
- +8 FOR
- SET MCI=$ORDER(^MCAR(694,MCI))
- IF MCI<1
- QUIT
- Begin DoDot:2
- +9 ; "B" Cross
- KILL ^MCAR(694,MCI,8,"B")
- +10 ; "B" Cross
- KILL ^MCAR(694,MCI,10,"B")
- +11 ; "B" Cross
- KILL ^MCAR(694,MCI,5,"B")
- +12 ; "B" Cross
- KILL ^MCAR(694,MCI,2,"B")
- +13 ; "B" Cross
- KILL ^MCAR(694,MCI,"ICD","B")
- +14 ; "B" Cross
- KILL ^MCAR(694,MCI,2005,"B")
- +15 QUIT
- End DoDot:2
- +16 QUIT
- End DoDot:1
- +17 DO EN1^MCPOS01(694)
- F694P1 ; FILE 694.1
- +1 ; "B" Cross
- KILL ^MCAR(694.1,"B")
- +2 ; Medical Type
- KILL ^MCAR(694.1,"C")
- +3 DO EN1^MCPOS01(694.1)
- F694P5 ; FILE 694.5
- +1 ; "B" Cross
- KILL ^MCAR(694.5,"B")
- +2 ; Patient
- KILL ^MCAR(694.5,"C")
- +3 Begin DoDot:1
- +4 NEW MCI
- +5 SET MCI=0
- +6 FOR
- SET MCI=$ORDER(^MCAR(694.5,MCI))
- IF MCI<1
- QUIT
- Begin DoDot:2
- +7 ; "B" Cross
- KILL ^MCAR(694.5,MCI,11,"B")
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 DO EN1^MCPOS01(694.5)
- F694P9 ; FILE 694.8
- +1 ; "B" Cross
- KILL ^MCAR(694.8,"B")
- +2 ; SYNONYM
- KILL ^MCAR(694.8,"C")
- +3 ; PARENT
- KILL ^MCAR(694.8,"PAR")
- +4 ;Procedure/Subspecialty
- KILL ^MCAR(684.8,"PS")
- +5 Begin DoDot:1
- +6 NEW MCI
- +7 SET MCI=0
- +8 FOR
- SET MCI=$ORDER(^MCAR(694.8,MCI))
- IF MCI<1
- QUIT
- Begin DoDot:2
- +9 ; "B" Cross
- KILL ^MCAR(694.8,MCI,1,"B")
- +10 ; "B" Cross
- KILL ^MCAR(694.8,MCI,3,"B")
- +11 QUIT
- End DoDot:2
- +12 QUIT
- End DoDot:1
- +13 DO EN1^MCPOS01(694.8)
- +14 GOTO F695^MCPOS01D