- 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 Mar 13, 2025@21:21:19 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
