source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDE.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.3 KB
RevLine 
[613]1XPDE ;SFISC/RSD - Package Edit ;05/08/2003 11:58
2 ;;8.0;KERNEL;**2,15,21,44,51,68,131,182,201,229,302**;Jul 10, 1995
3 Q
4 ;these tags are called from options.
5EDIT ;edit Build file package
6 N DA,DIR,DDSFILE,DR,Y,Z
7 Q:'$$DIC("AEMQLZ","",1) S DA=+Y
8 I $P(Y,U,3) D NEW(DA)
9 S Z=$P(^XPD(9.6,DA,0),U,3)+1,DR="["_$P("XPD EDIT BUILD^XPD EDIT MP^XPD EDIT GP",U,Z)_"]",DDSFILE="^XPD(9.6,"
10 D ^DDS Q:'$G(DA)
11 ;if full DD, kill multiple for partial DD
12 S Y=0 F S Y=$O(^XPD(9.6,DA,4,Y)) Q:'Y S Z=$G(^(Y,222)) D
13 .K:$P(Z,U,3)="f" ^XPD(9.6,DA,4,Y,2),^XPD(9.6,DA,4,"APDD",Y)
14 D QUIT(DA)
15 Q
16COPY ;copy a Build file package
17 N DA,DIK,DIR,FR,FR0,TO,TO0,X,Y,Z W !
18 Q:'$$DIC("QEAMZ","Copy FROM what Package: ")
19 S FR=+Y,FR0=Y(0),Z="QEAMZL",Z("S")="I Y'="_FR
20 I '$$DIC(.Z,"Copy TO what Package: ") D QUIT(FR) Q
21 S TO=Y,TO0=Y(0)
22 ;if this is not new, then it will be purged before copy.
23 I '$P(TO,U,3) W !,$P(TO0,U)," package will be PURGED before the copy."
24 W ! S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="YES" D ^DIR
25 S DIK="^XPD(9.6,",DA=+TO
26 I 'Y!$D(DIRUT) D W ! Q
27 .;they didn't want to continue, kill if it was a new package.
28 .I $P(TO,U,3) D ^DIK W $P(TO0,U)," being deleted!"
29 .;unlock both packages
30 .D QUIT(FR),QUIT(TO)
31 D WAIT^DICD
32 ;if not new, kill old data
33 K:'$P(TO,U,3) ^XPD(9.6,DA)
34 M ^XPD(9.6,DA)=^XPD(9.6,FR) S $P(^(DA,0),U)=$P(TO0,U)
35 D NEW(+TO)
36 ;if new National Package name, then kill x-ref
37 I $P(TO0,U,2)]"",$P(FR0,U,2)'=$P(TO0,U,2) K ^XPD(9.6,"C",$E($P(TO0,U,2),1,30),DA) S DIK(1)=1 D EN1^DIK
38 D QUIT(FR),QUIT(TO)
39 W "...Done.",!
40 Q
41BUILD ;build package from a namespace
42 N DIR,DIRUT,XPDA,XPDI,XPDF,XPDN,XPDX,XPDXL,X,X1,Y,Y1 W !
43 Q:'$$DIC("QEAML")
44 S XPDA=+Y W !
45 I $P(^XPD(9.6,XPDA,0),U,3) W !,"The Build Type must be SINGLE PACKAGE!!",! Q
46 ;if not a new package
47 I '$P(Y,U,3) D I $D(DIRUT) D QUIT(XPDA) Q
48 .S DIR(0)="Y",DIR("A")="Package already exists, Want to PURGE the existing data",DIR("B")="NO",DIR("?")="YES will delete all the KERNEL FILE information for this package in the BUILD file."
49 .D ^DIR K DIR Q:'Y
50 .S Y=0 F S Y=$O(^XPD(9.6,XPDA,"KRN",Y)) Q:'Y K ^(Y,"NM")
51 E D NEW(XPDA)
52 ;XPDN(0=excluded names or 1=include names, namespace)=""
53 W ! S DIR(0)="FO^1:15^K:X'?.1""-""1U.15UNP X",DIR("A")="Namespace",DIR("?")="Enter 1 to 15 characters, preceed with ""-"" to exclude namespace"
54 F D ^DIR Q:$D(DIRUT) S X=$E(Y,$L(Y))="*",%=$E(Y)="-",XPDN('%,$E(Y,%+1,$L(Y)-X))=""
55 I '$D(XPDN)!$D(DTOUT)!$D(DUOUT) D QUIT(XPDA) Q
56 W !!,"NAMESPACE INCLUDE",?35,"EXCLUDE",!,?11,"-------",?35,"-------"
57 S (X,Y)="",(X1,Y1)=1
58 F D W !?11,X,?35,Y Q:'X1&'Y1
59 .S:X1 X=$O(XPDN(1,X)),X1=X]"" S:Y1 Y=$O(XPDN(0,Y)),Y1=Y]""
60 S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="YES" D ^DIR
61 I 'Y!$D(DIRUT) D QUIT(XPDA) Q
62 D WAIT^DICD S XPDX="",XPDI("IEN")=0
63 F S XPDX=$O(XPDN(1,XPDX)),XPDXL=$L(XPDX),XPDF=0 Q:XPDX="" D
64 .F S XPDF=$O(^XPD(9.6,XPDA,"KRN",XPDF)) Q:'XPDF D
65 ..N XPD,XPDIC,XPDJ,XPCNT W "."
66 ..;XPDIC is used in $$SCR1^XPDET
67 ..S XPDIC="^XPD(9.6,"_XPDA_",""KRN"","_XPDF_",""NM"",",XPCNT=0
68 ..D LIST^DIC(XPDF,"","","","*",.XPDI,XPDX,"","I $E(^(0),1,XPDXL)=XPDX,$$SCR1^XPDET(Y)")
69 ..F XPDJ=1:1 S X=$G(^TMP("DILIST",$J,1,XPDJ)) Q:X="" D
70 ...S:XPDF<.404 %=^TMP("DILIST",$J,2,XPDJ)_",",X=$$TX^XPDET(X,$$GET1^DIQ(XPDF,%,$$TF^XPDET(XPDF),"I"))
71 ...S Y="+"_XPDJ_","_XPDF_","_XPDA_",",XPD(9.68,Y,.01)=X,XPD(9.68,Y,.03)=0
72 ...;Keep XPD from getting too big.
73 ...S XPCNT=XPCNT+1 I XPCNT>100 D UPDATE^DIE("","XPD") S XPCNT=0 K XPD
74 ..Q:'$D(XPD) D UPDATE^DIE("","XPD")
75 D QUIT(XPDA)
76 W "...Done.",!
77 Q
78VER ;verify a Build file package
79 N XPDA,Y
80 Q:'$$DIC("AEMQZ") S XPDA=+Y
81 D EN^XPDV
82 Q
83DIC(DIC,A,XPDL) ;DIC lookup to Build file, 9.6
84 N DLAYGO
85 S DIC(0)=$G(DIC),DIC="^XPD(9.6," S:$G(A)]"" DIC("A")=A
86 S:DIC(0)["L" DLAYGO=9.6,DIC("DR")="1;2//SINGLE PACKAGE;5//YES"
87 D ^DIC Q:Y<0 0
88 I '$G(XPDL) L +^XPD(9.6,+Y):0 E W !,"Being accessed by another user" Q 0
89 Q +Y
90 ;
91NEW(DA) ;create Kernel Files multiple for package DA
92 N I,J,X,XPDNEWF,XPD,XPDI
93 S:'$D(^XPD(9.6,DA,"KRN",0)) ^XPD(9.6,DA,"KRN",0)=U_$P(^DD(9.6,7,0),U,2)
94 S I=0
95 F J=1:1 S X=+$P($T(FILES+J),";;",2) Q:'X S:$D(^DD(X))&'$D(^XPD(9.6,DA,"KRN",X)) I=I+1,(XPDI(I),XPD(9.67,"+"_I_","_DA_",",.01))=X
96 Q:'$D(XPD)
97 ;XPDNEWF is a flag in INPUT transform of BUILD COMPONENT multiple
98 S XPDNEWF=1
99 D UPDATE^DIE("","XPD","XPDI")
100 Q
101QUIT(Y) ;unlock Y
102 L -^XPD(9.6,Y)
103 Q
104 ;
105 ;;file;install order;x-ref;file build;entry build;file pre;entry pre;file post;entry post;delete
106 ;You must put in code to delete anything
107FILES ;kernel files for field 7 in file 9.6
108 ;;9.8;;1;RTNF^XPDTA;RTNE^XPDTA
109 ;;9.2;1;;;HELP^XPDTA1;HLPF1^XPDIA1;HLPE1^XPDIA1;HLPF2^XPDIA1;;HLPDEL^XPDIA1
110 ;;3.6;2;1;;BUL^XPDTA1;;BULE1^XPDIA1;;;BULDEL^XPDIA1
111 ;;19.1;3;1;;KEY^XPDTA1;;;KEYF2^XPDIA1;;KEYDEL^XPDIA1
112 ;;.5;4;;;EDEOUT^DIFROMSO(.5,DA,"",XPDA);FPRE^DIFROMSI(.5,"",XPDA);EPRE^DIFROMSI(.5,DA,"",XPDA,"",OLDA);;EPOST^DIFROMSI(.5,DA,"",XPDA)
113 ;;.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%)
114 ;;.401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%)
115 ;;.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
116 ;;.403;8;;;EDEOUT^DIFROMSO(.403,DA,"",XPDA);FPRE^DIFROMSI(.403,"",XPDA);EPRE^DIFROMSI(.403,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.403,DA,"",XPDA);DEL^DIFROMSK(.403,"",%)
117 ;;.84;9;;;EDEOUT^DIFROMSO(.84,DA,"",XPDA);FPRE^DIFROMSI(.84,"",XPDA);EPRE^DIFROMSI(.84,DA,"",XPDA,"",OLDA);;EPOST^DIFROMSI(.84,DA,"",XPDA);DEL^DIFROMSK(.84,"",%)
118 ;;3.8;11;;;MAILG^XPDTA1;MAILGF1^XPDIA1;MAILGE1^XPDIA1;MAILGF2^XPDIA1;;MAILGDEL^XPDIA1(%)
119 ;;870;13;1;;HLLL^XPDTA1;;HLLLE^XPDIA1;;;HLLLDEL^XPDIA1(%)
120 ;;771;14;;;HLAP^XPDTA1;HLAPF1^XPDIA1;HLAPE1^XPDIA1;HLAPF2^XPDIA1;;HLAPDEL^XPDIA1(%)
121 ;;101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
122 ;;8994;16;1;;;;;;;RPCDEL^XPDIA1
123 ;;409.61;17;1;;;;;;;LMDEL^XPDIA1
124 ;;19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
125 ;;8994.2;19;1;;;;CRC32PE^XPDIA1;;;CRC32DEL^XPDIA1
126 ;;8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
127 ;;8989.52;21;1;;PAR2E1^XPDTA2;PAR2F1^XPDIA3;PAR2E1^XPDIA3;PAR2F2^XPDIA3;;PAR2DEL^XPDIA3(%)
Note: See TracBrowser for help on using the repository browser.