LEX2053P.m

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 ---LEX2053P   2594     printed  Mar 13, 2025@21:08:53                                                                                                                                                                                                    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