Routine: ICPT614E

ICPT614E ;DLS/DEK- ICPT Env. Check; 04/28/2003

 ;;6.0;CPT/HCPCS;**14**;May 19, 1997

 ; 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="ICPT*6.0*13",BUILD="ICPT*6.0*14"

 F PATCH="ICPT*6.0*12","ICPT*6.0*13" D  Q:+($G(XPDABORT))>0

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

 . . 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

 Q:+($G(XPDABORT))>0  D 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,CPT1,CPT2 S (CPT1,CPT2)=0

 S ZTRTN="CPTP^ICPT614E",ZTDESC="Re-Index file #81"

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

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

 S ZTRTN="CPTM^ICPT614E",ZTDESC="Re-Index file #81.3"

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

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

 I CPT1>0,CPT2'>0 D BM(("Task "_+CPT1_" to rebuild indexes for CPT Procedures file #81 started"))

 I CPT1'>0,CPT2>0 D BM(("Task "_+CPT2_" to rebuild indexes for CPT Modifier file #81.3 started"))

 I CPT1>0,CPT2>0 D

 . D BM(("Task "_+CPT1_" to rebuild indexes for CPT Procedures file #81 started"))

 . D M(("Task "_+CPT2_" to rebuild indexes for CPT Modifier file #81.3 started"))

 K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,CPT1,CPT2

CPTP ;   ICPT( Procedures

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

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

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

 K ^ICPT("ACT"),^ICPT("B"),^ICPT("BA"),^ICPT("C")

 K ^ICPT("D"),^ICPT("E"),^ICPT("F") D IXALL^DIK

CPTM ;   DIC(81.3, Modifiers

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

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

 F  S DA=$O(^DIC(81.3,DA)) Q:+DA=0  D

 . K ^DIC(81.3,DA,60,"B"),^DIC(81.3,DA,"M")

 K ^DIC(81.3,"ACT"),^DIC(81.3,"B"),^DIC(81.3,"BA")

 K ^DIC(81.3,"C"),^DIC(81.3,"D") 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) Q:$D(GMTSQT)  D:$D(XPDNM) BMES^XPDUTL($G(X)) W:'$D(XPDNM) !!,$G(X) Q

M(X) ;   Message

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPT614E   2988     printed  Mar 13, 2025@20:50:08                                                                                                                                                                                                    Page 2

ICPT614E  ;DLS/DEK- ICPT Env. Check; 04/28/2003

 +1       ;;6.0;CPT/HCPCS;**14**;May 19, 1997

 +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="ICPT*6.0*13"

           SET BUILD="ICPT*6.0*14"

 +3        FOR PATCH="ICPT*6.0*12","ICPT*6.0*13"

               Begin DoDot:1

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

                       Begin DoDot:2

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

                           DO ABRT

                       End DoDot:2

               End DoDot:1

               if +($GET(XPDABORT))>0

                   QUIT

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

               IF +($GET(XPDENV))=0

                   Begin DoDot:1

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

                           Begin DoDot:2

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

                               DO ABRT

                           End DoDot:2

                   End DoDot:1

 +9        if +($GET(XPDABORT))>0

               QUIT

           DO PROGCHK(.XPDABORT)

 +10       IF $GET(XPDABORT)=""

               KILL XPDABORT

               DO OK

 +11       QUIT

 +12      ;

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,CPT1,CPT2

           SET (CPT1,CPT2)=0

 +2        SET ZTRTN="CPTP^ICPT614E"

           SET ZTDESC="Re-Index file #81"

 +3        SET ZTIO=""

           SET ZTDTH=$HOROLOG

           KILL ZTSK

           DO ^%ZTLOAD

           DO HOME^%ZIS

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

               SET CPT1=+($GET(ZTSK))

 +5        SET ZTRTN="CPTM^ICPT614E"

           SET ZTDESC="Re-Index file #81.3"

 +6        SET ZTIO=""

           SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

           DO HOME^%ZIS

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

               SET CPT2=+($GET(ZTSK))

 +8        IF CPT1>0

               IF CPT2'>0

                   DO BM(("Task "_+CPT1_" to rebuild indexes for CPT Procedures file #81 started"))

 +9        IF CPT1'>0

               IF CPT2>0

                   DO BM(("Task "_+CPT2_" to rebuild indexes for CPT Modifier file #81.3 started"))

 +10       IF CPT1>0

               IF CPT2>0

                   Begin DoDot:1

 +11                   DO BM(("Task "_+CPT1_" to rebuild indexes for CPT Procedures file #81 started"))

 +12                   DO M(("Task "_+CPT2_" to rebuild indexes for CPT Modifier file #81.3 started"))

                   End DoDot:1

 +13       KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,CPT1,CPT2

 +14       QUIT

CPTP      ;   ICPT( Procedures

 +1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        NEW DA,DIK

           SET U="^"

           SET DT=$$DT^XLFDT

           SET DIK="^ICPT("

           SET DA=0

 +3        FOR

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

               if +DA=0

                   QUIT

               KILL ^ICPT(DA,60,"B")

 +4        KILL ^ICPT("ACT"),^ICPT("B"),^ICPT("BA"),^ICPT("C")

 +5        KILL ^ICPT("D"),^ICPT("E"),^ICPT("F")

           DO IXALL^DIK

 +6        QUIT

CPTM      ;   DIC(81.3, Modifiers

 +1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        NEW DA,DIK

           SET U="^"

           SET DT=$$DT^XLFDT

           SET DIK="^DIC(81.3,"

           SET DA=0

 +3        FOR

               SET DA=$ORDER(^DIC(81.3,DA))

               if +DA=0

                   QUIT

               Begin DoDot:1

 +4                KILL ^DIC(81.3,DA,60,"B"),^DIC(81.3,DA,"M")

               End DoDot:1

 +5        KILL ^DIC(81.3,"ACT"),^DIC(81.3,"B"),^DIC(81.3,"BA")

 +6        KILL ^DIC(81.3,"C"),^DIC(81.3,"D")

           DO IXALL^DIK

 +7        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(GMTSQT)

               QUIT

           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(GMTSQT)

               QUIT

           if $DATA(XPDNM)

               DO MES^XPDUTL($GET(X))

           if '$DATA(XPDNM)

               WRITE !,$GET(X)

           QUIT

ICPT614E.m