175 lines
8.2 KiB
Mathematica
175 lines
8.2 KiB
Mathematica
LEX2049P ; ISL/OI - Post Install LEX*2.0*49 ; 02/22/2007
|
|
;;2.0;LEXICON UTILITY;**49**;Sep 23, 1996;Build 3
|
|
;
|
|
; Global Variables
|
|
; ^%ZOSF("DEL"
|
|
; ^%ZOSF("TEST"
|
|
; ^LEXC
|
|
; ^LEXM(0
|
|
; ^LEXT(757.2
|
|
; ^ORD(101
|
|
; ^TMP("LEXCNT"
|
|
; ^TMP("LEXCS"
|
|
; ^TMP("LEXI"
|
|
; ^TMP("LEXINS"
|
|
; ^TMP("LEXKID"
|
|
; ^TMP("LEXMSG"
|
|
;
|
|
; External References
|
|
; HOME^%ZIS
|
|
; $$GET1^DID
|
|
; ^DIK
|
|
; ^DIM
|
|
; $$GET1^DIQ
|
|
; EN^DIU2
|
|
; $$DT^XLFDT
|
|
; $$FMTE^XLFDT
|
|
; $$NOW^XLFDT
|
|
; BMES^XPDUTL
|
|
; MES^XPDUTL
|
|
; EN^XQOR
|
|
; $$DTIME^XUP
|
|
;
|
|
POST ; Post-Install Main Entry Point
|
|
N CNT,DA,DIK,DIU,ERR,EXEC,FI,FIX,FNAME,I,INST,LEX,LEXBEG,LEXBUILD,LEXCHG,LEXEDT,LEXELP,LEXEND
|
|
N LEXFC,LEXI,LEXID,LEXMOD,LEXMUL,LEXNM,LEXO,LEXP,LEXPOST,LEXSCHG,LEXSHORT,LEXSUB,LEXTCS,LEXTND
|
|
N NAME,OK,PN,PNO,ROK,RTN,SSIEN,STR,T,TAG,TXT,TY,X,Y,ZTQUEUED,ZTREQ S LEXPOST="",LEXSHORT="",(LEXID,LEXSUB)="LEXKID" D MSG1
|
|
S LEXCHG=1,LEXEDT=$$NOW^XLFDT,LEXSCHG("0")="1"
|
|
S LEXSCHG("81",0)="",LEXSCHG("81.1",0)="",LEXSCHG("81.2",0)="",LEXSCHG("81.3",0)=""
|
|
S LEXSCHG("B","81")="",LEXSCHG("B","81.1")="",LEXSCHG("B","81.2")="",LEXSCHG("B","81.3")=""
|
|
S LEXSCHG("C","CPT","81")="",LEXSCHG("C","CPT","81.1")="",LEXSCHG("C","CPT","81.2")="",LEXSCHG("C","CPT","81.3")=""
|
|
S LEXSCHG("80",0)="",LEXSCHG("80.1",0)=""
|
|
S LEXSCHG("B","80")="",LEXSCHG("B","80.1")=""
|
|
S LEXSCHG("C","ICD","80")="",LEXSCHG("C","ICD","80.1")=""
|
|
S LEXSCHG("757",0)="",LEXSCHG("757.001",0)="",LEXSCHG("757.01",0)="",LEXSCHG("757.02",0)="",LEXSCHG("757.1",0)=""
|
|
S LEXSCHG("B","757")="",LEXSCHG("B","757.001")="",LEXSCHG("B","757.01")="",LEXSCHG("B","757.02")="",LEXSCHG("B","757.1")=""
|
|
S LEXSCHG("C","LEX","757")="",LEXSCHG("C","LEX","757.001")="",LEXSCHG("C","LEX","757.01")="",LEXSCHG("C","LEX","757.02")="",LEXSCHG("C","LEX","757.1")=""
|
|
S LEXSCHG("D","PRO")="",LEXSHORT=""
|
|
D DDUZ,CHGF,RTN,INST,NOTIFY,MSG2,KALL^LEXXGI2
|
|
Q
|
|
INST ; Installed Patches
|
|
N INST,STR D BL
|
|
S INST=$$PROK("PXRMCSD",9) S STR=" PXRM*2.0*9 "_$S(INST>0:"Installed",1:"Not Installed") D BM(STR),TL(STR)
|
|
S INST=$$PROK("ICDUPDT",28) S STR=" ICD*18.0*28 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
|
|
S INST=$$PROK("ICPTAU",34) S STR=" ICPT*6.0*34 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
|
|
S INST=$$PROK("LEXXGI",49) S STR=" LEX*2.0*49 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
|
|
Q
|
|
NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
|
|
N LEXP,X,STR
|
|
S STR="ERROR: Array of files not found" D:'$D(LEXSCHG) BM(STR),BL,TL(STR) Q:'$D(LEXSCHG)
|
|
S LEXP=+($O(^ORD(101,"B","LEXICAL SERVICES UPDATE",0)))
|
|
S STR="ERROR: LEXICAL SERVICES UPDATE protocol not found" D:$G(LEXP)'>0 BM(STR),BL,TL(STR) Q:LEXP=0
|
|
S X=LEXP_";ORD(101," D EN^XQOR
|
|
S STR="ERROR: LEXICAL SERVICES UPDATE protocol not invoked" D:$D(LEXSCHG) BM(STR),BL,TL(STR) Q:$D(LEXSCHG)
|
|
S ^LEXM(0,"PRO")=$$NOW^XLFDT,X="Protocol 'LEXICAL SERVICES UPDATE' was invoked"
|
|
W:'$D(XPDNM) !!,X D:$D(XPDNM) BM(X)
|
|
S (STR,X)="Subscribing applications were notified",STR=" "_STR D BL,TL(STR)
|
|
W:'$D(XPDNM) !,X D:$D(XPDNM) M(X)
|
|
Q
|
|
CHGF ; Change File
|
|
D M(" "),RI("Removing Change Files (757.9-757.91)","Remedy 175985") N FI,FNAME,ERR,ROK,STR
|
|
S FI=757.91,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
|
|
. N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
|
|
S FI=757.903,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
|
|
. N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
|
|
S FI=757.9,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
|
|
. N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
|
|
S FI=757.901,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
|
|
. N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
|
|
S FI=757.902,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
|
|
. N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
|
|
I '$D(^LEXC) S STR="Removed Change Files (757.9-757.91) (Remedy 175985)" D BL,TL(STR) Q
|
|
Q
|
|
RTN ; Routines
|
|
D M(" "),BL D DRTN,MRTN
|
|
Q
|
|
DRTN ; Delete Routines
|
|
N EXEC,ROK,RTN,STR,X
|
|
S X=$G(^%ZOSF("DEL")) Q:'$L(X) D ^DIM Q:'$D(X) Q:'$L(X) S EXEC=X
|
|
F RTN="LEXCHGF","LEXCHGF2","LEXNDX7","LEXXST5" D
|
|
. S ROK=+($$ROK(RTN)) I +ROK'>0 S STR=" "_RTN,STR=STR_$J(" ",(17-$L(STR)))_"Deleted" D M(STR),TL(STR) Q
|
|
. S X=RTN X EXEC
|
|
. S ROK=+($$ROK(RTN)) I +ROK'>0 S STR=" "_RTN,STR=STR_$J(" ",(17-$L(STR)))_"Deleted" D M(STR),TL(STR) Q
|
|
. S STR=" "_RTN D M(STR),TL(STR)
|
|
Q
|
|
MRTN ; Modified Routines
|
|
N CNT,EXEC,FIX,I,RTN,PN,PNO,STR,TXT,TY S CNT=0 F I=1:1 D Q:'$L(TXT)
|
|
. S TXT="" S EXEC="S TXT=$T(MRN+"_I_"^LEX2049P)" X EXEC
|
|
. S TXT=$P(TXT,";;",2,299) Q:TXT=""
|
|
. S RTN=$P(TXT,";",1) S:'$L(RTN) TXT="" Q:'$L(TXT) Q:+($$ROK(RTN))=0
|
|
. S PN=$P(TXT,";",2),TY=$P(TXT,";",3),FIX=$P(TXT,";",4)
|
|
. S PNO=$$PROK(RTN,PN)
|
|
. S STR=" "_RTN S:+PNO>0 STR=STR_$J(" ",(17-$L(STR)))_TY S:+PNO>0 STR=STR_$J(" ",(29-$L(STR)))_FIX
|
|
. D M(STR),TL(STR)
|
|
Q
|
|
MRN ; Modified Routine Names
|
|
;;LEXXFI;49;Modified;Removed references to file #757.9
|
|
;;LEXXFI7;49;Modified;Removed references to file #757.9
|
|
;;LEXXST;49;Modified;Removed references to file #757.9
|
|
;;LEXXGI;49;Modified;Fix LEXICAL SERVICES UPDATE Protocol
|
|
;;LEXXGI2;49;Modified;Fix LEXICAL SERVICES UPDATE Protocol
|
|
;;LEXXII;49;Modified;Fix Install Message (Protocol)
|
|
;;ICDUPDT;28;Modified;Fix ICD CODE UPDATE EVENT Protocol
|
|
;;ICPTAU;34;Modified;Fix ICPT CODE UPDATE EVENT Protocol
|
|
;;PXRMCSD;9;Modified;Fix ICD/CPT Reminder Dialogs Message
|
|
;;PXRMCSTX;9;Modified;Fix ICD/CPT Reminder Taxonomies Message
|
|
;;
|
|
DDUZ ; Delete Exported DUZ if broken Pointer
|
|
N STR S STR="Removing broken Pointer in file #757.2"
|
|
D M(" "),RI(STR,"ROF LEX*2.0*46") S STR=STR_" (ROF LEX*2.0*46)" Q:$L($$GET1^DIQ(200,("1118,"),.01))
|
|
D BL,TL(STR) N DA,DIK,NAME,SSIEN S SSIEN=0 F S SSIEN=$O(^LEXT(757.2,SSIEN)) Q:+SSIEN'>0 D
|
|
. Q:'$D(^LEXT(757.2,SSIEN,200)) Q:$O(^LEXT(757.2,SSIEN,200,0))'>0 Q:'$D(^LEXT(757.2,SSIEN,200,1118))
|
|
. N DA,DIK,NAME S NAME=$P($G(^LEXT(757.2,SSIEN,0)),"^",1) D:$L(NAME) CI((" "_NAME))
|
|
. S DA(1)=SSIEN,DA=1118,DIK="^LEXT(757.2,"_SSIEN_",200," D ^DIK
|
|
Q
|
|
ROK(X) ; Routine OK
|
|
S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
|
|
PROK(X,Y) ; Routine and Patch # OK (in UCI)
|
|
N LEX,LEXI,LEXO S X=$G(X),Y=$G(Y) Q:'$L(X) 0 Q:Y'=""&(+Y=0)
|
|
S Y=+Y,LEX=$$ROK(X) Q:'LEX 0 Q:+Y=0 1 S LEXO=0,LEX=$T(@("+2^"_X)),LEX=$P($P(LEX,"**",2),"**",1)
|
|
F LEXI=1:1:$L(LEX,",") S:+($P(LEX,",",LEXI))=Y LEXO=1 Q:LEXO=1
|
|
S X=LEXO
|
|
Q X
|
|
LL(T,X) ; Line Label
|
|
N RTN,TAG,ROK,EXEC,OK S TAG=$G(T),RTN=$G(X) Q:'$L(RTN) 0 S ROK=$$ROK(RTN) Q:+ROK'>0 0 S:'$L(TAG)&($L(RTN)) TAG=RTN
|
|
S OK=0,EXEC="S OK=$L($T("_TAG_"^"_RTN_")) S OK=$S(OK>0:1,1:0)" X EXEC S X=+($G(OK))
|
|
Q X
|
|
MSG1 ; Send Installation Message to G.LEXICON
|
|
K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
|
|
K ^TMP("LEXINS",$J),^TMP("LEXKID",$J) S:$D(ZTQUEUED) ZTREQ="@"
|
|
N LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID,ZTQUEUED
|
|
S LEXID="LEXKID",LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC,ZTQUEUED)=0
|
|
D HDR^LEXXFI,EN^LEXXII K ^LEXM(0,"PRO")
|
|
Q
|
|
MSG2 ; Send Installation (part 2)
|
|
N LEXSHORT,ZTQUEUED,LEXBUILD S ZTQUEUED=0,LEXSHORT=1,LEXBUILD="LEX*2.0*49"
|
|
D MAIL^LEXXFI,KILL^LEXXFI
|
|
Q
|
|
ENV(X) ; Environment check
|
|
N LEXNM D HOME^%ZIS S U="^",DT=$$DT^XLFDT,LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01),DTIME=$$DTIME^XUP(+($G(DUZ))) Q:+($G(DUZ))'>0!('$L(LEXNM)) 0
|
|
Q 1
|
|
ED(LEX) ; External Date MM/DD/YYYY TT:TT
|
|
N XPDNM S LEX=$$FMTE^XLFDT($G(LEX),"1Z") S:LEX["@" LEX=$P(LEX,"@",1)_" "_$P(LEX,"@",2,299)
|
|
Q LEX
|
|
RI(X,Y) ; Reference - Indented
|
|
N I S X=$G(X),Y=$G(Y) Q:'$L(X)
|
|
I $L(Y) S X=" "_X F Q:$L(X)>54 S X=X_" "
|
|
S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X) Q
|
|
CI(X) ; Comment Text - Indented
|
|
N I S X=$G(X) Q:'$L(X) S X=" "_X D MES^XPDUTL(X)
|
|
Q
|
|
BL ; Blank Line
|
|
D TL("") Q
|
|
TL(LEXX) ; Text Line
|
|
S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
|
|
I '$D(^TMP(LEXSUB,$J,1)) S ^TMP(LEXSUB,$J,1)=" ",^TMP(LEXSUB,$J,0)=1
|
|
N LEXNX S LEXNX=$O(^TMP(LEXSUB,$J," "),-1),LEXNX=LEXNX+1
|
|
S ^TMP(LEXSUB,$J,LEXNX)=" "_$G(LEXX),^TMP(LEXSUB,$J,0)=LEXNX
|
|
Q
|
|
BM(X) ; Blank and Line
|
|
D BMES^XPDUTL($G(X))
|
|
Q
|
|
M(X) ; Line
|
|
D MES^XPDUTL($G(X))
|
|
Q
|