ICPT619 ;SLC/KER - ICPT Env. Check ; 04/18/2004
;;6.0;CPT/HCPCS;**19**;May 19, 1997
;
; External References
; DBIA 10141 $$PATCH^XPDUTL
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
ENV ; Environment Check
N PATCHES,PATCH,BUILD,ABORT,I
W !," ICPT/HCPCS Code Text Descriptors (CTD)",! S XPDABORT="",BUILD="ICPT*6.0*19" S ABORT=0
S ABORT=$$PATCHES S:+ABORT'>0 ABORT=$$DATA(BUILD) S:+ABORT'>0 ABORT=$$VAR D:+ABORT>0 ABRT
I $G(XPDABORT)="" K XPDABORT D OK
Q
ABRT ; Abort - All or nothing
S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*30")=1
S XPDQUIT("ICD*18.0*12")=1,XPDQUIT("ICPT*6.0*19")=1
S XPDQUIT("CTD UTIL 1.0")=1
Q
OK ; Environment is Ok
Q:+($G(XPDENV))>0 D BM((" Environment for patch/build "_BUILD_" is ok")),M(" ")
Q
;
; Checks
PATCHES(X) ; Check Required Patches/Components
Q:+($G(ABORT))>0 1 N PATCHES,I,INS
S PATCHES="ICPT*6.0*16"
F I=1:1 Q:'$L($P($G(PATCHES),";",I)) S PATCH=$P($G(PATCHES),";",I) D Q:+($G(ABORT))>0
. W !," Checking for ",PATCH S INS=$$PATCH^XPDUTL(PATCH) I +INS>0 H 1 W " - installed"
. I 'INS D BM((" >>> "_PATCH_" is required and MUST be installed prior to this patch.")) W ! S ABORT=1
Q:+($G(ABORT))>0 1 Q 0
;
DATA(X) ; Check Required Data
Q:+($G(ABORT))>0 1 Q:+($G(XPDENV))=0 0 N BUILD,BUILDI,CPD S BUILDI=$G(^LEXM(81,0,"BUILD")),BUILD=$G(X),CPD=$$CPD
W !," Checking for ICD installed data" H:+CPD>0 1 W:+CPD>0 " - Installed"
I +CPD'>0 D
. I $L(BUILD),BUILD=BUILDI H 1 W " - Ready for installation"
. I $L(BUILD),BUILD'=BUILDI D
. . I '$L(BUILDI) D
. . . D BM(" >>> Global ^LEXM either not found or incomplete.")
. . . D M((" Expecting data for "_BUILD_"."))
. . I $L(BUILDI) D
. . . D BM(" >>> Global ^LEXM incorrect for this installation.")
. . . D M((" Expecting data for "_BUILD_", found "_BUILDI_"."))
. . W ! S ABORT=1
. I '$L(BUILD) H 1 W " - Data not required"
Q:+($G(ABORT))>0 1 Q 0
;
VAR(X) ; Check Variables
W !," Checking required environment variables"
D HOME^%ZIS S U="^",DT=$$DT^XLFDT Q:+($G(ABORT))>0 1
I (+($G(DUZ))>0)&($G(DUZ(0))="@") H 1 W " - ok"
I '$G(DUZ)!($G(DUZ(0))'="@") D
. D BM(" >>> Programming variables are not set up properly.") W ! S ABORT=1
Q:+($G(ABORT))>0 1 Q 0
;
CPD(X) ; Check Current Patched Data is installed
N INS S INS=1
S:'$D(^ICPT("AST"))!('$D(^ICPT("ADS")))!('$D(^DIC(81.3,"AST")))!('$D(^DIC(81.3,"ADS"))) INS=0
S:'$D(^ICPT(100,61,"B"))!('$D(^ICPT(100,62,"B"))) INS=0 S:'$D(^DIC(81.3,1,61,"B"))!('$D(^DIC(81.3,1,62,"B"))) INS=0
S X=INS Q X
;
; Miscellaneous
BM(X) ; Blank Line with Message
D BMES^XPDUTL($G(X)) Q
M(X) ; Message
D MES^XPDUTL($G(X)) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPT619 2790 printed Apr 09, 2024@20:50:57 Page 2
ICPT619 ;SLC/KER - ICPT Env. Check ; 04/18/2004
+1 ;;6.0;CPT/HCPCS;**19**;May 19, 1997
+2 ;
+3 ; External References
+4 ; DBIA 10141 $$PATCH^XPDUTL
+5 ; DBIA 10141 BMES^XPDUTL
+6 ; DBIA 10141 MES^XPDUTL
+7 ;
ENV ; Environment Check
+1 NEW PATCHES,PATCH,BUILD,ABORT,I
+2 WRITE !," ICPT/HCPCS Code Text Descriptors (CTD)",!
SET XPDABORT=""
SET BUILD="ICPT*6.0*19"
SET ABORT=0
+3 SET ABORT=$$PATCHES
if +ABORT'>0
SET ABORT=$$DATA(BUILD)
if +ABORT'>0
SET ABORT=$$VAR
if +ABORT>0
DO ABRT
+4 IF $GET(XPDABORT)=""
KILL XPDABORT
DO OK
+5 QUIT
ABRT ; Abort - All or nothing
+1 SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("LEX*2.0*30")=1
+2 SET XPDQUIT("ICD*18.0*12")=1
SET XPDQUIT("ICPT*6.0*19")=1
+3 SET XPDQUIT("CTD UTIL 1.0")=1
+4 QUIT
OK ; Environment is Ok
+1 if +($GET(XPDENV))>0
QUIT
DO BM((" Environment for patch/build "_BUILD_" is ok"))
DO M(" ")
+2 QUIT
+3 ;
+4 ; Checks
PATCHES(X) ; Check Required Patches/Components
+1 if +($GET(ABORT))>0
QUIT 1
NEW PATCHES,I,INS
+2 SET PATCHES="ICPT*6.0*16"
+3 FOR I=1:1
if '$LENGTH($PIECE($GET(PATCHES),";",I))
QUIT
SET PATCH=$PIECE($GET(PATCHES),";",I)
Begin DoDot:1
+4 WRITE !," Checking for ",PATCH
SET INS=$$PATCH^XPDUTL(PATCH)
IF +INS>0
HANG 1
WRITE " - installed"
+5 IF 'INS
DO BM((" >>> "_PATCH_" is required and MUST be installed prior to this patch."))
WRITE !
SET ABORT=1
End DoDot:1
if +($GET(ABORT))>0
QUIT
+6 if +($GET(ABORT))>0
QUIT 1
QUIT 0
+7 ;
DATA(X) ; Check Required Data
+1 if +($GET(ABORT))>0
QUIT 1
if +($GET(XPDENV))=0
QUIT 0
NEW BUILD,BUILDI,CPD
SET BUILDI=$GET(^LEXM(81,0,"BUILD"))
SET BUILD=$GET(X)
SET CPD=$$CPD
+2 WRITE !," Checking for ICD installed data"
if +CPD>0
HANG 1
if +CPD>0
WRITE " - Installed"
+3 IF +CPD'>0
Begin DoDot:1
+4 IF $LENGTH(BUILD)
IF BUILD=BUILDI
HANG 1
WRITE " - Ready for installation"
+5 IF $LENGTH(BUILD)
IF BUILD'=BUILDI
Begin DoDot:2
+6 IF '$LENGTH(BUILDI)
Begin DoDot:3
+7 DO BM(" >>> Global ^LEXM either not found or incomplete.")
+8 DO M((" Expecting data for "_BUILD_"."))
End DoDot:3
+9 IF $LENGTH(BUILDI)
Begin DoDot:3
+10 DO BM(" >>> Global ^LEXM incorrect for this installation.")
+11 DO M((" Expecting data for "_BUILD_", found "_BUILDI_"."))
End DoDot:3
+12 WRITE !
SET ABORT=1
End DoDot:2
+13 IF '$LENGTH(BUILD)
HANG 1
WRITE " - Data not required"
End DoDot:1
+14 if +($GET(ABORT))>0
QUIT 1
QUIT 0
+15 ;
VAR(X) ; Check Variables
+1 WRITE !," Checking required environment variables"
+2 DO HOME^%ZIS
SET U="^"
SET DT=$$DT^XLFDT
if +($GET(ABORT))>0
QUIT 1
+3 IF (+($GET(DUZ))>0)&($GET(DUZ(0))="@")
HANG 1
WRITE " - ok"
+4 IF '$GET(DUZ)!($GET(DUZ(0))'="@")
Begin DoDot:1
+5 DO BM(" >>> Programming variables are not set up properly.")
WRITE !
SET ABORT=1
End DoDot:1
+6 if +($GET(ABORT))>0
QUIT 1
QUIT 0
+7 ;
CPD(X) ; Check Current Patched Data is installed
+1 NEW INS
SET INS=1
+2 if '$DATA(^ICPT("AST"))!('$DATA(^ICPT("ADS")))!('$DATA(^DIC(81.3,"AST")))!('$DATA(^DIC(81.3,"ADS")))
SET INS=0
+3 if '$DATA(^ICPT(100,61,"B"))!('$DATA(^ICPT(100,62,"B")))
SET INS=0
if '$DATA(^DIC(81.3,1,61,"B"))!('$DATA(^DIC(81.3,1,62,"B")))
SET INS=0
+4 SET X=INS
QUIT X
+5 ;
+6 ; Miscellaneous
BM(X) ; Blank Line with Message
+1 DO BMES^XPDUTL($GET(X))
QUIT
M(X) ; Message
+1 DO MES^XPDUTL($GET(X))
QUIT
