source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDTC.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1XPDTC ;SFISC/RSD - Transport calls ;6/27/07 15:00
2 ;;8.0;KERNEL;**10,15,21,39,41,44,58,83,92,95,100,108,124,131,463**;Jul 10, 1995;Build 4
3 Q
4 ;^XTMP("XPDT",XPDA,data type,file #,
5 ;XPDA=ien of File 9.6, XPDNM=.01 field
6DD ;build DD
7 N FILE,FGR,FNAM,Z2,Z3,Z4
8 S FILE=0,FGR="^XTMP(""XPDT"",XPDA)",FNAM=$NA(^XPD(9.6,XPDA,4,"APDD"))
9 F S FILE=$O(^XPD(9.6,XPDA,4,FILE)) Q:'FILE D
10 .S Z2=$G(^XPD(9.6,XPDA,4,FILE,222)),Z3=$G(^(223)),Z4=$G(^(224))
11 .Q:'$$DATA^XPDV(FILE,Z2)
12 .D FIA^DIFROMSU(FILE,"",FNAM,FGR,Z2,Z3,Z4,XPDVER),DIERR:$D(DIERR)
13 Q:'$D(^XTMP("XPDT",XPDA,"FIA"))
14 ;send DD and Data
15 D DDOUT^DIFROMS("","","",FGR),DIERR:$D(DIERR),DATAOUT^DIFROMS("","","",FGR),DIERR:$D(DIERR)
16 Q
17 ;XPDERR is checked in XPDT and will abort transport
18DIERR ;record error
19 D MSG^DIALOG("EW",.XPD) S XPDERR=1
20 Q
21KRN ;build Kernel Files
22 ;XPDFILE=file #, XPDOLDA=ien in Build file
23 N %,%1,%2,DA,EACT,FACT,FGR,XPDFILE,XPDFL,XPDOLDA,XPDI
24 F XPDFILE=1:1 S Y0=$P($T(FILES+XPDFILE^XPDE),";;",2,99) Q:Y0="" S XPDI(+Y0)=Y0
25 ;XPDI(XPDFILE)=file;order;x-ref;fact;eact;fpre;epre;fpos;epos;fdel
26 S XPDFILE=0
27 F S XPDFILE=$O(^XPD(9.6,XPDA,"KRN",XPDFILE)) Q:'XPDFILE S XPDI=$G(XPDI(XPDFILE)) I XPDI S FACT=$P(XPDI,";",4),EACT=$P(XPDI,";",5) D Q:$D(XPDERR) D:FACT]"" ACT(FACT)
28 .;need to add code to check if File and data is already being sent in the File
29 .;mult. If it is, don't bother sending it again. DTL(XPDFILE)
30 .S XPDOLDA=0,FGR=$$FILE^XPDV(XPDFILE) I FGR="" S XPDERR=1 Q
31 .K ^TMP($J,"XPD")
32 .F S XPDOLDA=$O(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA)) Q:'XPDOLDA S Y0=$G(^(XPDOLDA,0)) D
33 ..;XPDFL= 0-send,1-delete,2-link,3-merge,4-attach,5-disable
34 ..S XPDFL=$P(Y0,U,3)
35 ..;If deleting at site get an unused DA
36 ..I XPDFL=1 S DA=$O(@FGR@(" "),-1)+1 F DA=DA:1 Q:'$D(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA))
37 ..;$P(Y0,U,2) is file # for this template, reset Y0 before getting DA
38 ..E S:$P(Y0,U,2) $P(Y0,U)=$P(Y0," FILE #") S DA=$$ENTRY^XPDV(Y0)
39 ..I 'DA S XPDERR=1 Q
40 ..;(-1)=action ^ ien in Build file
41 ..S ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,-1)=+XPDFL_"^"_XPDOLDA
42 ..;action 2 - verify children, 4 - verify parent
43 ..I XPDFL=2!(XPDFL=4),'$$MENU^XPDV(XPDFILE,DA,XPDFL) S XPDERR=1 Q
44 ..;if action is 1,4 or 5 then only send .01 field and set checksum to ""
45 ..I XPDFL=1!(XPDFL>3) S ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,0)=$P(Y0,U),$P(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA,0),U,4)="" Q
46 ..M ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)=@FGR@(DA)
47 ..;execute entry build action
48 ..D:EACT]"" ACT(EACT)
49 .;quit if no entries were saved
50 .Q:'$O(^XTMP("XPDT",XPDA,"KRN",XPDFILE,0))
51 .;XPDI=XPDI(XPDFILE), build x-ref of order to install
52 .S %=$P(^DIC(XPDFILE,0),U),^XTMP("XPDT",XPDA,"ORD",+$P(XPDI,";",2),XPDFILE)=XPDI,^(XPDFILE,0)=%
53 .Q
54 Q
55QUES ;build from Install Questions multiple
56 N I,J,K,X,%
57 S X=""
58 ;the "B" x-ref will give me the order of the questions
59 F S X=$O(^XPD(9.6,XPDA,"QUES","B",X)) Q:X="" S I=$$QUES^XPDV(X) S:'I XPDERR=1 D:I
60 .S J=0 F S J=$O(^XPD(9.6,XPDA,"QUES",I,J)) Q:J="" D
61 ..;tranform J to DIR subscripts
62 ..I $L(J)=1!(J="QQ") S ^XTMP("XPDT",XPDA,"QUES",X,$TR(J,"1ABQ","0AB?"))=^(J) Q ;^(J) ref to ^XPD(9.6,XPDA,"QUES",I,J)
63 ..;set the word processing fields into DIR("?",#) structure
64 ..F %=1:1 Q:'$D(^XPD(9.6,XPDA,"QUES",I,J,%,0)) S ^XTMP("XPDT",XPDA,"QUES",X,$TR(J,"AQ10","A?"),%)=^(0)
65 ;send the File questions
66 S K=$G(^XPD(9.6,XPDA,"QDEF")) ;Developer Defaults for Questions
67 F I=1:2 S X=$P($T(QUESTION+I),";;",2,99) Q:X="" S Y=$P($T(QUESTION+I+1),";;",2) D
68 .S ^XTMP("XPDT",XPDA,"QUES",$P(X,";"),0)=$P(X,";",2),^("A")=$P(X,";",3),^("B")=$S($L($P(K,U,I)):$P(K,U,I),1:$P(X,";",4)),^("??")=$P(X,";",5) S:Y]"" ^("M")=Y
69 Q
70INT ;build pre,post, & enviroment init routines
71 N %,I,X
72 F I="PRE","INI","INIT" I $G(^XPD(9.6,XPDA,I))]"" S X=^(I) D
73 .S ^XTMP("XPDT",XPDA,I)=X,X=$P($P(X,U,$L(X,U)),"(") Q:$D(^("RTN",X)) ;rwf
74 .I '$$RTN^XPDV(X) W !,"Routine ",X," **NOT FOUND**" S XPDERR=1 Q
75 .S %=$$LOAD^XPDTA(X,"0^")
76 Q
77BLD ;build Build file, Package file and Order Parameter file
78 N %,DIC,X,XPD,XPDI,XPDV,Y
79 ;Update the 'Date Distributed' field
80 S XPD(9.6,XPDA_",",.02)=$$DT^XLFDT()
81 D FILE^DIE("","XPD") K XPD
82 ;save version of kernel and fm
83 S ^XTMP("XPDT",XPDA,"VER")=$$VERSION^XPDUTL("XU")_U_$$VERSION^XPDUTL("VA FILEMAN")
84 S ^XTMP("XPDT",XPDA,"MBREQ")=$P($G(XPDT(XPDT)),U,4)
85 M ^XTMP("XPDT",XPDA,"BLD",XPDA)=^XPD(9.6,XPDA)
86 ;check national package file pointer
87 S XPDI=$P(^XPD(9.6,XPDA,0),U,2)
88 I XPDI="" W !,"No Package File Link" Q
89 S $P(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,2)=$$PT^XPDTA("^DIC(9.4)",XPDI)
90 ;quit if no pointer to package file
91 I '$D(^DIC(9.4,XPDI)) W !,"Package File Link is corrupted" S XPDERR=1 Q
92 ;update version multiple in package file,XPD=version^date distributed
93 S XPD=$$VER^XPDUTL(XPDNM)_U_$P(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,4)
94 ;XPD(1)=root of description field
95 S:$D(^XTMP("XPDT",XPDA,"BLD",XPDA,1)) XPD(1)=$NA(^(1))
96 S ^XTMP("XPDT",XPDA,"PKG",XPDI,0)=^DIC(9.4,XPDI,0),^XTMP("XPDT",XPDA,"PKG",XPDI,22,0)="^"_$P(^DD(9.4,22,0),U,2)_"^1^1"
97 ;add node 20 to XTMP for Patient Merge
98 M ^XTMP("XPDT",XPDA,"PKG",XPDI,20)=^DIC(9.4,XPDI,20)
99 ;XPDNM'["*" is a version release
100 I XPDNM'["*" D
101 .S XPDV=$$PKGVER^XPDIP(XPDI,.XPD)
102 .;Merge is used to set single nodes and merge multiples
103 .F %=1,5,7,20,"DEV","VERSION" M ^XTMP("XPDT",XPDA,"PKG",XPDI,%)=^DIC(9.4,XPDI,%)
104 .;XPDV=ien of Version Multiple
105 .I $D(^DIC(9.4,XPDI,22,XPDV))'>9 W !!,"**Version multiple in Package file wasn't updated**",!! S XPDERR=1 Q
106 .M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1)=^DIC(9.4,XPDI,22,XPDV)
107 ;this is a patch, %=version number, $P(XPD,U)=patch number
108 E D
109 .S %=$P(XPD,U),$P(XPD,U)=$P(XPDNM,"*",3),XPDV=$$PKGPAT^XPDIP(XPDI,%,.XPD)
110 .S ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=^DIC(9.4,XPDI,22,+XPDV,0)
111 .I $D(^DIC(9.4,XPDI,22,+XPDV,"PAH",+$P(XPDV,U,2)))'>9 W !!,"**Patch multiple in Package file wasn't updated**",!! S XPDERR=1 Q
112 .M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1)=^DIC(9.4,XPDI,22,+XPDV,"PAH",+$P(XPDV,U,2))
113 ;M ^XTMP("XPDT",XPDA,"PKG",XPDI)=^DIC(9.4,XPDI)
114 ;save the version ien^patch ien on -1 node
115 S ^XTMP("XPDT",XPDA,"PKG",XPDI,-1)="1^1"
116 ;resolve Primary Help Frame (0;4)
117 S %=+$P(^DIC(9.4,XPDI,0),U,4) S:% $P(^XTMP("XPDT",XPDA,"PKG",XPDI,0),U,4)=$$PT^XPDTA("^DIC(9.2)",%)
118 Q
119 ;
120ACT(%) ;execute action
121 ;user can count on DA,XPDFILE,XPDFL,XPDNM,XPDOLDA being around
122 ;DA=ien in ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)
123 ;XPDOLDA=ien in ^XPD(9.6,XPDA,"KRN",XPDIFLE,"NM",XPDOLDA)
124 N EACT,FACT,FGR,K0,Y0
125 S:%'["^" %="^"_%
126 D @% Q
127 ;
128 ;the following are the default questions for the INSTALL QUESTIONS
129 ;in file 9.6, the format is:
130 ;;field .01;field 1;field 2;field 4;field 7
131 ;;field 10
132QUESTION ;package install questions
133 ;;XPF1;Y;Shall I write over your |FLAG| File;YES;^D REP^XPDH
134 ;;D XPF1^XPDIQ
135 ;;XPF2;Y;Want my data |FLAG| yours;YES;^D DTA^XPDH
136 ;;D XPF2^XPDIQ
137 ;;XPI1;YO;Want KIDS to INHIBIT LOGONs during the install;NO;^D INHIBIT^XPDH
138 ;;D XPI1^XPDIQ
139 ;;XPM1;PO^VA(200,:EM;Enter the Coordinator for Mail Group '|FLAG|';;^D MG^XPDH
140 ;;D XPM1^XPDIQ
141 ;;XPO1;Y;Want KIDS to Rebuild Menu Trees Upon Completion of Install;NO;^D MENU^XPDH
142 ;;D XPO1^XPDIQ
143 ;;XPZ1;Y;Want to DISABLE Scheduled Options, Menu Options, and Protocols;NO;^D OPT^XPDH
144 ;;D XPZ1^XPDIQ
145 ;;XPZ2;Y;Want to MOVE routines to other CPUs;NO;^D RTN^XPDH
146 ;;D XPZ2^XPDIQ
Note: See TracBrowser for help on using the repository browser.