AUM61B ; IHS/SD/SDR - New routine created in Serenji at 8/13/2004 9:19:42 AM
;;06.1;TABLE MAINTENANCE;;SEP 28,2001
;
ICD9ENEW ;;ICD 9, NEW/REVISED E-CODES: CODE NUMBER(#.01)^DIAGNOSIS(#3)^DESCRIPTION(#10)^Use only with sex(#9.5)
;;END
ICD9PREV ;;ICD OPERATION/PROCEDURE, REVISED CODES: CODE NUMBER(#.01)^OPERATION/PROCEDURE(#4)^DESCRIPTION(#10)^MDC(#80.12)-DRG(#80.12,1-6) (Multiple MDCs/DRGs separated by "~")
;;37.79^REV/REL CARDIAC DEVICE POCKET^REVISION OR RELOCATION OF CARDIAC DEVICE POCKET^^1-7,8
;;78.10^APPL EXT FIX DEV UNSPEC SITE^APPLICATION OF EXTERNAL FIXATOR DEVICE, UNSPECIFIED SITE^^8-233,234
;;78.11^EXT SCAP CLAV THOR(RIBS/STERN)^APPLICATION OF EXTERNAL FIXATOR DEVICE, SCAPULA, CLAVICLE, AND THORAX (RIBS AND STERNUM)^^4-76,77
;;78.12^APPL EXT FIXATOR DEV, HUMERUS^APPLICATION OF EXTERNAL FIXATOR DEVICE, HUMERUS^^8-218,219,220
;;78.13^APPL EXT FIX DEV RADIUS & ULNA^APPLICATION OF EXTERNAL FIXATOR DEVICE, RADIUS AND ULNA^^8-233,234
;;78.14^EXT DEV CARPALS & METACARPALS^APPLICATION OF EXTERNAL FIXATOR DEVICE, CARPALS AND METACARPALS^^8-228,229
;;78.15^APPL EXT FIXATOR DEVICE, FEMUR^APPLICATION OF EXTERNAL FIXATOR DEVICE, FEMUR^^8-210,211,212
;;78.16^APPL EXT FIXATOR DEV, PATELLA^APPLICATION OF EXTERNAL FIXATOR DEVICE, PATELLA^^8-501,502,503
;;78.17^APPL EXT DEV, TIBIA AND FIBULA^APPLICATION OF EXTERNAL FIXATOR DEVICE, TIBIA AND FIBULA^^8-218,219,220
;;78.18^APPL EXT DEV, TARSALS & META^APPLICATION OF EXTERNAL FIXATOR DEVICE, TARSALS AND METATARSALS^^8-225
;;78.19^APPL EXT FIXATOR DEV, OTHER^APPLICATION OF EXTERNAL FIXATOR DEVICE, OTHER^^8-233,234
;;81.53^REV HIP REPLACE NOT OTHER SPEC^REVISION OF HIP REPLACEMENT, NOT OTHERWISE SPECIFIED^^8-471,545
;;81.55^REV KNEE REPL NOT OTHER SPEC^REVISION OF KNEE REPLACEMENT, NOT OTHERWISE SPECIFIED^^8-471,545
;;END
PRNT ;
S U="^"
W !," CODE",?10,"DIAGNOSIS",!?10,"DESCRIPTION",!," -----",?10,"-----------"
NEW X,Y,P2,P3
F X=1:1 S Y=$P($T(ICD9NEW+X),";;",3),P2=$P(Y,U,2),P3=$P(Y,U,3) Q:Y="END" W !," ",$P(Y,U,1),?10,$S($L(P3):P3,1:P2),!?10,P2
Q
AUM61B ; IHS/SD/SDR - New routine created in Serenji at 8/13/2004 9:19:42 AM
+1 ;;06.1;TABLE MAINTENANCE;;SEP 28,2001
+2 ;
ICD9ENEW ;;ICD 9, NEW/REVISED E-CODES: CODE NUMBER(#.01)^DIAGNOSIS(#3)^DESCRIPTION(#10)^Use only with sex(#9.5)
+1 ;;END
ICD9PREV ;;ICD OPERATION/PROCEDURE, REVISED CODES: CODE NUMBER(#.01)^OPERATION/PROCEDURE(#4)^DESCRIPTION(#10)^MDC(#80.12)-DRG(#80.12,1-6) (Multiple MDCs/DRGs separated by "~")
+1 ;;37.79^REV/REL CARDIAC DEVICE POCKET^REVISION OR RELOCATION OF CARDIAC DEVICE POCKET^^1-7,8
+2 ;;78.10^APPL EXT FIX DEV UNSPEC SITE^APPLICATION OF EXTERNAL FIXATOR DEVICE, UNSPECIFIED SITE^^8-233,234
+3 ;;78.11^EXT SCAP CLAV THOR(RIBS/STERN)^APPLICATION OF EXTERNAL FIXATOR DEVICE, SCAPULA, CLAVICLE, AND THORAX (RIBS AND STERNUM)^^4-76,77
+4 ;;78.12^APPL EXT FIXATOR DEV, HUMERUS^APPLICATION OF EXTERNAL FIXATOR DEVICE, HUMERUS^^8-218,219,220
+5 ;;78.13^APPL EXT FIX DEV RADIUS & ULNA^APPLICATION OF EXTERNAL FIXATOR DEVICE, RADIUS AND ULNA^^8-233,234
+6 ;;78.14^EXT DEV CARPALS & METACARPALS^APPLICATION OF EXTERNAL FIXATOR DEVICE, CARPALS AND METACARPALS^^8-228,229
+7 ;;78.15^APPL EXT FIXATOR DEVICE, FEMUR^APPLICATION OF EXTERNAL FIXATOR DEVICE, FEMUR^^8-210,211,212
+8 ;;78.16^APPL EXT FIXATOR DEV, PATELLA^APPLICATION OF EXTERNAL FIXATOR DEVICE, PATELLA^^8-501,502,503
+9 ;;78.17^APPL EXT DEV, TIBIA AND FIBULA^APPLICATION OF EXTERNAL FIXATOR DEVICE, TIBIA AND FIBULA^^8-218,219,220
+10 ;;78.18^APPL EXT DEV, TARSALS & META^APPLICATION OF EXTERNAL FIXATOR DEVICE, TARSALS AND METATARSALS^^8-225
+11 ;;78.19^APPL EXT FIXATOR DEV, OTHER^APPLICATION OF EXTERNAL FIXATOR DEVICE, OTHER^^8-233,234
+12 ;;81.53^REV HIP REPLACE NOT OTHER SPEC^REVISION OF HIP REPLACEMENT, NOT OTHERWISE SPECIFIED^^8-471,545
+13 ;;81.55^REV KNEE REPL NOT OTHER SPEC^REVISION OF KNEE REPLACEMENT, NOT OTHERWISE SPECIFIED^^8-471,545
+14 ;;END
PRNT ;
+1 SET U="^"
+2 WRITE !," CODE",?10,"DIAGNOSIS",!?10,"DESCRIPTION",!," -----",?10,"-----------"
+3 NEW X,Y,P2,P3
+4 FOR X=1:1
SET Y=$PIECE($TEXT(ICD9NEW+X),";;",3)
SET P2=$PIECE(Y,U,2)
SET P3=$PIECE(Y,U,3)
IF Y="END"
QUIT
WRITE !," ",$PIECE(Y,U,1),?10,$SELECT($LENGTH(P3):P3,1:P2),!?10,P2
+5 QUIT