source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPEFKPC.m@ 1000

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1VEPEFKPC ; install and build file checker
2 ;;1.0;VEPE - DAOU SYSTEMS;**1**; 01-OCT-2003
3 ;; Copyright 2003 Daou Systems, Inc.
4 ;
5 Q
6EN(XPDT,XPDQUIT,TARBLD) ; entry point
7 ;
8 ; XPDT is an array passed into this routine -
9 ; XPDT(ien) = [1] Transport global Install IEN
10 ; [2] Name of Patch being installed
11 ; XPDQUIT is an output variable indicating if the Install should stop
12 ; TARBLD is the IEN of the target build that you want to check to see
13 ; if there is any overlap
14 ;
15 NEW OK,IEN,INST,NAME,BLD,BCIEN,BCTYP,BCNAME,DIR,X,Y
16 NEW DTOUT,DUOUT,DIRUT,DIROUT,GLO,TARBLDNM
17 NEW FILNUM,SUBFIL,FIELD
18 I '$G(TARBLD) S XPDQUIT=1 G EXIT
19 S OK=1,TARBLDNM=$P($G(^XPD(9.6,TARBLD,0)),U,1)
20 S IEN=0
21 F S IEN=$O(XPDT(IEN)) Q:'IEN D
22 . S INST=$P(XPDT(IEN),U,1)
23 . S NAME=$P(XPDT(IEN),U,2)
24 . S BLD=$O(^XPD(9.6,"B",NAME,"")) ; build file
25 . W !!?3,"Checking ",NAME," for overlap with ",TARBLDNM," "
26 . I BLD S GLO="^XPD(9.6,BLD)" ; build file
27 . E D I 'OK Q
28 .. S BLD=$O(^XTMP("XPDI",INST,"BLD",0))
29 .. I 'BLD W "NO BUILD FOUND!!" S OK=0 Q
30 .. S GLO="^XTMP(""XPDI"",INST,""BLD"",BLD)" ; transport global
31 .. Q
32 . ;
33 . ;
34 . ; loop thru all build components in the incoming build
35 . S BCIEN=0
36 . F S BCIEN=$O(@GLO@("KRN",BCIEN)) Q:'BCIEN D
37 .. I '$P($G(@GLO@("KRN",BCIEN,"NM",0)),U,4) Q
38 .. S BCTYP=$P($G(^DIC(BCIEN,0)),U,1) ; build component type
39 .. W "." ; display "." for each type of build component found
40 .. S BCNAME=""
41 .. F S BCNAME=$O(@GLO@("KRN",BCIEN,"NM","B",BCNAME)) Q:BCNAME="" D
42 ... I '$D(^XPD(9.6,TARBLD,"KRN",BCIEN,"NM","B",BCNAME)) Q
43 ... W !?8,BCNAME,?54,BCTYP," OVERLAP"
44 ... S OK=0
45 ... Q
46 .. Q
47 . ;
48 . ;
49 . ; DATA DICTIONARIES
50 . S FILNUM="" W "."
51 . F S FILNUM=$O(@GLO@(4,"APDD",FILNUM)) Q:FILNUM="" D
52 .. S SUBFIL=""
53 .. F S SUBFIL=$O(@GLO@(4,"APDD",FILNUM,SUBFIL)) Q:SUBFIL="" D
54 ... ; if the $D'=11 and the same DD/multiple is in the target build,
55 ... ; then display a message and quit
56 ... I $D(@GLO@(4,"APDD",FILNUM,SUBFIL))'=11,$D(^XPD(9.6,TARBLD,4,"APDD",FILNUM,SUBFIL)) W !?8,FILNUM,"/",SUBFIL,?54,"Data Dictionary overlap" S OK=0 Q
57 ... ; now look at all the fields
58 ... S FIELD=""
59 ... F S FIELD=$O(@GLO@(4,"APDD",FILNUM,SUBFIL,FIELD)) Q:FIELD="" D
60 .... I '$D(^XPD(9.6,TARBLD,4,"APDD",FILNUM,SUBFIL,FIELD)) Q
61 .... W !?8,FILNUM,"/",SUBFIL,":",FIELD,?54,"Data Dictionary overlap"
62 .... S OK=0
63 .... Q
64 ... Q
65 .. Q
66 . ;
67 . I OK W " OK",!?12,"No overlap found"
68 . ;
69 . Q
70 ;
71 I OK W ! G EXIT
72 ;
73 W !!?5,"Some overlap was found as listed above"
74 S DIR(0)="Y"
75 S DIR("A")=" Do you want to Quit this install so you can review the situation"
76 S DIR("B")="YES"
77 D ^DIR K DIR
78 I 'Y G EXIT ; no, don't quit the installation, get out of here
79 ; At this point, yes, quit the installation
80 ; set variable to quit the installation
81 S XPDQUIT=1
82 ; ***
83EXIT ;
84 Q
85 ;
86 ;
87 ; This is where it goes!
88 ;
89 ;XPDI ;SFISC/RSD - Install Process ;11/20/2000 14:22
90 ; ;;8.0;KERNEL;**10,21,39,41,44,58,68,108,145,184**;Jul 10, 1995
91 ;EN ;install
92 ; N DIR,DIRUT,POP,XPD,XPDA,XPDD,XPDIJ,XPDDIQ,XPDIT,XPDIABT,XPDNM,XPDNOQUE,XPDPKG,XPDREQAB,XPDST,XPDSET,XPDSET1,XPDT,XPDQUIT,XPDQUES,Y,ZTSK,%
93 ; S %="I '$P(^(0),U,9),$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))",
94 ;XPDST=$$LOOK^XPDI1(%)
95 ; Q:'XPDST!$D(XPDQUIT)
96 ; ;;;
97 ; D EN^VEPEFKPC(.XPDT,.XPDQUIT,xxxxxx) Q:$D(XPDQUIT)
98 ; where xxxxxx is the IEN of the target build
99 ; in ^XPD(9.6,xxxxxx,0)
100 ; ;;;
101 ; S XPDIT=0,(XPDSET,XPDSET1)=$P(^XPD(9.7,XPDST,0),U) K ^TMP($J)
102 ; ;Check each part of XPDT array
Note: See TracBrowser for help on using the repository browser.