Routine: ICD186E

ICD186E ;DLS/DEK- ICD Env. Check; 04/28/2003

 ;;18.0;DRG Grouper;**6**;Oct 20, 2000

 ; External References

 ;   DBIA  10141  $$PATCH^XPDUTL

 ;   DBIA  10141  BMES^XPDUTL

 ;   DBIA  10141  MES^XPDUTL

ENVCHK ; Check Environment for needed vars.

 N PATCH,BUILD

 S XPDABORT="",PATCH="ICD*18.0*5",BUILD="ICD*18.0*6"

 I '$$PATCH^XPDUTL(PATCH) D  Q

 . D BM(PATCH_" is required and MUST be installed prior to this patch."),ABRT

 I +($$CPD)'>0,+($G(XPDENV))=0 D

 . I +($G(^LEXM(0,"CHECKSUM")))'=70183825959 D

 . . D BM("Global ^LEXM either not found or incomplete."),ABRT

 D:+($G(XPDABORT))'>0 PROGCHK(.XPDABORT)

 I $G(XPDABORT)="" K XPDABORT D OK

PROGCHK(XPDABORT) ; Check for Programmer

 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D

 . D BM("Programming variables are not set up properly."),ABRT

ABRT ; Abort - All or nothing

 S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*25")=1

 S XPDQUIT("ICD*18.0*6")=1,XPDQUIT("ICPT*6.0*14")=1

 S XPDQUIT("CSV UTIL 1.0")=1

OK ; Environment is Ok

 Q:+($G(XPDENV))>0

 D BM(("  Environment for patch/build "_BUILD_" is ok")),M(" ")

POST ; Post-Install - Rebuild Indexes

 N ZTRTN,ZTDESC,ZTSK,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ICD1,ICD2 S (ICD1,ICD2)=0

 S ZTRTN="ICDD^ICD186E",ZTDESC="Re-Index file #80"

 S ZTIO="",ZTDTH=$H K ZTSK D ^%ZTLOAD,HOME^%ZIS

 S:+($G(ZTSK))>0 ICD1=+($G(ZTSK))

 S ZTRTN="ICDP^ICD186E",ZTDESC="Re-Index file #80.1"

 S ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS

 S:+($G(ZTSK))>0 ICD2=+($G(ZTSK))

 I ICD1>0,ICD2'>0 D BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))

 I ICD1'>0,ICD2>0 D BM(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))

 I ICD1>0,ICD2>0 D

 . D BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))

 . D M(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))

 K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ICD1,ICD2

ICDD ;   ICD9( Diagnosis

 S:$D(ZTQUEUED) ZTREQ="@"

 N DA,DIK S U="^",DT=$$DT^XLFDT,DIK="^ICD9(",DA=0

 F  S DA=$O(^ICD9(DA)) Q:+DA=0  K ^ICD9(DA,66,"B")

 K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT")

 K ^ICD9("BA"),^ICD9("D")

 D IXALL^DIK

ICDP ;   ICD0( Procedure

 S:$D(ZTQUEUED) ZTREQ="@"

 N DA,DIK S U="^",DT=$$DT^XLFDT,DIK="^ICD0(",DA=0

 F  S DA=$O(^ICD0(DA)) Q:+DA=0  K ^ICD0(DA,66,"B")

 K ^ICD0("AB"),^ICD0("ACT"),^ICD0("BA"),^ICD0("D")

 K ^ICD0("E") D IXALL^DIK

CPD(X) ;   Check Current Patched Data is installed

 Q:$D(^LEX(757.1,"B",180595,257762))&('$D(^LEX(757.02,"B",322162,3296))) 1

Q 0

 ; Miscellaneous

BM(X) ;   Blank Line with Message

 S X=" "_$G(X) D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q

M(X) ;   Message

 S X=" "_$G(X) D:$D(XPDNM) MES^XPDUTL($G(X)) W:'$D(XPDNM) !,$G(X) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD186E   2834     printed  Mar 13, 2025@20:53:47                                                                                                                                                                                                     Page 2

ICD186E   ;DLS/DEK- ICD Env. Check; 04/28/2003

 +1       ;;18.0;DRG Grouper;**6**;Oct 20, 2000

 +2       ;

 +3       ; External References

 +4       ;   DBIA  10141  $$PATCH^XPDUTL

 +5       ;   DBIA  10141  BMES^XPDUTL

 +6       ;   DBIA  10141  MES^XPDUTL

 +7       ;

ENVCHK    ; Check Environment for needed vars.

 +1        NEW PATCH,BUILD

 +2        SET XPDABORT=""

           SET PATCH="ICD*18.0*5"

           SET BUILD="ICD*18.0*6"

 +3        IF '$$PATCH^XPDUTL(PATCH)

               Begin DoDot:1

 +4                DO BM(PATCH_" is required and MUST be installed prior to this patch.")

                   DO ABRT

               End DoDot:1

               QUIT

 +5        IF +($$CPD)'>0

               IF +($GET(XPDENV))=0

                   Begin DoDot:1

 +6                    IF +($GET(^LEXM(0,"CHECKSUM")))'=70183825959

                           Begin DoDot:2

 +7                            DO BM("Global ^LEXM either not found or incomplete.")

                               DO ABRT

                           End DoDot:2

                   End DoDot:1

 +8        if +($GET(XPDABORT))'>0

               DO PROGCHK(.XPDABORT)

 +9        IF $GET(XPDABORT)=""

               KILL XPDABORT

               DO OK

 +10       QUIT

PROGCHK(XPDABORT) ; Check for Programmer

 +1        IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")

               Begin DoDot:1

 +2                DO BM("Programming variables are not set up properly.")

                   DO ABRT

               End DoDot:1

 +3        QUIT

ABRT      ; Abort - All or nothing

 +1        SET XPDABORT=1

           SET XPDQUIT=1

           SET XPDQUIT("LEX*2.0*25")=1

 +2        SET XPDQUIT("ICD*18.0*6")=1

           SET XPDQUIT("ICPT*6.0*14")=1

 +3        SET XPDQUIT("CSV UTIL 1.0")=1

 +4        QUIT

OK        ; Environment is Ok

 +1        if +($GET(XPDENV))>0

               QUIT

 +2        DO BM(("  Environment for patch/build "_BUILD_" is ok"))

           DO M(" ")

 +3        QUIT

 +4       ;

POST      ; Post-Install - Rebuild Indexes

 +1        NEW ZTRTN,ZTDESC,ZTSK,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ICD1,ICD2

           SET (ICD1,ICD2)=0

 +2        SET ZTRTN="ICDD^ICD186E"

           SET ZTDESC="Re-Index file #80"

 +3        SET ZTIO=""

           SET ZTDTH=$HOROLOG

           KILL ZTSK

           DO ^%ZTLOAD

           DO HOME^%ZIS

 +4        if +($GET(ZTSK))>0

               SET ICD1=+($GET(ZTSK))

 +5        SET ZTRTN="ICDP^ICD186E"

           SET ZTDESC="Re-Index file #80.1"

 +6        SET ZTIO=""

           SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

           DO HOME^%ZIS

 +7        if +($GET(ZTSK))>0

               SET ICD2=+($GET(ZTSK))

 +8        IF ICD1>0

               IF ICD2'>0

                   DO BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))

 +9        IF ICD1'>0

               IF ICD2>0

                   DO BM(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))

 +10       IF ICD1>0

               IF ICD2>0

                   Begin DoDot:1

 +11                   DO BM(("Task "_+ICD1_" to rebuild indexes for ICD Diagnosis file #80 started"))

 +12                   DO M(("Task "_+ICD2_" to rebuild indexes for ICD Procedure file #80.1 started"))

                   End DoDot:1

 +13       KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ICD1,ICD2

 +14       QUIT

ICDD      ;   ICD9( Diagnosis

 +1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        NEW DA,DIK

           SET U="^"

           SET DT=$$DT^XLFDT

           SET DIK="^ICD9("

           SET DA=0

 +3        FOR

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

               if +DA=0

                   QUIT

               KILL ^ICD9(DA,66,"B")

 +4        KILL ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT")

 +5        KILL ^ICD9("BA"),^ICD9("D")

 +6        DO IXALL^DIK

 +7        QUIT

ICDP      ;   ICD0( Procedure

 +1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        NEW DA,DIK

           SET U="^"

           SET DT=$$DT^XLFDT

           SET DIK="^ICD0("

           SET DA=0

 +3        FOR

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

               if +DA=0

                   QUIT

               KILL ^ICD0(DA,66,"B")

 +4        KILL ^ICD0("AB"),^ICD0("ACT"),^ICD0("BA"),^ICD0("D")

 +5        KILL ^ICD0("E")

           DO IXALL^DIK

 +6        QUIT

CPD(X)    ;   Check Current Patched Data is installed

 +1        if $DATA(^LEX(757.1,"B",180595,257762))&('$DATA(^LEX(757.02,"B",322162,3296)))

               QUIT 1

 +2        QUIT 0

 +3       ;

 +4       ; Miscellaneous

BM(X)     ;   Blank Line with Message

 +1        SET X=" "_$GET(X)

           if $DATA(XPDNM)

               DO BMES^XPDUTL($GET(X))

           if '$DATA(XPDNM)

               WRITE !!,$GET(X)

           QUIT

M(X)      ;   Message

 +1        SET X=" "_$GET(X)

           if $DATA(XPDNM)

               DO MES^XPDUTL($GET(X))

           if '$DATA(XPDNM)

               WRITE !,$GET(X)

           QUIT

ICD186E.m