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