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
Q
;
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
Q
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
Q
OK ; Environment is Ok
Q:+($G(XPDENV))>0
D BM((" Environment for patch/build "_BUILD_" is ok")),M(" ")
Q
;
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
Q
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
Q
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
Q
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 Nov 22, 2024@16:55:40 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
