- 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 Feb 18, 2025@23:42:47 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