LEX2052P ;ISL/KER - LEX*2.0*52 Pre/Post Install ;08/18/2007
;;2.0;LEXICON UTILITY;**52**;Sep 23, 1996;Build 25
;
; Global Variables
; ^%ZOSF("DEL" DBIA 10096
; ^%ZOSF("TEST" DBIA 10096
; ^TMP("LEXCNT" SACC 2.3.2.5.1
; ^TMP("LEXCS" SACC 2.3.2.5.1
; ^TMP("LEXI" SACC 2.3.2.5.1
; ^TMP("LEXINS" SACC 2.3.2.5.1
; ^TMP("LEXKID" SACC 2.3.2.5.1
; ^TMP("LEXMSG" SACC 2.3.2.5.1
;
; External References
; HOME^%ZIS DBIA 10086
; ^DIM DBIA 10016
; $$GET1^DIQ DBIA 2056
; $$DT^XLFDT DBIA 10103
; $$FMTE^XLFDT DBIA 10103
; $$NOW^XLFDT DBIA 10103
; $$DTIME^XUP DBIA 4490
;
Q
POST ; LEX*2.0*52 Post-Install
N ENV,LEXBEG,LEXEND,LEXELP,LEXRTN,ZTREQ,X,Y S ENV=$$ENV 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)
N LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS,LEXSHORT,LEXPOST,LEXBLDS,LEXBUILD,LEXBLD,LEXID,LEXSUB,X D EN^LEX2052A,EN^LEX2052E,EN^LEX2052F,EN^LEX2052G
I $D(^%ZOSF("DEL")) F LEXRTN="LEX2052A","LEX2052B","LEX2052C","LEX2052D","LEX2052E","LEX2052F","LEX2052G","LEX2052H" 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*52",LEXPOST=1
S LEXEND=$$NOW^XLFDT,LEXELP=$$EP^LEXXII(LEXBEG,LEXEND)
D MSG,RX
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)=" CPT Modifier 51 Update",^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
RX ; Re-Index
N Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTREQ,ZTQUEUED
S ZTRTN="RXT^LEX2052P",ZTDESC="Re-Index CPT Modifier file 81.3",ZTIO="",ZTDTH=$H D ^%ZTLOAD
D:+($G(ZTSK))>0 BMES^XPDUTL((" Re-Indexing CPT Modified file 81.3 (Task #"_+($G(ZTSK))_")"))
D HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
Q
RXT ; Re-Index (tasked)
S:$D(ZTQUEUED) ZTREQ="@" N MIEN,DA,DIK S MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
. K ^DIC(81.3,MIEN,10,"B"),^DIC(81.3,MIEN,"M")
. N RIEN S RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
. . N DA,DIK S DA(1)=MIEN,DA=RIEN,DIK="^DIC(81.3,"_DA(1)_",10," D IX1^DIK
. K DA S DA=MIEN,DIK="^DIC(81.3," D IX1^DIK
F DA=3,11,46,47 S DIK="^DIC(81.3," D IX1^DIK
F DA=643,644,645,646,647 S DIK="^DIC(81.3," D IX1^DIK
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
ENV(X) ; Environment check
N LEXNM 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[HLEX2052P 3405 printed Dec 13, 2024@02:04:22 Page 2
LEX2052P ;ISL/KER - LEX*2.0*52 Pre/Post Install ;08/18/2007
+1 ;;2.0;LEXICON UTILITY;**52**;Sep 23, 1996;Build 25
+2 ;
+3 ; Global Variables
+4 ; ^%ZOSF("DEL" DBIA 10096
+5 ; ^%ZOSF("TEST" DBIA 10096
+6 ; ^TMP("LEXCNT" SACC 2.3.2.5.1
+7 ; ^TMP("LEXCS" SACC 2.3.2.5.1
+8 ; ^TMP("LEXI" SACC 2.3.2.5.1
+9 ; ^TMP("LEXINS" SACC 2.3.2.5.1
+10 ; ^TMP("LEXKID" SACC 2.3.2.5.1
+11 ; ^TMP("LEXMSG" SACC 2.3.2.5.1
+12 ;
+13 ; External References
+14 ; HOME^%ZIS DBIA 10086
+15 ; ^DIM DBIA 10016
+16 ; $$GET1^DIQ DBIA 2056
+17 ; $$DT^XLFDT DBIA 10103
+18 ; $$FMTE^XLFDT DBIA 10103
+19 ; $$NOW^XLFDT DBIA 10103
+20 ; $$DTIME^XUP DBIA 4490
+21 ;
+22 QUIT
POST ; LEX*2.0*52 Post-Install
+1 NEW ENV,LEXBEG,LEXEND,LEXELP,LEXRTN,ZTREQ,X,Y
SET ENV=$$ENV
if 'ENV
QUIT
SET LEXBEG=$$NOW^XLFDT
+2 KILL ^TMP("LEXCS",$JOB),^TMP("LEXCNT",$JOB),^TMP("LEXI",$JOB),^TMP("LEXMSG",$JOB),^TMP("LEXINS",$JOB),^TMP("LEXKID",$JOB)
+3 NEW LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS,LEXSHORT,LEXPOST,LEXBLDS,LEXBUILD,LEXBLD,LEXID,LEXSUB,X
DO EN^LEX2052A
DO EN^LEX2052E
DO EN^LEX2052F
DO EN^LEX2052G
+4 IF $DATA(^%ZOSF("DEL"))
FOR LEXRTN="LEX2052A","LEX2052B","LEX2052C","LEX2052D","LEX2052E","LEX2052F","LEX2052G","LEX2052H"
Begin DoDot:1
+5 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
+6 SET LEXSHORT=1
SET (LEXID,LEXSUB)="LEXKID"
SET (LEXBUILD,LEXBLD)="LEX*2.0*52"
SET LEXPOST=1
+7 SET LEXEND=$$NOW^XLFDT
SET LEXELP=$$EP^LEXXII(LEXBEG,LEXEND)
+8 DO MSG
DO RX
+9 QUIT
MSG ; Send a Install Message
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,ZTQUEUED,LEXT,LEXI
+3 SET LEXMUL=1
SET (LEXTND,LEXTCS,LEXMOD,LEXFC,ZTQUEUED)=0
+4 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
+5 if $GET(^TMP(LEXID,$JOB,LEXI))=" Lexicon/ICD/CPT Installation"
SET ^TMP(LEXID,$JOB,LEXI)=" CPT Modifier 51 Update"
SET ^TMP(LEXID,$JOB,(LEXI+1))=" ======================"
End DoDot:1
+6 IF $GET(LEXBEG)?7N1".".N
SET LEXT=""
SET LEXT=" Started: "_$TRANSLATE($$FMTE^XLFDT($GET(LEXBEG),"1Z"),"@"," ")
DO TL^LEXXII(LEXT)
+7 IF $GET(LEXEND)?7N1".".N
SET LEXT=""
SET LEXT=" Finished: "_$TRANSLATE($$FMTE^XLFDT($GET(LEXEND),"1Z"),"@"," ")
DO TL^LEXXII(LEXT)
+8 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
+9 DO MAIL^LEXXFI
DO KILL^LEXXFI
+10 QUIT
RX ; Re-Index
+1 NEW Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTREQ,ZTQUEUED
+2 SET ZTRTN="RXT^LEX2052P"
SET ZTDESC="Re-Index CPT Modifier file 81.3"
SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+3 if +($GET(ZTSK))>0
DO BMES^XPDUTL((" Re-Indexing CPT Modified file 81.3 (Task #"_+($GET(ZTSK))_")"))
+4 DO HOME^%ZIS
KILL Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
+5 QUIT
RXT ; Re-Index (tasked)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
NEW MIEN,DA,DIK
SET MIEN=0
FOR
SET MIEN=$ORDER(^DIC(81.3,MIEN))
if +MIEN'>0
QUIT
Begin DoDot:1
+2 KILL ^DIC(81.3,MIEN,10,"B"),^DIC(81.3,MIEN,"M")
+3 NEW RIEN
SET RIEN=0
FOR
SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
if +RIEN'>0
QUIT
Begin DoDot:2
+4 NEW DA,DIK
SET DA(1)=MIEN
SET DA=RIEN
SET DIK="^DIC(81.3,"_DA(1)_",10,"
DO IX1^DIK
End DoDot:2
+5 KILL DA
SET DA=MIEN
SET DIK="^DIC(81.3,"
DO IX1^DIK
End DoDot:1
+6 FOR DA=3,11,46,47
SET DIK="^DIC(81.3,"
DO IX1^DIK
+7 FOR DA=643,644,645,646,647
SET DIK="^DIC(81.3,"
DO IX1^DIK
+8 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
ENV(X) ; Environment check
+1 NEW LEXNM
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
