LEX2055P ;ISL/KER - LEX*2.0*55 Pre/Post Install ;11/30/2008
;;2.0;LEXICON UTILITY;**55**;Sep 23, 1996;Build 11
;
; Integration Control Registrations/Standards and Conventions
;
; ^LEX(757 N/A Major Concept Map
; ^LEX(757.001) N/A Concept Usage
; ^LEX(757.01 N/A Expressions
; ^LEX(757.02) N/A Codes
; ^LEX(757.03) N/A Coding System
; ^LEX(757.1) N/A Semantic Map
; ^LEX(757.11) N/A Semantic Class
; ^LEX(757.12) N/A Semantic Type
; ^LEX(757.13) N/A Source Categories
; ^LEX(757.14) N/A Source
; ^LEXT(757.2) N/A Subset Definition
;
; ^TMP( SACC 2.3.2.5.1
; ^%ZOSF("TEST") ICR 10096
; ^%ZOSF("DEL") ICR 10096
; ^DIK ICR 10013
; IX1^DIK ICR 10013
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; $$DTIME^XUP ICR 4490
; MES^XPDUTL ICR 10141
; HOME^%ZIS ICR 10086
;
; Local Variables NEWed or KILLed Elsewhere
; DT,DTIME,DUZ,U,XPDABORT,XPDQUIT
;
ENV ; Environment Check
N LEXREQP,LEXPAT,LEXI,LEXPN,LEXBUILD S LEXPAT="LEX*2.0*56",LEXBUILD="LEX*2.0*55"
S LEXPN=$$PATCH^XPDUTL(LEXPAT) W !," Checking for ",LEXPAT I +LEXPN>0 H 1 W " - installed"
I +LEXPN'>0 D ET(" "),ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
I $D(LEXE) D ABRT Q
Q
POK(X) ; Patch is OK
N LEXPAT S LEXPAT=$G(X) Q:'$L(LEXPAT) 1
S X=+($$PATCH^XPDUTL(LEXPAT))
Q X
ET(X) ; Error Text
N LEXI S LEXI=+($G(LEXE(0))),LEXI=LEXI+1,LEXE(LEXI)=" "_$G(X),LEXE(0)=LEXI
Q
ED ; Error Display
N LEXI S LEXI=0 F S LEXI=$O(LEXE(LEXI)) Q:+LEXI=0 D MES^XPDUTL(LEXE(LEXI))
D MES^XPDUTL(" ") K LEXE
Q
QUIT ; Quit Passed Environment Check
K LEXFULL D OK
Q
EXIT ; Exit Failed Environment Check
D:$D(LEXE) ED S XPDQUIT=2 K LEXE,LEXFULL Q
ABRT ; Abort Failed Environment Check, KILL the distribution
D:$D(LEXE) ED S XPDABORT=1,XPDQUIT=1,XPDQUIT("LEX*2.0*55")=1
K LEXE,LEXFULL
Q
OK ; Environment is OK
N LEXT S LEXT=" Environment "_$S($L(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
D BMES^XPDUTL(LEXT),MES^XPDUTL(" ")
Q
POST ; LEX*2.0*55 Post-Install
N ENV,EXC,LEXBEG,LEXBLD,LEXBUILD,LEXELP,LEXEND,LEXFC,LEXI,LEXID,LEXMOD,LEXMUL,LEXNM,LEXPOST,LEXRTN
N LEXSHORT,LEXSUB,LEXT,LEXTCS,LEXTND,X,ZTQUEUED,ZTREQ
S ENV=$$SET Q:'ENV S LEXBEG=$$NOW^XLFDT
K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J),^TMP("LEXINS",$J),^TMP("LEXKID",$J)
D INST I $D(^%ZOSF("DEL")) F LEXRTN="LEX2055A","LEX2055B","LEX2055C","LEX2055D","LEX2055E","LEX2055F","LEX2055G","LEX2055H","LEX2055I" D
. N EXC,X,Y I +($$ROK(LEXRTN))>0 S (EXC,X)=$G(^%ZOSF("DEL")) D ^DIM I $D(X) S X=LEXRTN X EXC
S LEXSHORT=1,(LEXID,LEXSUB)="LEXKID",(LEXBUILD,LEXBLD)="LEX*2.0*55",LEXPOST=1
S LEXEND=$$NOW^XLFDT,LEXELP=$$EP^LEXXII(LEXBEG,LEXEND)
D MSG
Q
MSG ; Send a Install Message
S:$D(ZTQUEUED) ZTREQ="@" N LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,ZTQUEUED,LEXT,LEXI S LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC,ZTQUEUED)=0
D HDR^LEXXFI,EN^LEXXII I $L($G(LEXID)) S LEXI=0 F S LEXI=$O(^TMP(LEXID,$J,LEXI)) Q:+LEXI'>0 D
. S:$G(^TMP(LEXID,$J,LEXI))=" Lexicon/ICD/CPT Installation" ^TMP(LEXID,$J,LEXI)=" BI-RADS Mammography Assessment Code Set",^TMP(LEXID,$J,(LEXI+1))=" ======================================="
I $G(LEXBEG)?7N1".".N S LEXT="" S LEXT=" Started: "_$TR($$FMTE^XLFDT($G(LEXBEG),"1Z"),"@"," ") D TL^LEXXII(LEXT)
I $G(LEXEND)?7N1".".N S LEXT="" S LEXT=" Finished: "_$TR($$FMTE^XLFDT($G(LEXEND),"1Z"),"@"," ") D TL^LEXXII(LEXT)
I $G(LEXBEG)?7N1".".N!$G(LEXEND)?7N1".".N!($L($G(LEXELP))&($G(LEXELP)[":")) S LEXT="" S LEXT=" Elapsed: "_$$ED^LEXXII($G(LEXELP)) D TL^LEXXII(LEXT),BL^LEXXII
D MAIL^LEXXFI,KILL^LEXXFI
Q
INST ; Install Patch LEX*2.0*55
D:+($$ROK("LEX2055A"))>0 INST^LEX2055A D CON
Q
ROK(X) ; Routine OK
S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1
Q 0
CON ; Data Convversion
N LEX55W S LEX55W="BARRES~" F S LEX55W=$O(^LEX(757.01,"AWRD",LEX55W)) Q:'$L(LEX55W) Q:LEX55W'["BARRET" D
. N LEX55C S LEX55C=0 F S LEX55C=$O(^LEX(757.01,"AWRD",LEX55W,LEX55C)) Q:+LEX55C'>0 D
. . N LEX55E S LEX55E=0 F S LEX55E=$O(^LEX(757.01,"AWRD",LEX55W,LEX55C,LEX55E)) Q:+LEX55E'>0 D
. . . N DA,DIK S DA=LEX55E,DIK="^LEX(757.01," D IX1^DIK
Q
SET(X) ; Setup Environment
D HOME^%ZIS S U="^",DT=$$DT^XLFDT,LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01),DTIME=$$DTIME^XUP(+($G(DUZ))) Q:+($G(DUZ))'>0!('$L(LEXNM)) 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2055P 4798 printed Apr 09, 2024@21:10:16 Page 2
LEX2055P ;ISL/KER - LEX*2.0*55 Pre/Post Install ;11/30/2008
+1 ;;2.0;LEXICON UTILITY;**55**;Sep 23, 1996;Build 11
+2 ;
+3 ; Integration Control Registrations/Standards and Conventions
+4 ;
+5 ; ^LEX(757 N/A Major Concept Map
+6 ; ^LEX(757.001) N/A Concept Usage
+7 ; ^LEX(757.01 N/A Expressions
+8 ; ^LEX(757.02) N/A Codes
+9 ; ^LEX(757.03) N/A Coding System
+10 ; ^LEX(757.1) N/A Semantic Map
+11 ; ^LEX(757.11) N/A Semantic Class
+12 ; ^LEX(757.12) N/A Semantic Type
+13 ; ^LEX(757.13) N/A Source Categories
+14 ; ^LEX(757.14) N/A Source
+15 ; ^LEXT(757.2) N/A Subset Definition
+16 ;
+17 ; ^TMP( SACC 2.3.2.5.1
+18 ; ^%ZOSF("TEST") ICR 10096
+19 ; ^%ZOSF("DEL") ICR 10096
+20 ; ^DIK ICR 10013
+21 ; IX1^DIK ICR 10013
+22 ; $$GET1^DIQ ICR 2056
+23 ; $$DT^XLFDT ICR 10103
+24 ; $$NOW^XLFDT ICR 10103
+25 ; $$FMTE^XLFDT ICR 10103
+26 ; $$DTIME^XUP ICR 4490
+27 ; MES^XPDUTL ICR 10141
+28 ; HOME^%ZIS ICR 10086
+29 ;
+30 ; Local Variables NEWed or KILLed Elsewhere
+31 ; DT,DTIME,DUZ,U,XPDABORT,XPDQUIT
+32 ;
ENV ; Environment Check
+1 NEW LEXREQP,LEXPAT,LEXI,LEXPN,LEXBUILD
SET LEXPAT="LEX*2.0*56"
SET LEXBUILD="LEX*2.0*55"
+2 SET LEXPN=$$PATCH^XPDUTL(LEXPAT)
WRITE !," Checking for ",LEXPAT
IF +LEXPN>0
HANG 1
WRITE " - installed"
+3 IF +LEXPN'>0
DO ET(" ")
DO ET((LEXPAT_" not found, please install "_LEXPAT_" before continuing"))
+4 IF $DATA(LEXE)
DO ABRT
QUIT
+5 QUIT
POK(X) ; Patch is OK
+1 NEW LEXPAT
SET LEXPAT=$GET(X)
if '$LENGTH(LEXPAT)
QUIT 1
+2 SET X=+($$PATCH^XPDUTL(LEXPAT))
+3 QUIT X
ET(X) ; Error Text
+1 NEW LEXI
SET LEXI=+($GET(LEXE(0)))
SET LEXI=LEXI+1
SET LEXE(LEXI)=" "_$GET(X)
SET LEXE(0)=LEXI
+2 QUIT
ED ; Error Display
+1 NEW LEXI
SET LEXI=0
FOR
SET LEXI=$ORDER(LEXE(LEXI))
if +LEXI=0
QUIT
DO MES^XPDUTL(LEXE(LEXI))
+2 DO MES^XPDUTL(" ")
KILL LEXE
+3 QUIT
QUIT ; Quit Passed Environment Check
+1 KILL LEXFULL
DO OK
+2 QUIT
EXIT ; Exit Failed Environment Check
+1 if $DATA(LEXE)
DO ED
SET XPDQUIT=2
KILL LEXE,LEXFULL
QUIT
ABRT ; Abort Failed Environment Check, KILL the distribution
+1 if $DATA(LEXE)
DO ED
SET XPDABORT=1
SET XPDQUIT=1
SET XPDQUIT("LEX*2.0*55")=1
+2 KILL LEXE,LEXFULL
+3 QUIT
OK ; Environment is OK
+1 NEW LEXT
SET LEXT=" Environment "_$SELECT($LENGTH(LEXBUILD):("for patch/build "_LEXBUILD_" "),1:"")_"is ok"
+2 DO BMES^XPDUTL(LEXT)
DO MES^XPDUTL(" ")
+3 QUIT
POST ; LEX*2.0*55 Post-Install
+1 NEW ENV,EXC,LEXBEG,LEXBLD,LEXBUILD,LEXELP,LEXEND,LEXFC,LEXI,LEXID,LEXMOD,LEXMUL,LEXNM,LEXPOST,LEXRTN
+2 NEW LEXSHORT,LEXSUB,LEXT,LEXTCS,LEXTND,X,ZTQUEUED,ZTREQ
+3 SET ENV=$$SET
if 'ENV
QUIT
SET LEXBEG=$$NOW^XLFDT
+4 KILL ^TMP("LEXCS",$JOB),^TMP("LEXCNT",$JOB),^TMP("LEXI",$JOB),^TMP("LEXMSG",$JOB),^TMP("LEXINS",$JOB),^TMP("LEXKID",$JOB)
+5 DO INST
IF $DATA(^%ZOSF("DEL"))
FOR LEXRTN="LEX2055A","LEX2055B","LEX2055C","LEX2055D","LEX2055E","LEX2055F","LEX2055G","LEX2055H","LEX2055I"
Begin DoDot:1
+6 NEW EXC,X,Y
IF +($$ROK(LEXRTN))>0
SET (EXC,X)=$GET(^%ZOSF("DEL"))
DO ^DIM
IF $DATA(X)
SET X=LEXRTN
XECUTE EXC
End DoDot:1
+7 SET LEXSHORT=1
SET (LEXID,LEXSUB)="LEXKID"
SET (LEXBUILD,LEXBLD)="LEX*2.0*55"
SET LEXPOST=1
+8 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$EP^LEXXII(LEXBEG,LEXEND)
+9 DO MSG
+10 QUIT
MSG ; Send a Install Message
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
NEW LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,ZTQUEUED,LEXT,LEXI
SET LEXMUL=1
SET (LEXTND,LEXTCS,LEXMOD,LEXFC,ZTQUEUED)=0
+2 DO HDR^LEXXFI
DO EN^LEXXII
IF $LENGTH($GET(LEXID))
SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP(LEXID,$JOB,LEXI))
if +LEXI'>0
QUIT
Begin DoDot:1
+3 if $GET(^TMP(LEXID,$JOB,LEXI))=" Lexicon/ICD/CPT Installation"
SET ^TMP(LEXID,$JOB,LEXI)=" BI-RADS Mammography Assessment Code Set"
SET ^TMP(LEXID,$JOB,(LEXI+1))=" ======================================="
End DoDot:1
+4 IF $GET(LEXBEG)?7N1".".N
SET LEXT=""
SET LEXT=" Started: "_$TRANSLATE($$FMTE^XLFDT($GET(LEXBEG),"1Z"),"@"," ")
DO TL^LEXXII(LEXT)
+5 IF $GET(LEXEND)?7N1".".N
SET LEXT=""
SET LEXT=" Finished: "_$TRANSLATE($$FMTE^XLFDT($GET(LEXEND),"1Z"),"@"," ")
DO TL^LEXXII(LEXT)
+6 IF $GET(LEXBEG)?7N1".".N!$GET(LEXEND)?7N1".".N!($LENGTH($GET(LEXELP))&($GET(LEXELP)[":"))
SET LEXT=""
SET LEXT=" Elapsed: "_$$ED^LEXXII($GET(LEXELP))
DO TL^LEXXII(LEXT)
DO BL^LEXXII
+7 DO MAIL^LEXXFI
DO KILL^LEXXFI
+8 QUIT
INST ; Install Patch LEX*2.0*55
+1 if +($$ROK("LEX2055A"))>0
DO INST^LEX2055A
DO CON
+2 QUIT
ROK(X) ; Routine OK
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT 0
if $LENGTH(X)>8
QUIT 0
XECUTE ^%ZOSF("TEST")
if $TEST
QUIT 1
+2 QUIT 0
CON ; Data Convversion
+1 NEW LEX55W
SET LEX55W="BARRES~"
FOR
SET LEX55W=$ORDER(^LEX(757.01,"AWRD",LEX55W))
if '$LENGTH(LEX55W)
QUIT
if LEX55W'["BARRET"
QUIT
Begin DoDot:1
+2 NEW LEX55C
SET LEX55C=0
FOR
SET LEX55C=$ORDER(^LEX(757.01,"AWRD",LEX55W,LEX55C))
if +LEX55C'>0
QUIT
Begin DoDot:2
+3 NEW LEX55E
SET LEX55E=0
FOR
SET LEX55E=$ORDER(^LEX(757.01,"AWRD",LEX55W,LEX55C,LEX55E))
if +LEX55E'>0
QUIT
Begin DoDot:3
+4 NEW DA,DIK
SET DA=LEX55E
SET DIK="^LEX(757.01,"
DO IX1^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+5 QUIT
SET(X) ; Setup Environment
+1 DO HOME^%ZIS
SET U="^"
SET DT=$$DT^XLFDT
SET LEXNM=$$GET1^DIQ(200,+($GET(DUZ)),.01)
SET DTIME=$$DTIME^XUP(+($GET(DUZ)))
if +($GET(DUZ))'>0!('$LENGTH(LEXNM))
QUIT 0
+2 QUIT 1
