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

LEX2109P.m

Go to the documentation of this file. 
  1. LEX2109P ;ISL/KER - LEX*2.0*109 Pre/Post Install ;12/12/2016
  1.  ;;2.0;LEXICON UTILITY;**109**;Sep 23, 1996;Build 12
  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.  ; Note:  All references to the patch number should be
  1.  ;        checked and updated as necessary.
  1.  ;   
  1.  ;        The sub-routine (Informational Patch List) must
  1.  ;        be updated with each patch.  It should include
  1.  ;        (as a minimum) the patch names of all of the 
  1.  ;        informational patches associated with the Lexicon
  1.  ;        Patch.  This will update the Package file at the
  1.  ;        site.
  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*78;;
  1.  ;;;;;;
  1. PRE ; Pre-Install              (N/A for this patch)
  1.  Q
  1. CON ; Conversion of data
  1.  ; Fix CPT File #81, CPT Category field #3
  1.  S ^ICPT("D",206,90630)="" K ^ICPT("D",29,90630),^ICPT("D",29,90651)
  1.  K ^ICPT("D",230,109539),^ICPT("D",230,109540)
  1.  ; Fix Semantic Map file #757.1, Major Concept Map field #.01
  1.  K ^LEX(757.1,"B",47404,47401),^LEX(757.1,"B",47704,47702),^LEX(757.1,"B",48101,48102)
  1.  ; I10734300FY16 - ICD-10 Code Z48.21 is acceptable as principle diagnosis
  1.  N DA,DIK S DA=569102,DIK="^ICD9(" D IX2^DIK
  1.  S $P(^ICD9(569102,1),"^",3)=""
  1.  S DA=569102,DIK="^ICD9(" D IX1^DIK
  1.  ; I9695799FY16 - ICD-10 Code Z51.89 is acceptable as principle diagnosis
  1.  N DA,DIK S DA=569129,DIK="^ICD9(" D IX2^DIK
  1.  S $P(^ICD9(DA,1),"^",3)=""
  1.  S DA=569129,DIK="^ICD9(" D IX1^DIK
  1.  ; New CPT Copyright Message
  1.  K ^DIC(81.2,1,1) S ^DIC(81.2,1,0)="CPT MESSAGE^3170101"
  1.  S ^DIC(81.2,1,1,0)="^81.21^10^10^3161130^^"
  1.  S ^DIC(81.2,1,1,1,0)="CPT (CPT is a registered trademark of the American Medical Association)"
  1.  S ^DIC(81.2,1,1,2,0)="codes, descriptions and other data are copyright 1966, 1970, 1973, 1977,"
  1.  S ^DIC(81.2,1,1,3,0)="1981, 1983-2016 American Medical Association."
  1.  S ^DIC(81.2,1,1,4,0)=" "
  1.  S ^DIC(81.2,1,1,5,0)="CPT is commercial technical data developed exclusively at private expense"
  1.  S ^DIC(81.2,1,1,6,0)="by Contractor/Manufacturer American Medical Association, AMA Plaza, "
  1.  S ^DIC(81.2,1,1,7,0)="330 N. Wabash Ave., Suite 39300, Chicago, IL 60611-5885.  The provisions"
  1.  S ^DIC(81.2,1,1,8,0)="of this Agreement between AMA and VA prevail, including prohibiting "
  1.  S ^DIC(81.2,1,1,9,0)="creating derivative works and providing CPT to any third parties outside"
  1.  S ^DIC(81.2,1,1,10,0)="of the Facilities."
  1.  S ^DIC(81.2,"B","CPT MESSAGE",1)=""
  1.  Q
  1.  ; Full Dexcription for Code L1851
  1.  S DA=112226,DIK="^ICPT(" D IX2^DIK K ^ICPT(112226,62,1,1,0)
  1.  S ^ICPT(112226,62,1,1,1,0)="KNEE ORTHOSIS (KO), SINGLE UPRIGHT, THIGH AND CALF, WITH ADJUSTABLE"
  1.  S ^ICPT(112226,62,1,1,2,0)="FLEXION AND EXTENSION JOINT (UNICENTRIC OR POLYCENTRIC), MEDIAL-LATERAL"
  1.  S ^ICPT(112226,62,1,1,3,0)="AND ROTATION CONTROL, WITH OR WITHOUT VARUS/VALGUS ADJUSTMENT,"
  1.  S ^ICPT(112226,62,1,1,4,0)="PREFABRICATED, OFF-THE-SHELF"
  1.  S ^ICPT(112226,62,1,1,0)="^81.621^4^4"
  1.  S DA=112226,DIK="^ICPT(" D IX1^DIK
  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