source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXST3.m@ 1211

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1LEXXST3 ; ISL Lexicon Status (KIDS/Routines Patch) ; 05/14/2003
2 ;;2.0;LEXICON UTILITY;**4,5,8,25**;Sep 23, 1996;Build 1
3 Q
4KIDS ; KIDS entries
5 N LEXBLD D GB,SB Q
6GB ; Get KIDs builds
7 K LEXBLD Q:'$D(^DIC(9.4,"C","LEX"))
8 N LEXC,LEXIN,LEXPIN,LEXPN,LEXPA S LEXPA=$$PAC("LEX") Q:LEXPA=0
9 N LEXB S LEXB=0 F S LEXB=$O(^XPD(9.6,"C",LEXPA,LEXB)) Q:+LEXB=0 D
10 . S LEXPN=$P($G(^XPD(9.6,LEXB,0)),"^",1)
11 . S LEXIN=$$INS(LEXPN)
12 . I LEXPN'["*" D
13 . . S LEXC=+($G(LEXBLD(1,0))),LEXC=LEXC+1
14 . . S LEXBLD(1,0)=LEXC,LEXBLD(1,LEXC)=LEXB_"^"_LEXPN_"^"_LEXIN
15 . I LEXPN["*" D
16 . . S LEXC=+($P(LEXPN,"*",3)) I $D(LEXBLD(2,LEXC)) D
17 . . . S LEXC=LEXC+99999
18 . . S LEXBLD(2,0)=LEXC,LEXBLD(2,LEXC)=LEXB_"^"_LEXPN_"^"_LEXIN
19 Q
20SB ; Save KIDs builds
21 I '$D(LEXBLD) D NOINS Q
22 I +($G(LEXBLD(1,0)))=0 D NOPAC G SP
23 N LEXLN,LEXIN I +($G(LEXBLD(1,0)))>0 D
24 . D BL,TT("KIDS INSTALLATION (PACKAGE)"),BL
25 . N LEXI S LEXI=0 F S LEXI=$O(LEXBLD(1,LEXI)) Q:+LEXI=0 D
26 . . S LEXLN=$P($G(LEXBLD(1,LEXI)),"^",2) Q:'$L(LEXLN)
27 . . S LEXIN=$P($G(LEXBLD(1,LEXI)),"^",3) S:$L(LEXIN) LEXLN=LEXLN_$J("",(40-$L(LEXLN)))_" "_LEXIN
28 . . S LEXLN=" "_LEXLN D TL(LEXLN)
29SP ; Save patches
30 I +($G(LEXBLD(2,0)))=0 D NOPAT Q
31 I +($G(LEXBLD(2,0)))>0 D
32 . D BL,TT("KIDS INSTALLATIONS (PATCHES)"),BL
33 . N LEXI S LEXI=0 F S LEXI=$O(LEXBLD(2,LEXI)) Q:+LEXI=0 D
34 . . S LEXLN=$P($G(LEXBLD(2,LEXI)),"^",2) Q:'$L(LEXLN)
35 . . S LEXIN=$P($G(LEXBLD(2,LEXI)),"^",3) S:$L(LEXIN) LEXLN=LEXLN_$J("",(40-$L(LEXLN)))_" "_LEXIN
36 . . S LEXLN=" "_LEXLN D TL(LEXLN)
37 Q
38NOINS ; None found
39 D BL,TT("KIDS INSTALLATION (PACKAGE/PATCHES)"),BL D TL(" NONE FOUND") Q
40NOPAC ; No package
41 D BL,TT("KIDS INSTALLATION (PACKAGE)"),BL,TL(" NONE FOUND") Q
42NOPAT ; No patches
43 D BL,TT("KIDS INSTALLATIONS (PATCHES)"),BL,TL(" NONE FOUND") Q
44PAC(LEXX) ; Package Entry
45 S LEXX=+($O(^DIC(9.4,"C",LEXX,0))) Q LEXX
46INS(LEXX) ; Installation Entry
47 S LEXX=$G(LEXX) Q:LEXX="" LEXX Q:'$D(^XPD(9.7,"B",LEXX)) ""
48 N LEXIA,LEXM,LEXI S (LEXIA,LEXM)=0
49 F S LEXIA=$O(^XPD(9.7,"B",LEXX,LEXIA)) Q:+LEXIA=0 D
50 . S LEXI=$P($G(^XPD(9.7,LEXIA,1)),"^",3),LEXI=+LEXI
51 . S:LEXI>LEXM LEXM=LEXI
52 S:+LEXM=0 LEXM="" S:+LEXM>0 LEXM=$$FTE^LEXXST4(+LEXM)
53 S LEXX=LEXM Q LEXX
54 ;
55RTN ; Find Patched Routines
56 I '$D(^DIC(9.4,"C","LEX"))!('$D(^DIC(9.8,"B","LEXA1"))) D NORTN Q
57 N LEX,LEXPT,LEXP,LEXRT,LEXC,LEXT S LEXRT="LEW~",LEXC="LEX"
58 ; PCH 5 replace indirection $T(@LEXRT) with executable string
59 F S LEXRT=$O(^DIC(9.8,"B",LEXRT)) Q:LEXRT=""!($E(LEXRT,1,$L(LEXC))'=LEXC) D
60 . ; PCH 8 quit if routine is a environment check, pre/post install
61 . Q:$E(LEXRT,4)?1N
62 . N LEXEXC,X S X=LEXRT X ^%ZOSF("TEST") I $T D
63 . . S LEXT="",LEXEXC="S LEXT=$T("_LEXRT_"+1^"_LEXRT_")" X LEXEXC
64 . . S LEXT=$G(LEXT),LEXP=$$TRIM($P($G(LEXT),";",5)) I +LEXP>0 D
65 . . . N LEXPN,LEXPT F LEXPN=1:1 Q:$P(LEXP,",",LEXPN)="" D
66 . . . . S LEXPT=$P(LEXP,",",LEXPN) I '$D(LEX(LEXPT,LEXRT)) D
67 . . . . . N LEXI F LEXI=1:1 Q:$L($G(LEX(LEXPT,LEXI)))<200
68 . . . . . S LEX(LEXPT,LEXI)=$G(LEX(LEXPT,LEXI))_", "_LEXRT,LEX(LEXPT,LEXRT)=""
69 . . . . . S:$E($G(LEX(LEXPT,LEXI)),1,2)=", " LEX(LEXPT,LEXI)=$E(LEX(LEXPT,LEXI),3,$L(LEX(LEXPT,LEXI)))
70 D PAT
71 Q
72PAT ; Save Patch Routines
73 D:+($O(LEX(0)))=0 NORTN Q:+($O(LEX(0)))=0
74 D:+($O(LEX(0)))>0 BL,TT("PATCHED ROUTINES")
75 N LEXSP,LEXLN,LEXLP S LEXLP=+($O(LEX(9999999),-1)),LEXSP=" "
76 I LEXLP>0 D BL,TL((" LAST ROUTINE PATCH # "_LEXLP))
77 I +($O(LEX(0)))>0 D BL,TL(" PATCH ROUTINES"),TL(" ------------------------------------------------------------------------")
78 N LEXPN,LEXI S LEXPN=0 F S LEXPN=$O(LEX(LEXPN)) Q:+LEXPN=0 F LEXI=1:1 Q:'$D(LEX(LEXPN,LEXI)) D
79 . S LEXLN=$G(LEX(LEXPN,LEXI)) I $L(LEXLN),LEXI'>1 S LEXLN=$J("",(9-$L(LEXPN)))_LEXPN_" "_LEXLN D PL(LEXLN,LEXI)
80 . I $L(LEXLN),LEXI>1 D PL(LEXLN,LEXI)
81 D:+($O(LEX(0)))>0 BL
82 Q
83PL(LEXX,LEXI) ; Patch Line
84 S LEXX=$G(LEXX) Q:'$L(LEXX) S LEXI=+($G(LEXI)) I LEXI>1 D
85 . N LEXNX,LEXNI S LEXNI=$O(^TMP("LEXINS",$J,9999999999),-1) Q:+LEXNI'>0
86 . S LEXNX=$G(^TMP("LEXINS",$J,LEXNI))
87 . I $L(LEXNX) D
88 . . K ^TMP("LEXINS",$J,LEXNI)
89 . . S ^TMP("LEXINS",$J,0)=(LEXNI-1),LEXX=LEXNX_", "_LEXX
90 N LEXLL S LEXLL=78 S:LEXI>1 LEXLL=60 D:$L(LEXX)'>LEXLL TL(LEXX) Q:$L(LEXX)'>LEXLL N LEXP,LEXNL
91PL2 ; Patch Line (over 78 characters)
92 F LEXP=78:-1:1 Q:$E(LEXX,(LEXP-1),LEXP)=", "
93 I LEXP>1 S LEXNL=$E(LEXX,1,(LEXP-1)) D TL(LEXNL) S LEXX=$E(LEXX,(LEXP+1),$L(LEXX))
94 S LEXLL=60 I $L(LEXX)>LEXLL S LEXX=LEXSP_LEXX G PL2
95 S:$L(LEXX)'>LEXLL&(LEXX'[LEXSP) LEXX=LEXSP_LEXX D TL(LEXX)
96 Q
97NORTN ; No patched routines found
98 D BL,TT("PATCHED ROUTINES"),BL D TL(" NONE FOUND") Q
99TT(LEXX) ; Title Line
100 D TT^LEXXST($G(LEXX)) Q
101TL(LEXX) ; Text Line
102 D TL^LEXXST($G(LEXX)) Q
103BL ; Blank Line
104 D BL^LEXXST Q
105TRIM(LEXX) ; Trim spaces
106 S LEXX=$G(LEXX),LEXX=$TR(LEXX,"*","")
107 F Q:$E(LEXX,1)'=" " S LEXX=$E(LEXX,2,$L(LEXX))
108 F Q:$E(LEXX,$L(LEXX))'=" " S LEXX=$E(LEXX,1,($L(LEXX)-1))
109 F Q:LEXX'[" " S LEXX=$P(LEXX," ",1)_" "_$P(LEXX," ",2)
110 Q LEXX
111 Q
Note: See TracBrowser for help on using the repository browser.