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

LEX2089P.m

Go to the documentation of this file.
  1. LEX2089P ;ISL/KER - LEX*2.0*89 Pre/Post Install ;12/29/2012
  1. ;;2.0;LEXICON UTILITY;**89**;Sep 23, 1996;Build 5
  1. ;
  1. ; Global Variables
  1. ; ^LEXM( N/A
  1. ;
  1. ; External References
  1. ; ^DIC ICR 10006
  1. ; $$NOW^XLFDT ICR 10103
  1. ; $$PKGPAT^XPDIP ICR 2067
  1. ; MES^XPDUTL ICR 10141
  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,X,Y S LEXOK=0 D IMP
  1. S LEXEDT=$G(^LEXM(0,"CREATED")) D:LEXOK>0 LOAD,CON,IP
  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. IP ; Informational Patches
  1. N LEX,LEXP,LEXPS,LEXSQ,LEXT,LEXI,LEXE,LEXX,LEXC,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXSUB,LEXOK D IMP S LEXSUB=""
  1. I $G(LEXPTYPE)="Code Set Update",$G(LEXFY)["FY",$L($G(LEXQTR)) S LEXSUB="Code Set "_LEXFY_" "_LEXQTR_" Qtr Update"
  1. S LEXC=0 F LEXI=1:1 D Q:'$L(LEXX)
  1. . S LEXX="" S LEXE="S LEXX=$T(IPL+"_LEXI_")" X LEXE S:'$L($TR($G(LEXX),";","")) LEXX="" Q:'$L(LEXX) S LEXPS=$P(LEXX,";;",2) S:$L(LEXPS,"*")=3 LEXC=LEXC+1
  1. I LEXC>0 S LEXT=" Informational Patch"_$S(+($G(LEXC))>1:"es",1:"") S:$L(LEXSUB) LEXT=LEXT_" for the "_LEXSUB S LEXT=LEXT_":" D MES^XPDUTL(LEXT)
  1. S LEXC=0 F LEXI=1:1 D Q:'$L(LEXX)
  1. . S LEXX="" S LEXE="S LEXX=$T(IPL+"_LEXI_")" X LEXE S:'$L($TR($G(LEXX),";","")) LEXX="" Q:'$L(LEXX) S LEXPS=$P(LEXX,";;",2) S:'$L(LEXPS) LEXX="" Q:'$L(LEXX)
  1. . S LEXSQ=+($P(LEXX,";;",3)) S:+LEXSQ>0 LEXPS=LEXPS_" SEQ #"_LEXSQ S LEXC=LEXC+1 D:LEXC=1 MES^XPDUTL(" ")
  1. . W:$D(LEXTEST) !,?5,LEXPS D:'$D(LEXTEST) IPU(LEXPS)
  1. D:LEXC>0 MES^XPDUTL(" ") N LEXTEST
  1. Q
  1. IPU(X) ; Patch Update
  1. N LEXID,LEXOP,LEXPC,LEXPK,LEXPKI,LEXPN,LEXPTI,LEXSQ,LEXT,LEXVR,LEXVRI,LEXAR
  1. S LEXPC=$G(X),LEXSQ=$P(LEXPC," ",2,299),LEXID=$P(LEXPC," ",1),LEXOP=""
  1. S LEXPK=$S($P(LEXPC,"*",1)="ICD":"DRG GROUPER",$P(LEXPC,"*",1)="ICPT":"CPT/HCPCS CODES",$P(LEXPC,"*",1)="LEX":"LEXICON UTILITY",1:"") Q:'$L(LEXPK)
  1. S LEXPKI=$$PIEN(LEXPK) Q:+LEXPKI'>0 S LEXVR=$P(LEXPC,"*",2) Q:'$L(LEXVR) Q:LEXVR'["." S LEXPN=$P(LEXPC,"*",3) Q:'$L(LEXPN) Q:+LEXPN'>0
  1. S LEXAR=LEXPN_"^"_$$NOW^XLFDT_"^"_$G(DUZ)
  1. I $L($G(LEXBUILD)) S LEXOP=$$PKGPAT^XPDIP(LEXPKI,LEXVR,.LEXAR)
  1. S LEXVRI=$P(LEXOP,"^",1),LEXPTI=$P(LEXOP,"^",2)
  1. S LEXT=" "_LEXID,LEXT=LEXT_$J(" ",(17-$L(LEXT)))_LEXSQ,LEXT=LEXT_$J(" ",(28-$L(LEXT)))_LEXPK
  1. I $L(LEXOP),LEXPTI>0 S LEXT=LEXT_$J(" ",(46-$L(LEXT)))_"Patch History updated" D MES^XPDUTL(LEXT)
  1. I $L(LEXOP),LEXPTI'>0 S LEXT=LEXT_$J(" ",(46-$L(LEXT)))_"Patch History not updated" D MES^XPDUTL(LEXT)
  1. I '$L(LEXOP) D MES^XPDUTL(LEXT)
  1. Q
  1. IPL ; Patch List ;;Patch;;Sequence #
  1. ;;ICPT*6.0*62;;60
  1. ;;;;;;
  1. PRE ; Pre-Install (N/A for this patch)
  1. Q
  1. CON ; Conversion of data
  1. ; Fix codes 250.00 and 294.9
  1. N CODE F CODE="250.00","294.9" D
  1. . N STA F STA="0",2 K ^LEX(757.02,"ACT",(CODE_" "),STA,3131001)
  1. . N SIEN S SIEN=0 F S SIEN=$O(^LEX(757.02,"CODE",(CODE_" "),SIEN)) Q:+SIEN'>0 D
  1. . . N HIST S HIST=0 F S HIST=$O(^LEX(757.02,+SIEN,4,HIST)) Q:+HIST'>0 D
  1. . . . N ND,DA,DIK,STA,EFF S ND=$G(^LEX(757.02,SIEN,4,HIST,0)),STA=$P(ND,"^",2),EFF=$P(ND,"^",1)
  1. . . . Q:STA'?1N Q:EFF'?7N Q:STA>0 Q:EFF'=3131001
  1. . . . S DA(1)=SIEN,DA=HIST,DIK="^LEX(757.02,"_DA(1)_",4," D ^DIK
  1. . . K ^LEX(757.02,SIEN,4,"B",3131001)
  1. ; Increment Copyright
  1. S ^DIC(81.2,1,0)="CPT MESSAGE^3130101"
  1. S ^DIC(81.2,1,1,0)="17^81.21^20^20^3130101^^^^"
  1. Q
  1. ;
  1. ; Miscellaneous
  1. PIEN(X) ; Package IEN
  1. N DIC,DTOUT,DTOUT,Y S X=$G(X),DIC="^DIC(9.4,",DIC(0)="B" D ^DIC S X=+Y
  1. Q X
  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