AUMPOST2 ;IHS/ASDST/DMJ - INSTALL NEW CODES FOR 2002 [ 09/26/2001 7:04 AM ]
;;02.1;ICD UPDATE;;SEP 12, 2001
START ;START
K ^DD(80.1,0,"DIC")
S DLAYGO=80.1
D ICD0
D REV
D INA
S ^DD(80.1,0,"DIC")="AICDKWI0"
K DLAYGO
Q
ICD0 ;install new icd0 codes
F AUMI=1:1:16 D
.S AUMLN=$T(@AUMI)
.F AUMJ=2:1:8 S AUM(AUMJ)=$P(AUMLN,";",AUMJ)
.S Y=$O(^ICD0("AB",AUM(2),0))
.I 'Y D
..S DIC="^ICD0("
..S DIC(0)="LX"
..S X=AUM(2)
..D ^DIC
.Q:+Y<0 S DA=+Y
.S ^ICD0(DA,1)=AUM(3)
.S $P(^ICD0(DA,0),"^",9)=""
.S $P(^ICD0(DA,0),"^",11)=""
.S $P(^ICD0(DA,0),"^",10)=AUM(4)
.S $P(^ICD0(DA,0),"^",4)=$E(AUM(3),1,50)
.S $P(^ICD0(DA,9999999),"^",4)=3011000
.D MDC
.S DIK="^ICD0(" D IX1^DIK
Q
MDC ;update MDC multiple
F AUMI2=1:1 S AUMLN=$T(@AUMI+AUMI2) Q:+AUMLN D
.S AUMMDC=$P(AUMLN,";",2)
.S AUMDRG=$P(AUMLN,";",3)
.S ^ICD0(DA,"MDC",AUMMDC,0)=AUMMDC
.S ^ICD0(DA,"MDC",AUMMDC,"DRG")=AUMDRG
.S:+AUMLN'=999 ^ICD0(DA,"MDC",0)="^80.12PA^"_AUMMDC_"^"_AUMI2
K AUMI2,AUMMDC,AUMDRG
Q
REV ;revised descriptions
S AUM(1)="OTHER FETAL MONITORING"
S AUMCT=0
F I=75.34 D
.S AUMCT=AUMCT+1
.S DA=$O(^ICD0("AB",I,0))
.Q:'DA
.S ^ICD0(DA,1)=AUM(AUMCT)
.S $P(^ICD0(DA,0),"^",4)=$E(AUM(AUMCT),1,50)
.S DIK="^ICD0(" D IX1^DIK
Q
INA ;inactivate entry point
F I=67.5,81.09 D
.S DA=$O(^ICD0("AB",I,0))
.Q:'DA
.S $P(^ICD0(DA,0),"^",11)=3011000
Q
;new codes
1 ;37.28;INTRACARDIAC ECHOCARDIOGRAPHY
2 ;44.32;PERCUTANEOUS [ENDOSCOPIC] GASTROJEJUNOSTOMY
;6;154^156
;7;201
;10;288
;17;400^406^407
3 ;67.51;TRANSABDOMINAL CERCLAGE OF CERVIX;F
;13;360
;14;372^373
;21;442^443
;24;486
4 ;67.59;OTHER REPAIR OF INTERNAL CERVICAL OS;F
;13;360
;14;372^373
;21;442^443
;24;486
5 ;75.38;FETAL PULSE OXIMETRY
6 ;81.30;REFUSION OF SPINE, NOT OTHERWISE SPECIFIED
;1;4
;8;497^498
;21;442^443
;24;486
7 ;81.31;REFUSION OF ATLAS-AXIS SPINE
;1;4
;8;497^498
;21;442^443
;24;486
8 ;81.32;REFUSION OF OTHER CERVICAL SPINE, ANTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
9 ;81.33;REFUSION OF OTHER CERVICAL SPINE, POSTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
10 ;81.34;REFUSION OF DORSAL AND DORSOLUMBAR SPINE, ANTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
11 ;81.35;REFUSION OF DORSAL AND DORSOLUMBAR SPINE, POSTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24^486
12 ;81.36;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, ANTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
13 ;81.37;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, LATERAL TRANSVERSE PROCESS TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
14 ;81.38;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, POSTERIOR TECHNIQUE
;1;4
;8;496^519^520
;21;442^443
;24;486
15 ;81.39;REFUSION OF SPINE, NOT ELSEWHERE CLASSIFIED
;1;4
;8;496^519^520
;21;442^443
;24;486
16 ;97.44;NONOPERATIVE REMOVAL OF HEART ASSIST SYSTEM
999 ;end
AUMPOST2 ;IHS/ASDST/DMJ - INSTALL NEW CODES FOR 2002 [ 09/26/2001 7:04 AM ]
+1 ;;02.1;ICD UPDATE;;SEP 12, 2001
START ;START
+1 KILL ^DD(80.1,0,"DIC")
+2 SET DLAYGO=80.1
+3 DO ICD0
+4 DO REV
+5 DO INA
+6 SET ^DD(80.1,0,"DIC")="AICDKWI0"
+7 KILL DLAYGO
+8 QUIT
ICD0 ;install new icd0 codes
+1 FOR AUMI=1:1:16
Begin DoDot:1
+2 SET AUMLN=$TEXT(@AUMI)
+3 FOR AUMJ=2:1:8
SET AUM(AUMJ)=$PIECE(AUMLN,";",AUMJ)
+4 SET Y=$ORDER(^ICD0("AB",AUM(2),0))
+5 IF 'Y
Begin DoDot:2
+6 SET DIC="^ICD0("
+7 SET DIC(0)="LX"
+8 SET X=AUM(2)
+9 DO ^DIC
End DoDot:2
+10 IF +Y<0
QUIT
SET DA=+Y
+11 SET ^ICD0(DA,1)=AUM(3)
+12 SET $PIECE(^ICD0(DA,0),"^",9)=""
+13 SET $PIECE(^ICD0(DA,0),"^",11)=""
+14 SET $PIECE(^ICD0(DA,0),"^",10)=AUM(4)
+15 SET $PIECE(^ICD0(DA,0),"^",4)=$EXTRACT(AUM(3),1,50)
+16 SET $PIECE(^ICD0(DA,9999999),"^",4)=3011000
+17 DO MDC
+18 SET DIK="^ICD0("
DO IX1^DIK
End DoDot:1
+19 QUIT
MDC ;update MDC multiple
+1 FOR AUMI2=1:1
SET AUMLN=$TEXT(@AUMI+AUMI2)
IF +AUMLN
QUIT
Begin DoDot:1
+2 SET AUMMDC=$PIECE(AUMLN,";",2)
+3 SET AUMDRG=$PIECE(AUMLN,";",3)
+4 SET ^ICD0(DA,"MDC",AUMMDC,0)=AUMMDC
+5 SET ^ICD0(DA,"MDC",AUMMDC,"DRG")=AUMDRG
+6 IF +AUMLN'=999
SET ^ICD0(DA,"MDC",0)="^80.12PA^"_AUMMDC_"^"_AUMI2
End DoDot:1
+7 KILL AUMI2,AUMMDC,AUMDRG
+8 QUIT
REV ;revised descriptions
+1 SET AUM(1)="OTHER FETAL MONITORING"
+2 SET AUMCT=0
+3 FOR I=75.34
Begin DoDot:1
+4 SET AUMCT=AUMCT+1
+5 SET DA=$ORDER(^ICD0("AB",I,0))
+6 IF 'DA
QUIT
+7 SET ^ICD0(DA,1)=AUM(AUMCT)
+8 SET $PIECE(^ICD0(DA,0),"^",4)=$EXTRACT(AUM(AUMCT),1,50)
+9 SET DIK="^ICD0("
DO IX1^DIK
End DoDot:1
+10 QUIT
INA ;inactivate entry point
+1 FOR I=67.5,81.09
Begin DoDot:1
+2 SET DA=$ORDER(^ICD0("AB",I,0))
+3 IF 'DA
QUIT
+4 SET $PIECE(^ICD0(DA,0),"^",11)=3011000
End DoDot:1
+5 QUIT
+6 ;new codes
1 ;37.28;INTRACARDIAC ECHOCARDIOGRAPHY
2 ;44.32;PERCUTANEOUS [ENDOSCOPIC] GASTROJEJUNOSTOMY
+1 ;6;154^156
+2 ;7;201
+3 ;10;288
+4 ;17;400^406^407
3 ;67.51;TRANSABDOMINAL CERCLAGE OF CERVIX;F
+1 ;13;360
+2 ;14;372^373
+3 ;21;442^443
+4 ;24;486
4 ;67.59;OTHER REPAIR OF INTERNAL CERVICAL OS;F
+1 ;13;360
+2 ;14;372^373
+3 ;21;442^443
+4 ;24;486
5 ;75.38;FETAL PULSE OXIMETRY
6 ;81.30;REFUSION OF SPINE, NOT OTHERWISE SPECIFIED
+1 ;1;4
+2 ;8;497^498
+3 ;21;442^443
+4 ;24;486
7 ;81.31;REFUSION OF ATLAS-AXIS SPINE
+1 ;1;4
+2 ;8;497^498
+3 ;21;442^443
+4 ;24;486
8 ;81.32;REFUSION OF OTHER CERVICAL SPINE, ANTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
9 ;81.33;REFUSION OF OTHER CERVICAL SPINE, POSTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
10 ;81.34;REFUSION OF DORSAL AND DORSOLUMBAR SPINE, ANTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
11 ;81.35;REFUSION OF DORSAL AND DORSOLUMBAR SPINE, POSTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24^486
12 ;81.36;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, ANTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
13 ;81.37;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, LATERAL TRANSVERSE PROCESS TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
14 ;81.38;REFUSION OF LUMBAR AND LUMBOSACRAL SPINE, POSTERIOR TECHNIQUE
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
15 ;81.39;REFUSION OF SPINE, NOT ELSEWHERE CLASSIFIED
+1 ;1;4
+2 ;8;496^519^520
+3 ;21;442^443
+4 ;24;486
16 ;97.44;NONOPERATIVE REMOVAL OF HEART ASSIST SYSTEM
999 ;end
