Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEX2067P

LEX2067P.m

Go to the documentation of this file.
  1. LEX2067P ;ISL/KER - LEX*2.0*67 Pre/Post Install ;06/03/2009
  1. ;;2.0;LEXICON UTILITY;**67**;Sep 23, 1996;Build 4
  1. ;
  1. ; Variables NEWed or KILLed Elsewhere
  1. ; LEXTEST Variable used for testing only
  1. ; This variable is not set
  1. ;
  1. ; Global Variables
  1. ; ^LEX( N/A
  1. ; ^LEXM( N/A
  1. ;
  1. ; External References
  1. ; IX1^DIK ICR 10013
  1. ; $$NOW^XLFDT ICR 10103
  1. ; BMES^XPDUTL ICR 10141
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZTLOAD ICR 10063
  1. ;
  1. Q
  1. POST ; Post-Install
  1. ;
  1. ; From IMP in the Environment Check
  1. ;
  1. ; LEXBUILD Build Name - LEX*2.0*nn
  1. ; LEXPTYPE Patch Type - Remedy or Quarterly
  1. ; LEXFY Fiscal Year - FYnn
  1. ; LEXQTR Quarter - 1st, 2nd, 3rd, or 4th
  1. ; LEXIGHF Name of Host File - LEX_2_nn.GBL
  1. ; LEXLREV Revision - nn
  1. ; LEXREQP Required Builds - build;build;build
  1. ;
  1. N LEXEDT,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST,LEXOK S LEXOK=0 D IMP
  1. S LEXEDT=$G(^LEXM(0,"CREATED")) D:LEXOK>0 LOAD D CON
  1. Q
  1. LOAD ; Load Data
  1. ;
  1. ; LEXSHORT Send Short Message
  1. ; LEXMSG Flag to send Message
  1. ;
  1. N LEXSHORT,LEXMSG S LEXSHORT="",LEXMSG=""
  1. S LEXSTR=$G(LEXPTYPE) S:$L($G(LEXFY))&($L($G(LEXQTR))) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
  1. S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:$G(LEXBUILD)=""
  1. D:LEXB=LEXBUILD EN^LEXXGI
  1. LQ ; Load Quit
  1. D KLEXM
  1. Q
  1. ;
  1. KLEXM ; Subscripted Kill of ^LEXM
  1. H 2 N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
  1. N LEX S LEX=$G(^LEXM(0,"PRO")) K ^LEXM(0)
  1. Q
  1. ;
  1. PRE ; Pre-Install (N/A for this patch)
  1. Q
  1. ;
  1. CON ; Conversion of data
  1. N LEXTX,Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTQUEUED,ZTREQ
  1. S LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 " D BMES^XPDUTL(LEXTX)
  1. K ^LEX(757.02,"AVA","482.41 "),^LEX(757.02,"AVA","041.11 ")
  1. N DA,DIK S DIK="^LEX(757.02," F DA=304492,316463,316464,332669,318848,332656 D IX1^DIK
  1. S ZTRTN="CONT^LEX2067P",ZTDESC="Fixing AVA Cross-Reference File #757.02",ZTIO="",ZTDTH=$H D ^%ZTLOAD D HOME^%ZIS
  1. Q
  1. CONT ;
  1. N DA,DIK,LEXBEG,LEXCK,LEXDIF,LEXELP,LEXEND,LEXERR,LEXERRT,LEXFI,LEXIDX,LEXIDXT,LEXIEN,LEXNDS,LEXOK,LEXSO,LEXSTR,LEXTC,LEXTX
  1. N LEXFI,LEXTX S LEXFI="757.02" S LEXTX=" Fixing ""AVA"" cross-reference in the CODE file #757.02 "
  1. S LEXCK="^ICD^10D^ICP^10P^CPT^CPC^DS4^NAN^HHC^NIC^SNM^SM3^OMA^SCC^",LEXBEG=$$NOW^XLFDT,(LEXNDS,LEXERR)=0
  1. S LEXSTR="",LEXFI=757.02,LEXIDX="AVA",LEXIDXT="^LEX(757.02,""AVA"",CODE,EXP,SAB,IEN)"
  1. N LEXQUIET S LEXQUIET=""
  1. F S LEXSTR=$O(^LEX(LEXFI,LEXIDX,LEXSTR)) Q:'$L(LEXSTR) D
  1. . N LEXEXP S LEXEXP=0 F S LEXEXP=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP)) Q:+LEXEXP'>0 D
  1. . . N LEXSAB S LEXSAB="" F S LEXSAB=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB)) Q:'$L(LEXSAB) D
  1. . . . N LEXIEN S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)) Q:+LEXIEN'>0 D
  1. . . . . N LEXOK,LEXSO,LEXEX,LEXSR,LEXSB S LEXNDS=LEXNDS+1
  1. . . . . S LEXEX=$P($G(^LEX(757.02,+LEXIEN,0)),"^",1),LEXSO=$P($G(^LEX(757.02,+LEXIEN,0)),"^",2)
  1. . . . . S LEXSR=$P($G(^LEX(757.02,+LEXIEN,0)),"^",3),LEXSB=$E($P($G(^LEX(757.03,+LEXSR,0)),"^",1),1,3)
  1. . . . . I $L(LEXSAB)'=3!(LEXCK'[("^"_LEXSAB_"^")) D Q
  1. . . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
  1. . . . . . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$G(LEXSAB)
  1. . . . . I '$L(LEXEX)!('$L(LEXSO))!($L(LEXSB)'=3) D Q
  1. . . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
  1. . . . . . I '$D(ZTQUEUED),'$L(LEXEX) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Expression (null)"
  1. . . . . . I '$D(ZTQUEUED),'$L(LEXSO) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Code (null)"
  1. . . . . . I '$D(ZTQUEUED),$L(LEXSB)'=3 W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Invalid Source ",$G(LEXSB)
  1. . . . . S LEXOK=1 S:LEXSTR='(LEXSO_" ") LEXOK=0 S:LEXEXP'=LEXEX LEXOK=0 S:LEXSAB'=LEXSB LEXOK=0 I 'LEXOK D
  1. . . . . . S LEXERR=LEXERR+1 K:'$D(LEXTEST) ^LEX(LEXFI,LEXIDX,LEXSTR,LEXEXP,LEXSAB,LEXIEN)
  1. . . . . . S:$L(LEXSO)&($L(LEXEX))&($L(LEXSB))&(LEXCK[("^"_LEXSB_"^")) ^LEX(LEXFI,LEXIDX,(LEXSO_" "),LEXEX,LEXSB,LEXIEN)=""
  1. . . . . . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSTR,?48," ",LEXIEN,?58,"Data doesn't match Record"
  1. S LEXIEN=0 F S LEXIEN=$O(^LEX(LEXFI,LEXIEN)) Q:+LEXIEN'>0 D
  1. . 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)
  1. . 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
  1. . I LEXCK[("^"_LEXSB_"^"),'$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
  1. . . S LEXERR=LEXERR+1 I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?30,"Missing ",LEXSO,"/",LEXSB,?58," ",DA
  1. . . S:'$D(LEXTEST) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)=""
  1. . I LEXCK'[("^"_LEXSB_"^"),$D(^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)) D
  1. . . S LEXERR=LEXERR+1
  1. . . I '$D(ZTQUEUED) W:'$D(LEXQUIET) !,?8,LEXFI,?19,LEXIDX,?26,LEXSO,?48," ",DA,?58,"Invalid Source" W:'$D(LEXTEST)&('$D(LEXQUIET)) " - Deleted"
  1. . . K:'$D(LEXTEST) ^LEX(757.02,"AVA",(LEXSO_" "),LEXEX,LEXSB,DA)
  1. S LEXERR=$S(+LEXERR>0:LEXERR,1:"") I '$D(ZTQUEUED),+LEXERR>0 W:'$D(LEXQUIET) !,+LEXERR," Error",$S(+LEXERR>1:"s",1:"")," found"
  1. Q
  1. IMP ; Call IMP in Environment Check
  1. K LEXBUILD,LEXFY,LEXIGHF,LEXLREV,LEXPTYPE,LEXQTR,LEXREQP N LEXF
  1. S LEXF=$P($T(+1)," ",1) S:$E(LEXF,$L(LEXF))="P" LEXF=$E(LEXF,1,($L(LEXF)-1)) Q:'$L(LEXF)
  1. S LEXF="IMP^"_LEXF Q:'$L($T(@LEXF)) D @LEXF S:$L(LEXBUILD) LEXOK=1
  1. Q