ICD1865L.m

ICD1865L ;ALB/JDG - UPDATE DX & PX CODES ; 10/5/11 3:23pm

 ;;18.0;DRG Grouper;**65**;Oct 20,2000;Build 7

 ;

 Q

 ;

 ; Update Dx code(s)

 ;

CODENOCC ;entry point to add 'CODE NOT CC WITH' to Dx code 482.42

 ;

 N SDA,SDB,ICDA,ICDA1,LINE,LINEXX,ICDTXT,ICDEDXIEN

 S ICDA=0,ICDA1="",ICDEDXIEN=14734

 F  S ICDA=$O(^ICD9(ICDEDXIEN,2,ICDA)) Q:ICDA=""!(ICDA1=9119)  D

 .S ICDA1=$P(^ICD9(ICDEDXIEN,2,ICDA,0),U,1)

 I ICDA1=9119 D MESSTWO Q

 S SDA(1)="",SDA(2)=" Adding missing diagnosis code to CODE NOT CC WITH sub-file "

 S SDA(3)=" (#80.03) in the ICD DIAGNOSIS file (#80) for Dx code 482.42 "  D MESSONE

 F LINE=1:1 S LINEXX=$T(PROCUP1+LINE) S ICDTXT=$P(LINEXX,";;",2) Q:ICDTXT="EXIT"  D

 .S ICDFDA(80.03,"?+1,"_ICDEDXIEN_",",.01)=ICDTXT

 D UPDATE^DIE("","ICDFDA") K ICDFDA

 Q

 ;

 ;

MESSONE ;

 D MES^XPDUTL(.SDA) K SDA

 Q

 ;

 ;

MESSTWO ;

 S SDB(1)="",SDB(2)=" Diagnosis code 487.0 already exists. "

 S SDB(3)=" Nothing added to CODE NOT CC WITH sub-file (#80.03) "

 S SDB(4)=" in the ICD DIAGNOSIS file (#80) for Dx code 482.42 "

 D MES^XPDUTL(.SDB) K SDB

 Q

 ;

 ;

PROCUP1 ; IEN's of the missing Dx codes being added to CODE NOT CC WITH sub-file (#80.03) in the ICD DIAGNOSIS file (#80) for code 482.42

 ;;9119

 ;;EXIT

ICD1865L  ;ALB/JDG - UPDATE DX & PX CODES ; 10/5/11 3:23pm

 +1       ;;18.0;DRG Grouper;**65**;Oct 20,2000;Build 7

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ; Update Dx code(s)

 +6       ;

CODENOCC  ;entry point to add 'CODE NOT CC WITH' to Dx code 482.42

 +1       ;

 +2        NEW SDA,SDB,ICDA,ICDA1,LINE,LINEXX,ICDTXT,ICDEDXIEN

 +3        SET ICDA=0

           SET ICDA1=""

           SET ICDEDXIEN=14734

 +4        FOR 

               SET ICDA=$ORDER(^ICD9(ICDEDXIEN,2,ICDA))

               IF ICDA=""!(ICDA1=9119)

                   QUIT 

               Begin DoDot:1

 +5                SET ICDA1=$PIECE(^ICD9(ICDEDXIEN,2,ICDA,0),U,1)

               End DoDot:1

 +6        IF ICDA1=9119

               DO MESSTWO

               QUIT 

 +7        SET SDA(1)=""

           SET SDA(2)=" Adding missing diagnosis code to CODE NOT CC WITH sub-file "

 +8        SET SDA(3)=" (#80.03) in the ICD DIAGNOSIS file (#80) for Dx code 482.42 "

           DO MESSONE

 +9        FOR LINE=1:1

               SET LINEXX=$TEXT(PROCUP1+LINE)

               SET ICDTXT=$PIECE(LINEXX,";;",2)

               IF ICDTXT="EXIT"

                   QUIT 

               Begin DoDot:1

 +10               SET ICDFDA(80.03,"?+1,"_ICDEDXIEN_",",.01)=ICDTXT

               End DoDot:1

 +11       DO UPDATE^DIE("","ICDFDA")

           KILL ICDFDA

 +12       QUIT 

 +13      ;

 +14      ;

MESSONE   ;

 +1        DO MES^XPDUTL(.SDA)

           KILL SDA

 +2        QUIT 

 +3       ;

 +4       ;

MESSTWO   ;

 +1        SET SDB(1)=""

           SET SDB(2)=" Diagnosis code 487.0 already exists. "

 +2        SET SDB(3)=" Nothing added to CODE NOT CC WITH sub-file (#80.03) "

 +3        SET SDB(4)=" in the ICD DIAGNOSIS file (#80) for Dx code 482.42 "

 +4        DO MES^XPDUTL(.SDB)

           KILL SDB

 +5        QUIT 

 +6       ;

 +7       ;

PROCUP1   ; IEN's of the missing Dx codes being added to CODE NOT CC WITH sub-file (#80.03) in the ICD DIAGNOSIS file (#80) for code 482.42

 +1       ;;9119

 +2       ;;EXIT