LEX2053P ;ISL/KER - LEX*2.0*53 Pre/Post Install ;06/06/2007
;;2.0;LEXICON UTILITY;**53**;Sep 23, 1996;Build 18
;
; Variables NEWed or KILLed Elsewhere
; None
;
; Global Variables
; ^LEXM
;
; External References
; None
;
Q
POST ; LEX*2.0*53 Post-Install
;
; From IMP^LEX2053
;
; LEXBUILD Build Name - LEX*2.0*nn
; LEXPTYPE Patch Type - Remedy or Quarterly
; LEXFY Fiscal Year - FYnn
; LEXQTR Quarter - 1st, 2nd, 3rd, or 4th
; LEXIGHF Name of Host File - LEX_2_nn.GBL
; LEXLREV Revision - nn
; LEXREQP Required Builds - build;build;build
;
N LEXEDT,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXRTN,LEXSTR,LEXSUBJ,LEXLAST D IMP^LEX2053
S LEXEDT=$G(^LEXM(0,"CREATED")) D CON,LOAD
I $D(^%ZOSF("DEL")) S LEXRTN="LEX2053A" 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
Q
LOAD ; Load Data from export global ^LEXM
;
; LEXSHORT Send Short Message
; LEXMSG Flag to send Message
;
N LEXSHORT,LEXMSG S LEXSHORT="",LEXMSG=""
S LEXSTR=$G(LEXPTYPE) S:$L($G(LEXFY))&($L($G(LEXQTR))) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
D:LEXB=LEXBUILD EN^LEXXGI
LQ ; Load Quit
D KLEXM
Q
;
KLEXM ; Subscripted Kill of ^LEXM
N I S I="" F S I=$O(^LEXM(I)) Q:'$L(I) K ^LEXM(I)
Q
;
PRE ; LEX*2.0*53 Pre-Install (N/A for patch 53)
Q
RX ; Re-Index
N Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTREQ,ZTQUEUED
S ZTRTN="RXT^LEX2053P",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
CON ; Conversion of data
D EN^LEX2053A
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2053P 2594 printed Dec 13, 2024@02:04:24 Page 2
LEX2053P ;ISL/KER - LEX*2.0*53 Pre/Post Install ;06/06/2007
+1 ;;2.0;LEXICON UTILITY;**53**;Sep 23, 1996;Build 18
+2 ;
+3 ; Variables NEWed or KILLed Elsewhere
+4 ; None
+5 ;
+6 ; Global Variables
+7 ; ^LEXM
+8 ;
+9 ; External References
+10 ; None
+11 ;
+12 QUIT
POST ; LEX*2.0*53 Post-Install
+1 ;
+2 ; From IMP^LEX2053
+3 ;
+4 ; LEXBUILD Build Name - LEX*2.0*nn
+5 ; LEXPTYPE Patch Type - Remedy or Quarterly
+6 ; LEXFY Fiscal Year - FYnn
+7 ; LEXQTR Quarter - 1st, 2nd, 3rd, or 4th
+8 ; LEXIGHF Name of Host File - LEX_2_nn.GBL
+9 ; LEXLREV Revision - nn
+10 ; LEXREQP Required Builds - build;build;build
+11 ;
+12 NEW LEXEDT,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXRTN,LEXSTR,LEXSUBJ,LEXLAST
DO IMP^LEX2053
+13 SET LEXEDT=$GET(^LEXM(0,"CREATED"))
DO CON
DO LOAD
+14 IF $DATA(^%ZOSF("DEL"))
SET LEXRTN="LEX2053A"
Begin DoDot:1
+15 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
+16 QUIT
LOAD ; Load Data from export global ^LEXM
+1 ;
+2 ; LEXSHORT Send Short Message
+3 ; LEXMSG Flag to send Message
+4 ;
+5 NEW LEXSHORT,LEXMSG
SET LEXSHORT=""
SET LEXMSG=""
+6 SET LEXSTR=$GET(LEXPTYPE)
if $LENGTH($GET(LEXFY))&($LENGTH($GET(LEXQTR)))
SET LEXSTR=LEXSTR_" for "_$GET(LEXFY)_" "_$GET(LEXQTR)_" Quarter"
+7 SET U="^"
SET LEXB=$GET(^LEXM(0,"BUILD"))
if LEXB=""
QUIT
if LEXBUILD=""
QUIT
+8 if LEXB=LEXBUILD
DO EN^LEXXGI
LQ ; Load Quit
+1 DO KLEXM
+2 QUIT
+3 ;
KLEXM ; Subscripted Kill of ^LEXM
+1 NEW I
SET I=""
FOR
SET I=$ORDER(^LEXM(I))
if '$LENGTH(I)
QUIT
KILL ^LEXM(I)
+2 QUIT
+3 ;
PRE ; LEX*2.0*53 Pre-Install (N/A for patch 53)
+1 QUIT
RX ; Re-Index
+1 NEW Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,ZTREQ,ZTQUEUED
+2 SET ZTRTN="RXT^LEX2053P"
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
CON ; Conversion of data
+1 DO EN^LEX2053A
+2 QUIT
