- AULMICD ;CODE TO CHANGE INTERNAL NUMBERS [ 10/07/86 2:20 PM ]
- ;IN THE ICD FILE, DELETE OLD ONES AND CROSS REFERENCE NEW ONES
- S OS=12262,NS=20000,FO=20001,U="^"
- F I=0:0 S OS=$O(^LORIICD(OS)) Q:(OS="")!(OS=FO)!(OS'?5N) S FROM="^LORIICD("_OS_",",NS=NS+1,TO="^LORIICD("_NS_"," D ^AIMUGTR1 S $P(^LORIICD(0),U,4)=$P(^LORIICD(0),U,4)+1 S DIK="^LORIICD(",DA=OS D ^DIK
- RECROSS F I=FO:1:NS S DIK="^LORIICD(",DA=I D IX1^DIK
- S $P(^LORIICD(0),"^",3)=NS
- Q
- AULMICD ;CODE TO CHANGE INTERNAL NUMBERS [ 10/07/86 2:20 PM ]
- +1 ;IN THE ICD FILE, DELETE OLD ONES AND CROSS REFERENCE NEW ONES
- +2 SET OS=12262
- SET NS=20000
- SET FO=20001
- SET U="^"
- +3 FOR I=0:0
- SET OS=$ORDER(^LORIICD(OS))
- IF (OS="")!(OS=FO)!(OS'?5N)
- QUIT
- SET FROM="^LORIICD("_OS_","
- SET NS=NS+1
- SET TO="^LORIICD("_NS_","
- DO ^AIMUGTR1
- SET $PIECE(^LORIICD(0),U,4)=$PIECE(^LORIICD(0),U,4)+1
- SET DIK="^LORIICD("
- SET DA=OS
- DO ^DIK
- RECROSS FOR I=FO:1:NS
- SET DIK="^LORIICD("
- SET DA=I
- DO IX1^DIK
- +1 SET $PIECE(^LORIICD(0),"^",3)=NS
- +2 QUIT
