source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2049P.m@ 1722

Last change on this file since 1722 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.2 KB
Line 
1LEX2049P ; ISL/OI - Post Install LEX*2.0*49 ; 02/22/2007
2 ;;2.0;LEXICON UTILITY;**49**;Sep 23, 1996;Build 3
3 ;
4 ; Global Variables
5 ; ^%ZOSF("DEL"
6 ; ^%ZOSF("TEST"
7 ; ^LEXC
8 ; ^LEXM(0
9 ; ^LEXT(757.2
10 ; ^ORD(101
11 ; ^TMP("LEXCNT"
12 ; ^TMP("LEXCS"
13 ; ^TMP("LEXI"
14 ; ^TMP("LEXINS"
15 ; ^TMP("LEXKID"
16 ; ^TMP("LEXMSG"
17 ;
18 ; External References
19 ; HOME^%ZIS
20 ; $$GET1^DID
21 ; ^DIK
22 ; ^DIM
23 ; $$GET1^DIQ
24 ; EN^DIU2
25 ; $$DT^XLFDT
26 ; $$FMTE^XLFDT
27 ; $$NOW^XLFDT
28 ; BMES^XPDUTL
29 ; MES^XPDUTL
30 ; EN^XQOR
31 ; $$DTIME^XUP
32 ;
33POST ; Post-Install Main Entry Point
34 N CNT,DA,DIK,DIU,ERR,EXEC,FI,FIX,FNAME,I,INST,LEX,LEXBEG,LEXBUILD,LEXCHG,LEXEDT,LEXELP,LEXEND
35 N LEXFC,LEXI,LEXID,LEXMOD,LEXMUL,LEXNM,LEXO,LEXP,LEXPOST,LEXSCHG,LEXSHORT,LEXSUB,LEXTCS,LEXTND
36 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
37 S LEXCHG=1,LEXEDT=$$NOW^XLFDT,LEXSCHG("0")="1"
38 S LEXSCHG("81",0)="",LEXSCHG("81.1",0)="",LEXSCHG("81.2",0)="",LEXSCHG("81.3",0)=""
39 S LEXSCHG("B","81")="",LEXSCHG("B","81.1")="",LEXSCHG("B","81.2")="",LEXSCHG("B","81.3")=""
40 S LEXSCHG("C","CPT","81")="",LEXSCHG("C","CPT","81.1")="",LEXSCHG("C","CPT","81.2")="",LEXSCHG("C","CPT","81.3")=""
41 S LEXSCHG("80",0)="",LEXSCHG("80.1",0)=""
42 S LEXSCHG("B","80")="",LEXSCHG("B","80.1")=""
43 S LEXSCHG("C","ICD","80")="",LEXSCHG("C","ICD","80.1")=""
44 S LEXSCHG("757",0)="",LEXSCHG("757.001",0)="",LEXSCHG("757.01",0)="",LEXSCHG("757.02",0)="",LEXSCHG("757.1",0)=""
45 S LEXSCHG("B","757")="",LEXSCHG("B","757.001")="",LEXSCHG("B","757.01")="",LEXSCHG("B","757.02")="",LEXSCHG("B","757.1")=""
46 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")=""
47 S LEXSCHG("D","PRO")="",LEXSHORT=""
48 D DDUZ,CHGF,RTN,INST,NOTIFY,MSG2,KALL^LEXXGI2
49 Q
50INST ; Installed Patches
51 N INST,STR D BL
52 S INST=$$PROK("PXRMCSD",9) S STR=" PXRM*2.0*9 "_$S(INST>0:"Installed",1:"Not Installed") D BM(STR),TL(STR)
53 S INST=$$PROK("ICDUPDT",28) S STR=" ICD*18.0*28 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
54 S INST=$$PROK("ICPTAU",34) S STR=" ICPT*6.0*34 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
55 S INST=$$PROK("LEXXGI",49) S STR=" LEX*2.0*49 "_$S(INST>0:"Installed",1:"Not Installed") D M(STR),TL(STR)
56 Q
57NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
58 N LEXP,X,STR
59 S STR="ERROR: Array of files not found" D:'$D(LEXSCHG) BM(STR),BL,TL(STR) Q:'$D(LEXSCHG)
60 S LEXP=+($O(^ORD(101,"B","LEXICAL SERVICES UPDATE",0)))
61 S STR="ERROR: LEXICAL SERVICES UPDATE protocol not found" D:$G(LEXP)'>0 BM(STR),BL,TL(STR) Q:LEXP=0
62 S X=LEXP_";ORD(101," D EN^XQOR
63 S STR="ERROR: LEXICAL SERVICES UPDATE protocol not invoked" D:$D(LEXSCHG) BM(STR),BL,TL(STR) Q:$D(LEXSCHG)
64 S ^LEXM(0,"PRO")=$$NOW^XLFDT,X="Protocol 'LEXICAL SERVICES UPDATE' was invoked"
65 W:'$D(XPDNM) !!,X D:$D(XPDNM) BM(X)
66 S (STR,X)="Subscribing applications were notified",STR=" "_STR D BL,TL(STR)
67 W:'$D(XPDNM) !,X D:$D(XPDNM) M(X)
68 Q
69CHGF ; Change File
70 D M(" "),RI("Removing Change Files (757.9-757.91)","Remedy 175985") N FI,FNAME,ERR,ROK,STR
71 S FI=757.91,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
72 . N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
73 S FI=757.903,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
74 . N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
75 S FI=757.9,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
76 . N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
77 S FI=757.901,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
78 . N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
79 S FI=757.902,FNAME=$$GET1^DID(FI,"","","NAME","","ERR") I $L(FNAME) D
80 . N DIU,ERR S DIU="^LEXC("_FI_",",DIU(0)="D" D EN^DIU2 K:'$L($$GET1^DID(FI,"","","NAME","","ERR")) ^LEXC(FI)
81 I '$D(^LEXC) S STR="Removed Change Files (757.9-757.91) (Remedy 175985)" D BL,TL(STR) Q
82 Q
83RTN ; Routines
84 D M(" "),BL D DRTN,MRTN
85 Q
86DRTN ; Delete Routines
87 N EXEC,ROK,RTN,STR,X
88 S X=$G(^%ZOSF("DEL")) Q:'$L(X) D ^DIM Q:'$D(X) Q:'$L(X) S EXEC=X
89 F RTN="LEXCHGF","LEXCHGF2","LEXNDX7","LEXXST5" D
90 . S ROK=+($$ROK(RTN)) I +ROK'>0 S STR=" "_RTN,STR=STR_$J(" ",(17-$L(STR)))_"Deleted" D M(STR),TL(STR) Q
91 . S X=RTN X EXEC
92 . S ROK=+($$ROK(RTN)) I +ROK'>0 S STR=" "_RTN,STR=STR_$J(" ",(17-$L(STR)))_"Deleted" D M(STR),TL(STR) Q
93 . S STR=" "_RTN D M(STR),TL(STR)
94 Q
95MRTN ; Modified Routines
96 N CNT,EXEC,FIX,I,RTN,PN,PNO,STR,TXT,TY S CNT=0 F I=1:1 D Q:'$L(TXT)
97 . S TXT="" S EXEC="S TXT=$T(MRN+"_I_"^LEX2049P)" X EXEC
98 . S TXT=$P(TXT,";;",2,299) Q:TXT=""
99 . S RTN=$P(TXT,";",1) S:'$L(RTN) TXT="" Q:'$L(TXT) Q:+($$ROK(RTN))=0
100 . S PN=$P(TXT,";",2),TY=$P(TXT,";",3),FIX=$P(TXT,";",4)
101 . S PNO=$$PROK(RTN,PN)
102 . S STR=" "_RTN S:+PNO>0 STR=STR_$J(" ",(17-$L(STR)))_TY S:+PNO>0 STR=STR_$J(" ",(29-$L(STR)))_FIX
103 . D M(STR),TL(STR)
104 Q
105MRN ; Modified Routine Names
106 ;;LEXXFI;49;Modified;Removed references to file #757.9
107 ;;LEXXFI7;49;Modified;Removed references to file #757.9
108 ;;LEXXST;49;Modified;Removed references to file #757.9
109 ;;LEXXGI;49;Modified;Fix LEXICAL SERVICES UPDATE Protocol
110 ;;LEXXGI2;49;Modified;Fix LEXICAL SERVICES UPDATE Protocol
111 ;;LEXXII;49;Modified;Fix Install Message (Protocol)
112 ;;ICDUPDT;28;Modified;Fix ICD CODE UPDATE EVENT Protocol
113 ;;ICPTAU;34;Modified;Fix ICPT CODE UPDATE EVENT Protocol
114 ;;PXRMCSD;9;Modified;Fix ICD/CPT Reminder Dialogs Message
115 ;;PXRMCSTX;9;Modified;Fix ICD/CPT Reminder Taxonomies Message
116 ;;
117DDUZ ; Delete Exported DUZ if broken Pointer
118 N STR S STR="Removing broken Pointer in file #757.2"
119 D M(" "),RI(STR,"ROF LEX*2.0*46") S STR=STR_" (ROF LEX*2.0*46)" Q:$L($$GET1^DIQ(200,("1118,"),.01))
120 D BL,TL(STR) N DA,DIK,NAME,SSIEN S SSIEN=0 F S SSIEN=$O(^LEXT(757.2,SSIEN)) Q:+SSIEN'>0 D
121 . Q:'$D(^LEXT(757.2,SSIEN,200)) Q:$O(^LEXT(757.2,SSIEN,200,0))'>0 Q:'$D(^LEXT(757.2,SSIEN,200,1118))
122 . N DA,DIK,NAME S NAME=$P($G(^LEXT(757.2,SSIEN,0)),"^",1) D:$L(NAME) CI((" "_NAME))
123 . S DA(1)=SSIEN,DA=1118,DIK="^LEXT(757.2,"_SSIEN_",200," D ^DIK
124 Q
125ROK(X) ; Routine OK
126 S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
127PROK(X,Y) ; Routine and Patch # OK (in UCI)
128 N LEX,LEXI,LEXO S X=$G(X),Y=$G(Y) Q:'$L(X) 0 Q:Y'=""&(+Y=0)
129 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)
130 F LEXI=1:1:$L(LEX,",") S:+($P(LEX,",",LEXI))=Y LEXO=1 Q:LEXO=1
131 S X=LEXO
132 Q X
133LL(T,X) ; Line Label
134 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
135 S OK=0,EXEC="S OK=$L($T("_TAG_"^"_RTN_")) S OK=$S(OK>0:1,1:0)" X EXEC S X=+($G(OK))
136 Q X
137MSG1 ; Send Installation Message to G.LEXICON
138 K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
139 K ^TMP("LEXINS",$J),^TMP("LEXKID",$J) S:$D(ZTQUEUED) ZTREQ="@"
140 N LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID,ZTQUEUED
141 S LEXID="LEXKID",LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC,ZTQUEUED)=0
142 D HDR^LEXXFI,EN^LEXXII K ^LEXM(0,"PRO")
143 Q
144MSG2 ; Send Installation (part 2)
145 N LEXSHORT,ZTQUEUED,LEXBUILD S ZTQUEUED=0,LEXSHORT=1,LEXBUILD="LEX*2.0*49"
146 D MAIL^LEXXFI,KILL^LEXXFI
147 Q
148ENV(X) ; Environment check
149 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
150 Q 1
151ED(LEX) ; External Date MM/DD/YYYY TT:TT
152 N XPDNM S LEX=$$FMTE^XLFDT($G(LEX),"1Z") S:LEX["@" LEX=$P(LEX,"@",1)_" "_$P(LEX,"@",2,299)
153 Q LEX
154RI(X,Y) ; Reference - Indented
155 N I S X=$G(X),Y=$G(Y) Q:'$L(X)
156 I $L(Y) S X=" "_X F Q:$L(X)>54 S X=X_" "
157 S X=X_" "_Y S:$E(X,1)'=" " X=" "_X D MES^XPDUTL(X) Q
158CI(X) ; Comment Text - Indented
159 N I S X=$G(X) Q:'$L(X) S X=" "_X D MES^XPDUTL(X)
160 Q
161BL ; Blank Line
162 D TL("") Q
163TL(LEXX) ; Text Line
164 S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
165 I '$D(^TMP(LEXSUB,$J,1)) S ^TMP(LEXSUB,$J,1)=" ",^TMP(LEXSUB,$J,0)=1
166 N LEXNX S LEXNX=$O(^TMP(LEXSUB,$J," "),-1),LEXNX=LEXNX+1
167 S ^TMP(LEXSUB,$J,LEXNX)=" "_$G(LEXX),^TMP(LEXSUB,$J,0)=LEXNX
168 Q
169BM(X) ; Blank and Line
170 D BMES^XPDUTL($G(X))
171 Q
172M(X) ; Line
173 D MES^XPDUTL($G(X))
174 Q
Note: See TracBrowser for help on using the repository browser.