ICDPSTV1.m

ICDPSTV1 ;ALB/EG - POSTINIT FOR DRG GROUPER ; APR 5 1991

 ;;8.0

DRGA F I=1:1 S X=$T(ADD+I) S ICDDRG=$P(X,";;",2) Q:ICDDRG=""  X ICDDRG

 S DIK="^ICD(" F DA=478:1:490 W "." D IX^DIK

 F DA=468,469,470,474,476,477 S $P(^ICD(DA,0),"^",5)=99 D IX^DIK

 S ^ICD(0)="DRG^80.2^490^490" K DA,DIK,I,ICDDRG,X Q

ADD ;new drg's

 ;;S ^ICD(478,0)="DRG478^^^^5^1^^^^^^"

 ;;S ^ICD(478,1,0)="^80.21A^1^1"

 ;;S ^ICD(478,1,1,0)="OTHER VASCULAR PROCEDURES W CC"

 ;;S ^ICD(478,"MC")="S ICDRG=$S(ICDOR[""O""&ICDCC:478,1:479)"

 ;;S ^ICD(479,0)="DRG479^^^^5^1^^^^^^"

 ;;S ^ICD(479,1,0)="^80.21A^1^1"

 ;;S ^ICD(479,1,1,0)="OTHER VASCULAR PROCEDURES W/O CC"

 ;;S ^ICD(479,"MC")="S ICDRG=$S(ICDOR[""O""&ICDCC:478,1:479)"

 ;;S ^ICD(480,0)="DRG480^^^^99^1^^^^^^"

 ;;S ^ICD(480,1,0)="^80.21A^1^1"

 ;;S ^ICD(480,1,1,0)="LIVER TRANSPLANT"

 ;;S ^ICD(480,"MC")="Q"

 ;;S ^ICD(481,0)="DRG481^^^^99^1^^^^^^"

 ;;S ^ICD(481,1,0)="^80.21A^1^1"

 ;;S ^ICD(481,1,1,0)="BONE MARROW TRANSPLANT"

 ;;S ^ICD(481,"MC")="Q"

 ;;S ^ICD(482,0)="DRG482^^^^99^1^^^^^^"

 ;;S ^ICD(482,1,0)="^80.21A^1^1"

 ;;S ^ICD(482,1,1,0)="TRACHEOSTOMY W MOUTH, LARYNX, PHARYNX DISORDER"

 ;;S ^ICD(482,"MC")="Q"

 ;;S ^ICD(483,0)="DRG483^^^^99^1^^^^^^"

 ;;S ^ICD(483,1,0)="^80.21A^1^1"

 ;;S ^ICD(483,1,1,0)="TRACHEOSTOMY W/O MOUTH, LARYNX, PHARYNX, DISORDER"

 ;;S ^ICD(483,"MC")="Q"

 ;;S ^ICD(484,0)="DRG484^^^^24^1^^^^^^"

 ;;S ^ICD(484,1,0)="^80.21A^1^1"

 ;;S ^ICD(484,1,1,0)="CRANIOTOMY FOR MULTIPLE SIGNIFICANT TRAUMA"

 ;;S ^ICD(484,"MC")="Q"

 ;;S ^ICD(485,0)="DRG485^^^^24^1^^^^^^"

 ;;S ^ICD(485,1,0)="^80.21A^1^1"

 ;;S ^ICD(485,1,1,0)="LIMB REATTACHMENT, HIP & FEMUR"

 ;;S ^ICD(485,"MC")="Q"

 ;;S ^ICD(486,0)="DRG486^^^^24^1^^^^^^"

 ;;S ^ICD(486,1,0)="^80.21A^1^1"

 ;;S ^ICD(486,1,1,0)="OTHER OPER PROCEDURES FOR MULTIPLE SIGNIFICANT TRAUMA"

 ;;S ^ICD(486,"MC")="Q"

 ;;S ^ICD(487,0)="DRG487^^^^24^^^^^^^"

 ;;S ^ICD(487,1,0)="^80.21A^1^1"

 ;;S ^ICD(487,1,1,0)="OTHER MULTIPLE SIGNIFICANT TRAUMA"

 ;;S ^ICD(487,"MC")="Q"

 ;;S ^ICD(488,0)="DRG488^^^^25^1^^^^^^"

 ;;S ^ICD(488,1,0)="^80.21A^1^1"

 ;;S ^ICD(488,1,1,0)="HIV W EXTENSIVE OPER PROCEDURE"

 ;;S ^ICD(488,"MC")="Q"

 ;;S ^ICD(489,0)="DRG489^^^^25^^^^^^^"

 ;;S ^ICD(489,1,0)="^80.21A^1^1"

 ;;S ^ICD(489,1,1,0)="HIV W MAJOR RELATED CONDITION"

 ;;S ^ICD(489,"MC")="Q"

 ;;S ^ICD(490,0)="DRG490^^^^25^^^^^^^"

 ;;S ^ICD(490,1,0)="^80.21A^1^1"

 ;;S ^ICD(490,1,1,0)="HIV W OR W/O  OTHER RELATED CONDITION"

 ;;S ^ICD(490,"MC")="Q"

 ;;

ICDPSTV1  ;ALB/EG - POSTINIT FOR DRG GROUPER ; APR 5 1991

 +1       ;;8.0

DRGA       FOR I=1:1

               SET X=$TEXT(ADD+I)

               SET ICDDRG=$PIECE(X,";;",2)

               IF ICDDRG=""

                   QUIT 

               XECUTE ICDDRG

 +1        SET DIK="^ICD("

           FOR DA=478:1:490

               WRITE "."

               DO IX^DIK

 +2        FOR DA=468,469,470,474,476,477

               SET $PIECE(^ICD(DA,0),"^",5)=99

               DO IX^DIK

 +3        SET ^ICD(0)="DRG^80.2^490^490"

           KILL DA,DIK,I,ICDDRG,X

           QUIT 

ADD       ;new drg's

 +1       ;;S ^ICD(478,0)="DRG478^^^^5^1^^^^^^"

 +2       ;;S ^ICD(478,1,0)="^80.21A^1^1"

 +3       ;;S ^ICD(478,1,1,0)="OTHER VASCULAR PROCEDURES W CC"

 +4       ;;S ^ICD(478,"MC")="S ICDRG=$S(ICDOR[""O""&ICDCC:478,1:479)"

 +5       ;;S ^ICD(479,0)="DRG479^^^^5^1^^^^^^"

 +6       ;;S ^ICD(479,1,0)="^80.21A^1^1"

 +7       ;;S ^ICD(479,1,1,0)="OTHER VASCULAR PROCEDURES W/O CC"

 +8       ;;S ^ICD(479,"MC")="S ICDRG=$S(ICDOR[""O""&ICDCC:478,1:479)"

 +9       ;;S ^ICD(480,0)="DRG480^^^^99^1^^^^^^"

 +10      ;;S ^ICD(480,1,0)="^80.21A^1^1"

 +11      ;;S ^ICD(480,1,1,0)="LIVER TRANSPLANT"

 +12      ;;S ^ICD(480,"MC")="Q"

 +13      ;;S ^ICD(481,0)="DRG481^^^^99^1^^^^^^"

 +14      ;;S ^ICD(481,1,0)="^80.21A^1^1"

 +15      ;;S ^ICD(481,1,1,0)="BONE MARROW TRANSPLANT"

 +16      ;;S ^ICD(481,"MC")="Q"

 +17      ;;S ^ICD(482,0)="DRG482^^^^99^1^^^^^^"

 +18      ;;S ^ICD(482,1,0)="^80.21A^1^1"

 +19      ;;S ^ICD(482,1,1,0)="TRACHEOSTOMY W MOUTH, LARYNX, PHARYNX DISORDER"

 +20      ;;S ^ICD(482,"MC")="Q"

 +21      ;;S ^ICD(483,0)="DRG483^^^^99^1^^^^^^"

 +22      ;;S ^ICD(483,1,0)="^80.21A^1^1"

 +23      ;;S ^ICD(483,1,1,0)="TRACHEOSTOMY W/O MOUTH, LARYNX, PHARYNX, DISORDER"

 +24      ;;S ^ICD(483,"MC")="Q"

 +25      ;;S ^ICD(484,0)="DRG484^^^^24^1^^^^^^"

 +26      ;;S ^ICD(484,1,0)="^80.21A^1^1"

 +27      ;;S ^ICD(484,1,1,0)="CRANIOTOMY FOR MULTIPLE SIGNIFICANT TRAUMA"

 +28      ;;S ^ICD(484,"MC")="Q"

 +29      ;;S ^ICD(485,0)="DRG485^^^^24^1^^^^^^"

 +30      ;;S ^ICD(485,1,0)="^80.21A^1^1"

 +31      ;;S ^ICD(485,1,1,0)="LIMB REATTACHMENT, HIP & FEMUR"

 +32      ;;S ^ICD(485,"MC")="Q"

 +33      ;;S ^ICD(486,0)="DRG486^^^^24^1^^^^^^"

 +34      ;;S ^ICD(486,1,0)="^80.21A^1^1"

 +35      ;;S ^ICD(486,1,1,0)="OTHER OPER PROCEDURES FOR MULTIPLE SIGNIFICANT TRAUMA"

 +36      ;;S ^ICD(486,"MC")="Q"

 +37      ;;S ^ICD(487,0)="DRG487^^^^24^^^^^^^"

 +38      ;;S ^ICD(487,1,0)="^80.21A^1^1"

 +39      ;;S ^ICD(487,1,1,0)="OTHER MULTIPLE SIGNIFICANT TRAUMA"

 +40      ;;S ^ICD(487,"MC")="Q"

 +41      ;;S ^ICD(488,0)="DRG488^^^^25^1^^^^^^"

 +42      ;;S ^ICD(488,1,0)="^80.21A^1^1"

 +43      ;;S ^ICD(488,1,1,0)="HIV W EXTENSIVE OPER PROCEDURE"

 +44      ;;S ^ICD(488,"MC")="Q"

 +45      ;;S ^ICD(489,0)="DRG489^^^^25^^^^^^^"

 +46      ;;S ^ICD(489,1,0)="^80.21A^1^1"

 +47      ;;S ^ICD(489,1,1,0)="HIV W MAJOR RELATED CONDITION"

 +48      ;;S ^ICD(489,"MC")="Q"

 +49      ;;S ^ICD(490,0)="DRG490^^^^25^^^^^^^"

 +50      ;;S ^ICD(490,1,0)="^80.21A^1^1"

 +51      ;;S ^ICD(490,1,1,0)="HIV W OR W/O  OTHER RELATED CONDITION"

 +52      ;;S ^ICD(490,"MC")="Q"

 +53      ;;