LEX2067P ;ISL/KER - LEX*2.0*67 Pre/Post Install ;06/03/2009
;;2.0;LEXICON UTILITY;**67**;Sep 23, 1996;Build 4
;
; Variables NEWed or KILLed Elsewhere
; LEXTEST Variable used for testing only
; This variable is not set
;
; Global Variables
; ^LEX( N/A
; ^LEXM( N/A
;
; External References
; IX1^DIK ICR 10013
; $$NOW^XLFDT ICR 10103
; BMES^XPDUTL ICR 10141
; HOME^%ZIS ICR 10086
; ^%ZTLOAD ICR 10063
;
Q
POST ; Post-Install
;
; From IMP in the Environment Check
;
; 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,LEXSTR,LEXLAST,LEXOK S LEXOK=0 D IMP
S LEXEDT=$G(^LEXM(0,"CREATED")) D:LEXOK>0 LOAD D CON
Q
LOAD ; Load Data
;
; 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:$G(LEXBUILD)=""
D:LEXB=LEXBUILD EN^LEXXGI
LQ ; Load Quit
D KLEXM
Q
;
KLEXM ; Subscripted Kill of ^LEXM
H 2 N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
N LEX S LEX=$G(^LEXM(0,"PRO")) K ^LEXM(0)
Q
;
PRE ; Pre-Install (N/A for this patch)
Q
;
CON ; Conversion of data
N LEXTX,Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTQUEUED,ZTREQ
S LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 " D BMES^XPDUTL(LEXTX)
K ^LEX(757.02,"AVA","482.41 "),^LEX(757.02,"AVA","041.11 ")
N DA,DIK S DIK="^LEX(757.02," F DA=304492,316463,316464,332669,318848,332656 D IX1^DIK
S ZTRTN="CONT^LEX2067P",ZTDESC="Fixing AVA Cross-Reference File #757.02",ZTIO="",ZTDTH=$H D ^%ZTLOAD D HOME^%ZIS
Q
CONT ;
N DA,DIK,LEXBEG,LEXCK,LEXDIF,LEXELP,LEXEND,LEXERR,LEXERRT,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR,LEXTC,LEXTX
N LEXFI,LEXTX S LEXFI="757.02" S LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 "
S LEXCK="^ICD^10D^ICP^10P^CPT^CPC^DS4^NAN^HHC^NIC^SNM^SM3^OMA^SCC^",LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0
S LEXSTR="",LEXFI=757.02,LEXIDX="AVA",LEXIDXT="^LEX(757.02,""AVA"",CODE,EXP,SAB,IEN)"
N LEXQUIET S LEXQUIET=""
F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
. N LEXEXP S LEXEXP=0 F S LEXEXP=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP)) Q:+LEXEXP'>0 D
. . N LEXSAB S LEXSAB="" F S LEXSAB=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB)) Q:'$L(LEXSAB) D
. . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)) Q:+LEXIEN'>0 D
. . . . N LEXOK,LEXSO,LEXEX,LEXSR,LEXSB S LEXNDS=LEXNDS+1
. . . . S LEXEX=$P($G(^LEX(757.02,+LEXIEN,0)),"^",1),LEXSO=$P($G(^LEX(757.02,+LEXIEN,0)),"^",2)
. . . . S LEXSR=$P($G(^LEX(757.02,+LEXIEN,0)),"^",3),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
. . . . I $L(LEXSAB)'=3!(LEXCK'[("^"_LEXSAB_"^")) D Q
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$G(LEXSAB)
. . . . I '$L(LEXEX)!('$L(LEXSO))!($L(LEXSB)'=3) D Q
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . I '$D(ZTQUEUED),'$L(LEXEX) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Expression (null)"
. . . . . I '$D(ZTQUEUED),'$L(LEXSO) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Code (null)"
. . . . . I '$D(ZTQUEUED),$L(LEXSB)'=3 W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$G(LEXSB)
. . . . S LEXOK=1 S:LEXSTR='(LEXSO_" ") LEXOK=0 S:LEXEXP'=LEXEX LEXOK=0 S:LEXSAB'=LEXSB LEXOK=0 I 'LEXOK D
. . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
. . . . . S:$L(LEXSO)&($L(LEXEX))&($L(LEXSB))&(LEXCK[("^"_LEXSB_"^")) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXEX,LEXSB,LEXIEN)=""
. . . . . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Data doesn't match Record"
S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
. N DA,DIK,LEXEX,LEXSO,LEXSR,LEXSB S DA=LEXIEN,LEXSR=$P($G(^LEX(LEXFI,+DA,0)),"^",3),LEXSO=$P($G(^LEX(LEXFI,DA,0)),U,2)
. S LEXEX=$P($G(^LEX(LEXFI,DA,0)),U,1),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3) Q:$L(LEXSB)'=3 Q:'$L(LEXSO) Q:+LEXEX'>0
. I LEXCK[("^"_LEXSB_"^"),'$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
. . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,"/",LEXSB,?58," ",DA
. . S:'$D(LEXTEST) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)=""
. I LEXCK'[("^"_LEXSB_"^"),$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
. . S LEXERR=LEXERR+1
. . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSO,?48," ",DA,?58,"Invalid Source" W:'$D(LEXTEST)&('$D(LEXQUIET)) " - Deleted"
. . K:'$D(LEXTEST) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED),+LEXERR>0 W:'$D(LEXQUIET) !,+LEXERR," Error",$S(+LEXERR>1:"s",1:"")," found"
Q
IMP ; Call IMP in Environment Check
K LEXBUILD,LEXFY,LEXIGHF,LEXLREV,LEXPTYPE,LEXQTR,LEXREQP N LEXF
S LEXF=$P($T(+1)," ",1) S:$E(LEXF,$L(LEXF))="P" LEXF=$E(LEXF,1,($L(LEXF)-1)) Q:'$L(LEXF)
S LEXF="IMP^"_LEXF Q:'$L($T(@LEXF)) D @LEXF S:$L(LEXBUILD) LEXOK=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2067P 6017 printed Dec 13, 2024@02:04:35 Page 2
LEX2067P ;ISL/KER - LEX*2.0*67 Pre/Post Install ;06/03/2009
+1 ;;2.0;LEXICON UTILITY;**67**;Sep 23, 1996;Build 4
+2 ;
+3 ; Variables NEWed or KILLed Elsewhere
+4 ; LEXTEST Variable used for testing only
+5 ; This variable is not set
+6 ;
+7 ; Global Variables
+8 ; ^LEX( N/A
+9 ; ^LEXM( N/A
+10 ;
+11 ; External References
+12 ; IX1^DIK ICR 10013
+13 ; $$NOW^XLFDT ICR 10103
+14 ; BMES^XPDUTL ICR 10141
+15 ; HOME^%ZIS ICR 10086
+16 ; ^%ZTLOAD ICR 10063
+17 ;
+18 QUIT
POST ; Post-Install
+1 ;
+2 ; From IMP in the Environment Check
+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,LEXSTR,LEXLAST,LEXOK
SET LEXOK=0
DO IMP
+13 SET LEXEDT=$GET(^LEXM(0,"CREATED"))
if LEXOK>0
DO LOAD
DO CON
+14 QUIT
LOAD ; Load Data
+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 $GET(LEXBUILD)=""
QUIT
+8 if LEXB=LEXBUILD
DO EN^LEXXGI
LQ ; Load Quit
+1 DO KLEXM
+2 QUIT
+3 ;
KLEXM ; Subscripted Kill of ^LEXM
+1 HANG 2
NEW DA
SET DA=0
FOR
SET DA=$ORDER(^LEXM(DA))
if +DA=0
QUIT
KILL ^LEXM(DA)
+2 NEW LEX
SET LEX=$GET(^LEXM(0,"PRO"))
KILL ^LEXM(0)
+3 QUIT
+4 ;
PRE ; Pre-Install (N/A for this patch)
+1 QUIT
+2 ;
CON ; Conversion of data
+1 NEW LEXTX,Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTQUEUED,ZTREQ
+2 SET LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 "
DO BMES^XPDUTL(LEXTX)
+3 KILL ^LEX(757.02,"AVA","482.41 "),^LEX(757.02,"AVA","041.11 ")
+4 NEW DA,DIK
SET DIK="^LEX(757.02,"
FOR DA=304492,316463,316464,332669,318848,332656
DO IX1^DIK
+5 SET ZTRTN="CONT^LEX2067P"
SET ZTDESC="Fixing AVA Cross-Reference File #757.02"
SET ZTIO=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
DO HOME^%ZIS
+6 QUIT
CONT ;
+1 NEW DA,DIK,LEXBEG,LEXCK,LEXDIF,LEXELP,LEXEND,LEXERR,LEXERRT,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR,LEXTC,LEXTX
+2 NEW LEXFI,LEXTX
SET LEXFI="757.02"
SET LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 "
+3 SET LEXCK="^ICD^10D^ICP^10P^CPT^CPC^DS4^NAN^HHC^NIC^SNM^SM3^OMA^SCC^"
SET LEXBEG=$$NOW^XLFDT
SET (LEXNDS,LEXERR)=0
+4 SET LEXSTR=""
SET LEXFI=757.02
SET LEXIDX="AVA"
SET LEXIDXT="^LEX(757.02,""AVA"",CODE,EXP,SAB,IEN)"
+5 NEW LEXQUIET
SET LEXQUIET=""
+6 FOR
SET LEXSTR=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR))
if '$LENGTH(LEXSTR)
QUIT
Begin DoDot:1
+7 NEW LEXEXP
SET LEXEXP=0
FOR
SET LEXEXP=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP))
if +LEXEXP'>0
QUIT
Begin DoDot:2
+8 NEW LEXSAB
SET LEXSAB=""
FOR
SET LEXSAB=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB))
if '$LENGTH(LEXSAB)
QUIT
Begin DoDot:3
+9 NEW LEXIEN
SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:4
+10 NEW LEXOK,LEXSO,LEXEX,LEXSR,LEXSB
SET LEXNDS=LEXNDS+1
+11 SET LEXEX=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",1)
SET LEXSO=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",2)
+12 SET LEXSR=$PIECE($GET(^LEX(757.02,+LEXIEN,0)),"^",3)
SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
+13 IF $LENGTH(LEXSAB)'=3!(LEXCK'[("^"_LEXSAB_"^"))
Begin DoDot:5
+14 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+15 IF '$DATA(ZTQUEUED)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$GET(LEXSAB)
End DoDot:5
QUIT
+16 IF '$LENGTH(LEXEX)!('$LENGTH(LEXSO))!($LENGTH(LEXSB)'=3)
Begin DoDot:5
+17 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+18 IF '$DATA(ZTQUEUED)
IF '$LENGTH(LEXEX)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Expression (null)"
+19 IF '$DATA(ZTQUEUED)
IF '$LENGTH(LEXSO)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Code (null)"
+20 IF '$DATA(ZTQUEUED)
IF $LENGTH(LEXSB)'=3
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$GET(LEXSB)
End DoDot:5
QUIT
+21 SET LEXOK=1
if LEXSTR='(LEXSO_" ")
SET LEXOK=0
if LEXEXP'=LEXEX
SET LEXOK=0
if LEXSAB'=LEXSB
SET LEXOK=0
IF 'LEXOK
Begin DoDot:5
+22 SET LEXERR=LEXERR+1
if '$DATA(LEXTEST)
KILL ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
+23 if $LENGTH(LEXSO)&($LENGTH(LEXEX))&($LENGTH(LEXSB))&(LEXCK[("^"_LEXSB_"^"))
SET ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXEX,LEXSB,LEXIEN)=""
+24 IF '$DATA(ZTQUEUED)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Data doesn't match Record"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET LEXIEN=0
FOR
SET LEXIEN=$ORDER(^LEX(LEXFI,LEXIEN))
if +LEXIEN'>0
QUIT
Begin DoDot:1
+26 NEW DA,DIK,LEXEX,LEXSO,LEXSR,LEXSB
SET DA=LEXIEN
SET LEXSR=$PIECE($GET(^LEX(LEXFI,+DA,0)),"^",3)
SET LEXSO=$PIECE($GET(^LEX(LEXFI,DA,0)),U,2)
+27 SET LEXEX=$PIECE($GET(^LEX(LEXFI,DA,0)),U,1)
SET LEXSB=$EXTRACT($PIECE($GET(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
if $LENGTH(LEXSB)'=3
QUIT
if '$LENGTH(LEXSO)
QUIT
if +LEXEX'>0
QUIT
+28 IF LEXCK[("^"_LEXSB_"^")
IF '$DATA(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA))
Begin DoDot:2
+29 SET LEXERR=LEXERR+1
IF '$DATA(ZTQUEUED)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,"/",LEXSB,?58," ",DA
+30 if '$DATA(LEXTEST)
SET ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)=""
End DoDot:2
+31 IF LEXCK'[("^"_LEXSB_"^")
IF $DATA(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA))
Begin DoDot:2
+32 SET LEXERR=LEXERR+1
+33 IF '$DATA(ZTQUEUED)
if '$DATA(LEXQUIET)
WRITE !,?8,LEXFI,?19,LEXIDX,?26,LEXSO,?48," ",DA,?58,"Invalid Source"
if '$DATA(LEXTEST)&('$DATA(LEXQUIET))
WRITE " - Deleted"
+34 if '$DATA(LEXTEST)
KILL ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
End DoDot:2
End DoDot:1
+35 SET LEXERR=$SELECT(+LEXERR>0:LEXERR,1:"")
IF '$DATA(ZTQUEUED)
IF +LEXERR>0
if '$DATA(LEXQUIET)
WRITE !,+LEXERR," Error",$SELECT(+LEXERR>1:"s",1:"")," found"
+36 QUIT
IMP ; Call IMP in Environment Check
+1 KILL LEXBUILD,LEXFY,LEXIGHF,LEXLREV,LEXPTYPE,LEXQTR,LEXREQP
NEW LEXF
+2 SET LEXF=$PIECE($TEXT(+1)," ",1)
if $EXTRACT(LEXF,$LENGTH(LEXF))="P"
SET LEXF=$EXTRACT(LEXF,1,($LENGTH(LEXF)-1))
if '$LENGTH(LEXF)
QUIT
+3 SET LEXF="IMP^"_LEXF
if '$LENGTH($TEXT(@LEXF))
QUIT
DO @LEXF
if $LENGTH(LEXBUILD)
SET LEXOK=1
+4 QUIT
