- 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 Feb 18, 2025@23:30:37 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