Routine: AICDPOST

AICDPOST ; IHS/OIT/FBD&NKD - ICD-10 LOAD POST-INIT ;

 ;;4.0;AICD;;DEC 12, 2014;Build 7

 D:'$D(IOM) HOME^%ZIS

 ; LOAD ICD-10 GLOBAL VALUES

 D MES^XPDUTL($$LJ^XLFSTR("Loading ICD-10 codes into ICD globals...",IOM))

 ; DOUBLE-CHECK EXISTENCE OF UPDATE GLOBALS (IN CASE OF RESTART)

 S AICDERR=0

 S:'$$GCHK^AICDENV("^AICDICD9","ICD DIAGNOSIS update global") AICDERR=2            ; FILE 80

 S:'$$GCHK^AICDENV("^AICDICD0","ICD OPERATION/PROCEDURE update global") AICDERR=2  ; FILE 80.1

 S:'$$GCHK^AICDENV("^AICDICDS","ICD CODING SYSTEMS update global") AICDERR=2       ; FILE 80.4

 I +AICDERR D SORRY(AICDERR) Q

 I $D(^ICD9(500001)) D  ; CLEANUP FOR RE-INSTALLATIONS - FLUSH PREVIOUS ICD-10 LOADS

 . N AICDIEN

 . S AICDIEN=499998

 . F  S AICDIEN=$O(^ICD9(AICDIEN)) Q:+AICDIEN'=AICDIEN  K ^ICD9(AICDIEN)  ; CLEANING ^ICD9 GLOBAL (FILE 80)

 . S AICDIEN=499998

 . F  S AICDIEN=$O(^ICD0(AICDIEN)) Q:+AICDIEN'=AICDIEN  K ^ICD0(AICDIEN)  ; CLEANING ^ICD0 GLOBAL (FILE 80.1)

 M ^ICD9=^AICDICD9  ; FILE 80

 M ^ICD0=^AICDICD0  ; FILE 80.1

 M ^ICDS=^AICDICDS  ; FILE 80.4

 K ^AICDALL(0)      ; RESET OVERRIDE

 D MES^XPDUTL($$LJ^XLFSTR("ICD-10 global load complete.",IOM))

 ; LAST STEP - REINDEX UPDATED FILES

 N XREF

 D MES^XPDUTL($$LJ^XLFSTR("Re-indexing modified files...",IOM))

 ; 1) WHOLE-FILE X-REF KILLS

 S XREF="@"                              ; STARTER SEED VALUE FOR FILE 80 XREF SCAN

 F  S XREF=$O(^ICD9(XREF)) Q:XREF=""  D  ; SCAN AND FLUSH ALL XREFS FOR FILE 80

 . K ^ICD9(XREF)

 S XREF="@"                              ; STARTER SEED VALUE FOR FILE 80.1 XREF SCAN

 F  S XREF=$O(^ICD0(XREF)) Q:XREF=""  D  ; SCAN AND FLUSH ALL XREFS FOR FILE 80.1

 . K ^ICD0(XREF)

 S XREF="@"                              ; STARTER SEED VALUE FOR FILE 80.4 XREF SCAN

 F  S XREF=$O(^ICDS(XREF)) Q:XREF=""  D  ; SCAN AND FLUSH ALL XREFS FOR FILE 80.4

 . K ^ICDS(XREF)

 ; 2) SUB-FILE X-REF KILLS

 F DIK="^ICD9(","^ICD0(","^ICDS(" D IXALL2^DIK  ; KILL LOGIC (TO REMOVE SUBFILE XREFS)

 ; 3) COMPLETE RE-INDEX (SET LOGIC)

 D MES^XPDUTL($$LJ^XLFSTR(" - File 80 ",IOM))

 S DIK="^ICD9(" D IXALL^DIK

 D MES^XPDUTL($$LJ^XLFSTR(" - File 80.1 ",IOM))

 S DIK="^ICD0(" D IXALL^DIK

 D MES^XPDUTL($$LJ^XLFSTR(" - File 80.4 ",IOM))

 S DIK="^ICDS(" D IXALL^DIK

 ; ENABLE ICD9 UNCODED DX/PX ENTRIES

 D UNCODED

 ; END OF POST-INIT RUN LOGIC

 D MES^XPDUTL($$LJ^XLFSTR("IHS ICD-10 LOOKUP install complete.",IOM))

UNCODED ; ADD/UPDATE ICD9 UNCODED ENTRIES

 N AICDC,AICDS,AICDI,AICDF,AICDR,AICDDT

 D MES^XPDUTL("Enabling IHS ICD9 Uncoded entries...")

 S AICDC=".9999",AICDDT=3141001

 F AICDS=1,2 S AICDF=$$FILE^ICDEX(AICDS),AICDR=$$ROOT^ICDEX(AICDS),AICDI=+$$CODEABA^ICDEX(AICDC,,AICDS) D

 . N FDA,NEWIEN

 . I AICDI<1 D

 . . S FDA(AICDF,"+1,",.01)=AICDC,FDA(AICDF,"+1,",1.1)=AICDS

 . . F AICDI=499999:-1:0 Q:'$D(@(AICDR_AICDI_")"))

 . . Q:'AICDI  Q:$D(@(AICDR_AICDI_")"))

 . . S NEWIEN(1)=AICDI

 . . D UPDATE^DIE(,"FDA","NEWIEN")

 . . S AICDI=$G(NEWIEN(1))

 . I 'AICDI D MES^XPDUTL("Could not add uncoded "_$$SNAM^ICDEX(AICDS)) Q

 . K FDA

 . S FDA(AICDF+.066,"?+2,"_AICDI_",",.01)=AICDDT

 . S FDA(AICDF+.066,"?+2,"_AICDI_",",.02)=1

 . S FDA(AICDF+.067,"?+3,"_AICDI_",",.01)=AICDDT

 . S FDA(AICDF+.067,"?+3,"_AICDI_",",1)="UNCODED "_$S(AICDS=2:"OPERATION / PROCEDURE",1:"DIAGNOSIS")

 . S FDA(AICDF+.068,"?+4,"_AICDI_",",.01)=AICDDT

 . S FDA(AICDF+.068,"?+4,"_AICDI_",",1)="UNCODED "_$S(AICDS=2:"OPERATION / PROCEDURE",1:"DIAGNOSIS")

 . D UPDATE^DIE(,"FDA")

 D MES^XPDUTL("Done")

SORRY(X) ;

 KILL DIFQ

 S XPDQUIT=X

 D MES^XPDUTL($$LJ^XLFSTR("Aborting post-init process.",IOM))

AICDPOST  ; IHS/OIT/FBD&NKD - ICD-10 LOAD POST-INIT ;

 +1       ;;4.0;AICD;;DEC 12, 2014;Build 7

 +2       ;

 +3       ;

 +4        IF '$DATA(IOM)

               DO HOME^%ZIS

 +5       ;

 +6       ; LOAD ICD-10 GLOBAL VALUES

 +7        DO MES^XPDUTL($$LJ^XLFSTR("Loading ICD-10 codes into ICD globals...",IOM))

 +8       ;

 +9       ; DOUBLE-CHECK EXISTENCE OF UPDATE GLOBALS (IN CASE OF RESTART)

 +10       SET AICDERR=0

 +11      ; FILE 80

           IF '$$GCHK^AICDENV("^AICDICD9","ICD DIAGNOSIS update global")

               SET AICDERR=2

 +12      ; FILE 80.1

           IF '$$GCHK^AICDENV("^AICDICD0","ICD OPERATION/PROCEDURE update global")

               SET AICDERR=2

 +13      ; FILE 80.4

           IF '$$GCHK^AICDENV("^AICDICDS","ICD CODING SYSTEMS update global")

               SET AICDERR=2

 +14       IF +AICDERR

               DO SORRY(AICDERR)

               QUIT

 +15      ;

 +16      ; CLEANUP FOR RE-INSTALLATIONS - FLUSH PREVIOUS ICD-10 LOADS

           IF $DATA(^ICD9(500001))

               Begin DoDot:1

 +17               NEW AICDIEN

 +18               SET AICDIEN=499998

 +19      ; CLEANING ^ICD9 GLOBAL (FILE 80)

FOR

                       SET AICDIEN=$ORDER(^ICD9(AICDIEN))

                       IF +AICDIEN'=AICDIEN

                           QUIT

                       KILL ^ICD9(AICDIEN)

 +20               SET AICDIEN=499998

 +21      ; CLEANING ^ICD0 GLOBAL (FILE 80.1)

FOR

                       SET AICDIEN=$ORDER(^ICD0(AICDIEN))

                       IF +AICDIEN'=AICDIEN

                           QUIT

                       KILL ^ICD0(AICDIEN)

               End DoDot:1

 +22      ;

 +23      ; FILE 80

           MERGE ^ICD9=^AICDICD9

 +24      ; FILE 80.1

           MERGE ^ICD0=^AICDICD0

 +25      ; FILE 80.4

           MERGE ^ICDS=^AICDICDS

 +26      ; RESET OVERRIDE

           KILL ^AICDALL(0)

 +27       DO MES^XPDUTL($$LJ^XLFSTR("ICD-10 global load complete.",IOM))

 +28      ;

 +29      ; LAST STEP - REINDEX UPDATED FILES

 +30       NEW XREF

 +31       DO MES^XPDUTL($$LJ^XLFSTR("Re-indexing modified files...",IOM))

 +32      ;

 +33      ; 1) WHOLE-FILE X-REF KILLS

 +34      ; STARTER SEED VALUE FOR FILE 80 XREF SCAN

           SET XREF="@"

 +35      ; SCAN AND FLUSH ALL XREFS FOR FILE 80

FOR

               SET XREF=$ORDER(^ICD9(XREF))

               IF XREF=""

                   QUIT

               Begin DoDot:1

 +36               KILL ^ICD9(XREF)

               End DoDot:1

 +37      ; STARTER SEED VALUE FOR FILE 80.1 XREF SCAN

           SET XREF="@"

 +38      ; SCAN AND FLUSH ALL XREFS FOR FILE 80.1

FOR

               SET XREF=$ORDER(^ICD0(XREF))

               IF XREF=""

                   QUIT

               Begin DoDot:1

 +39               KILL ^ICD0(XREF)

               End DoDot:1

 +40      ; STARTER SEED VALUE FOR FILE 80.4 XREF SCAN

           SET XREF="@"

 +41      ; SCAN AND FLUSH ALL XREFS FOR FILE 80.4

FOR

               SET XREF=$ORDER(^ICDS(XREF))

               IF XREF=""

                   QUIT

               Begin DoDot:1

 +42               KILL ^ICDS(XREF)

               End DoDot:1

 +43      ;

 +44      ; 2) SUB-FILE X-REF KILLS

 +45      ; KILL LOGIC (TO REMOVE SUBFILE XREFS)

           FOR DIK="^ICD9(","^ICD0(","^ICDS("

               DO IXALL2^DIK

 +46      ;

 +47      ; 3) COMPLETE RE-INDEX (SET LOGIC)

 +48       DO MES^XPDUTL($$LJ^XLFSTR(" - File 80 ",IOM))

 +49       SET DIK="^ICD9("

           DO IXALL^DIK

 +50       DO MES^XPDUTL($$LJ^XLFSTR(" - File 80.1 ",IOM))

 +51       SET DIK="^ICD0("

           DO IXALL^DIK

 +52       DO MES^XPDUTL($$LJ^XLFSTR(" - File 80.4 ",IOM))

 +53       SET DIK="^ICDS("

           DO IXALL^DIK

 +54      ;

 +55      ; ENABLE ICD9 UNCODED DX/PX ENTRIES

 +56       DO UNCODED

 +57      ;

 +58      ; END OF POST-INIT RUN LOGIC

 +59       DO MES^XPDUTL($$LJ^XLFSTR("IHS ICD-10 LOOKUP install complete.",IOM))

 +60       QUIT

 +61      ;

UNCODED   ; ADD/UPDATE ICD9 UNCODED ENTRIES

 +1        NEW AICDC,AICDS,AICDI,AICDF,AICDR,AICDDT

 +2        DO MES^XPDUTL("Enabling IHS ICD9 Uncoded entries...")

 +3        SET AICDC=".9999"

           SET AICDDT=3141001

 +4        FOR AICDS=1,2

               SET AICDF=$$FILE^ICDEX(AICDS)

               SET AICDR=$$ROOT^ICDEX(AICDS)

               SET AICDI=+$$CODEABA^ICDEX(AICDC,,AICDS)

               Begin DoDot:1

 +5                NEW FDA,NEWIEN

 +6                IF AICDI<1

                       Begin DoDot:2

 +7                        SET FDA(AICDF,"+1,",.01)=AICDC

                           SET FDA(AICDF,"+1,",1.1)=AICDS

 +8                        FOR AICDI=499999:-1:0

                               IF '$DATA(@(AICDR_AICDI_")"))

                                   QUIT

 +9                        IF 'AICDI

                               QUIT

                           IF $DATA(@(AICDR_AICDI_")"))

                               QUIT

 +10                       SET NEWIEN(1)=AICDI

 +11                       DO UPDATE^DIE(,"FDA","NEWIEN")

 +12                       SET AICDI=$GET(NEWIEN(1))

                       End DoDot:2

 +13               IF 'AICDI

                       DO MES^XPDUTL("Could not add uncoded "_$$SNAM^ICDEX(AICDS))

                       QUIT

 +14               KILL FDA

 +15               SET FDA(AICDF+.066,"?+2,"_AICDI_",",.01)=AICDDT

 +16               SET FDA(AICDF+.066,"?+2,"_AICDI_",",.02)=1

 +17               SET FDA(AICDF+.067,"?+3,"_AICDI_",",.01)=AICDDT

 +18               SET FDA(AICDF+.067,"?+3,"_AICDI_",",1)="UNCODED "_$SELECT(AICDS=2:"OPERATION / PROCEDURE",1:"DIAGNOSIS")

 +19               SET FDA(AICDF+.068,"?+4,"_AICDI_",",.01)=AICDDT

 +20               SET FDA(AICDF+.068,"?+4,"_AICDI_",",1)="UNCODED "_$SELECT(AICDS=2:"OPERATION / PROCEDURE",1:"DIAGNOSIS")

 +21               DO UPDATE^DIE(,"FDA")

               End DoDot:1

 +22       DO MES^XPDUTL("Done")

 +23      ;

 +24       QUIT

SORRY(X)  ;

 +1        KILL DIFQ

 +2        SET XPDQUIT=X

 +3        DO MES^XPDUTL($$LJ^XLFSTR("Aborting post-init process.",IOM))

 +4        QUIT

AICDPOST.m