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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1XPDET ;SFISC/RSD - Input tranforms & help for file 9.6 & 9.7 ;10/19/2002 15:43
2 ;;8.0;KERNEL;**15,39,41,44,51,58,66,137,229,393**;Jul 10, 1995;Build 12
3 Q
4INPUTB(X) ;input tranfrom for NAME in BUILD file
5 ;X=user input
6 ;name must be unique
7 I $L(X)>50!($L(X)<3)!$D(^XPD(9.6,"B",X)) K X Q
8 I X["*" K:$P(X,"*",2,3)'?1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.6N X Q
9 S %=$L(X," ") I %<2 K X Q
10 S %=$P(X," ",%) K:%'?1.2N1"."1.2N.1(1"V",1"T",1"B").2N X
11 Q
12INPUTE(X) ;input transform for ENTRIES in KERNEL FILES multiple
13 ;X=user input
14 N D,DD,DIC,DICR,DIX,DIY,DS,DO,XPDLK,Y
15 S XPDLK=$$GR(D1)
16 I XPDLK=""!X["*" K X Q
17 S DIC(0)="QEMZ",DIC=XPDLK
18 S:D1=9.8 DIC("S")="I $T(^@$P(^(0),U))]"""""
19 D ^DIC K:Y<0 X Q:'$D(X)
20 S X=Y(0,0)
21 ;check that this doesn't exist already
22 I $D(^XPD(9.6,D0,"KRN",D1,"NM","B",X)) K X Q
23 ;if fm file, change X to contain file # of template
24 I D1<.404 S X=$$TX(X,$P(Y(0),U,$S(D1=.403:8,1:4)))
25 Q
26GLOBALE(X) ;input transform for GLOBAL multiple .01 field in file 9.6
27 I $L(X)>30!($L(X)<2) K X Q
28 I X["(",X'[")" K X Q
29 ;change ' back to " for subscripts, they were changed in the Pre-Lookup node of the DD, 7.5. This was done to trick FM, which doesn't allow " in .01 fields
30 S X=$TR(X,"'","""")
31 I '$D(@("^"_X)) K X
32 Q
33INPUTMB(X) ;input transform for field 10 and 11 in file 9.6
34 ;X=user input
35 N D,DD,DIC,DICR,DIX,DIY,DS,DO,Y
36 ;can't select a global or multi package or itself (D0)
37 S DIC(0)="QEMZ",DIC="^XPD(9.6,",DIC("S")="I '$P(^(0),U,3),Y'="_D0
38 D ^DIC K:Y<0 X Q:'$D(X)
39 S X=Y(0,0)
40 Q
41LOOKE(X) ;special lookup for ENTRIES in KERNEL FILES multiple
42 Q:X'?1.E1"*"
43 N %,XPD,XPDI,XPDIC,XPDF,XPDLK,XPDX,Y
44 S XPDLK=$$GR(D1),XPDIC=DIC,XPDF=D1
45 I XPDLK="" K X Q
46 G:$E(X)="-" DEL
47 S XPDX=$P(X,"*"),XPDI("IEN")=0
48 D LIST^DIC(D1,"","","","*",.XPDI,XPDX,"","I $$SCR^XPDET(Y)")
49 I '$G(^TMP("DILIST",$J,0)) K X Q
50 K ^TMP("XPDX",$J)
51 ;loop thru list from lister and file using UPDATE^DIE
52 F XPDI=1:1 S X=$G(^TMP("DILIST",$J,1,XPDI)) Q:X="" D
53 .S:D1<.404 %=^TMP("DILIST",$J,2,XPDI)_",",X=$$TX(X,$$GET1^DIQ(D1,%,$$TF(D1),"I"))
54 .S Y="+"_XPDI_","_D1_","_D0_",",^TMP("XPDX",$J,9.68,Y,.01)=X,^(.03)=0
55 I $D(^TMP("XPDX",$J)) D UPDATE^DIE("","^TMP(""XPDX"",$J)","^TMP(""XPD"",$J)")
56 ;if in Screenman then call MLOAD to update screen
57 I $D(DDS),$D(^TMP("XPD",$J)) D MLOAD^DDSUTL("^TMP(""XPD"",$J)")
58 S X=""
59 K ^TMP("XPDX",$J),^TMP("XPD",$J)
60 Q
61DEL ;delete using wild card
62 I X'?1"-"1.E1"*" K X Q
63 S X=$E(X,2,$L(X)-1),XPDX=X S:$L(X) XPDI("IEN")=0
64 D LIST^DIC(9.68,","_D1_","_D0_",","","","*",.XPDI,XPDX)
65 I '$G(^TMP("DILIST",$J,0)) K X Q
66 N DIK,DA,D2
67 S DIK=XPDIC,DA(1)=D1,DA(2)=D0
68 F XPDI=1:1 S (DA,D2)=$G(^TMP("DILIST",$J,2,XPDI)) Q:'DA D
69 .D ^DIK
70 I $D(DDS) D MDEL^DDSUTL("^TMP(""DILIST"",$J,2)")
71 S X=""
72 K ^TMP("DILIST",$J)
73 Q
74HELP ;executable help of ENTRIES in KERNEL FILE multiple
75 N D,DIC,DIE,DIX,DIY,DO,DZ,DS,X,Y
76 ;file 9.8 is routine file, check that routine exists
77 S DIC=$$GR(D1),DIC(0)="M",X="??" Q:DIC="" S:D1=9.8 DIC("S")="I $T(^@$P(^(0),U))]"""""
78 D ^DIC Q
79 ;
80HELPO ;executable help of INSTALL ORDER in KERNEL FILES multiple
81 N Y
82 W !,"Numbers in use: ORDER FILE#" S Y=0
83 F S Y=$O(^XPD(9.6,D0,"KRN","AC",Y)) Q:'Y W !,?18,$J(Y,2),?28,$O(^(Y,0))
84 W ! Q
85 ;
86HELPMB ;executable help of fields 10 & 11 in file 9.6
87 N D,DIC,DIE,DIX,DIY,DO,DZ,DS,X,Y
88 S DIC="^XPD(9.6,",DIC(0)="M",X="??",DIC("S")="I '$P(^(0),U,3),Y'="_D0
89 D ^DIC Q
90 ;
91SCRA(Y) ;screen of ACTION field in ENTRIES multiple in KERNEL FILES multiple, Y=action
92 ;Y=0 - send, 1 - delete, 2 - link, 3 - merge, 4 - attach, 5 - disable
93 ;all entries can send to site
94 Q:'Y 1
95 ;.5=function file, can't delete, all others can
96 I Y=1 Q (D1'=.5)
97 ;then rest of code check if it is a Option or Protocal and can have MENU ITEMS
98 Q:D1'=19&(D1'=101) 0
99 ;only Options and Protocol can disable
100 Q:Y=5 1
101 N FGR,X,XPDF,XPDT,XPDZ
102 ;get X=name, FGR=global reference, XPDF=file #
103 S XPDY=Y,XPDF=D1,X=$P(^XPD(9.6,D0,"KRN",D1,"NM",D2,0),U),FGR=$$FILE^XPDV(D1)
104 Q:X="" 0
105 ;X=ien of protocol or option
106 S X=+$O(@FGR@("B",X,0)) Q:'X 0
107 ;get type
108 S XPDT=$P($G(@FGR@(X,0)),U,4)
109 ;all Options and Protocols, except Event Drivers, can be attached
110 I XPDY=4 Q '(XPDF=101&(XPDT="E"))
111 ;Protocol and Type is Subscriber can't do anything else
112 I XPDF=101,XPDT="S" Q 0
113 ;if it has SUBSCRIBERS, node 775 then ok
114 I $O(@FGR@(X,775,0)) Q 1
115 ;if type is menu,potocol,protocol menu,limited,extended,window suite
116 I "MOQLXZ"[$P($G(@FGR@(X,0)),U,4) Q 1
117 ;if it has ITEMs, node 10 then ok
118 I $O(@FGR@(X,10,0)) Q 1
119 Q 0
120 ;
121 ;only Fileman templates need to know what file they are associated with.
122 ;this value is also triggered to field .02 in the DD.
123TX(X,Y) ;X=template name, Y=file #
124 Q X_" FILE #"_Y
125 ;
126TF(F) ;F=file, return field of file# for templates
127 Q $S(F>.403:"",F<.403:4,1:7)
128 ;
129GR(X) Q $G(^DIC(X,0,"GL"))
130 ;
131 ;screens checks that X is not already in the ENTRIES multiple
132SCR(Y) ;screen logic for ENTRIES multiple in file 9.6
133 N %,X,Z
134 S Z=^(0),X=$P(Z,U)
135 ;FM files are less than .44
136 I XPDF<.44 D Q:X="" 0
137 .S %=$S(XPDF=.403:$P(Z,U,8),1:$P(Z,U,4)),X=X_" FILE #"_%
138 .S:XPDF'=.403&($P(Z,U,8)>2) %=0 S:'% X=""
139 ;routine must exist and must be type 'R'
140 I XPDF=9.8 Q:$T(^@X)=""!($P(Z,U,2)'="R") 0
141 Q '$D(@(XPDIC_"""B"",X)"))
142 ;
143 ;screen checks that X is not in the exclude list, XPDN(0)
144SCR1(Y) ;screen logic for exclude list
145 N %,X
146 ;if name X is in the exclude list, XPDN(0,X), then fail
147 S Y(0)=^(0),X=$P(Y(0),U) Q:$D(XPDN(0,X)) 0
148 ;check if X is refered in the namespace by check the subscript
149 ;before X, if sub exist and $P(X,sub)="" then it is part of the
150 ;namespace, fail and return 0
151 S %=$O(XPDN(0,X),-1) I $L(%) Q:$P(X,%)="" 0
152 Q $$SCR(.Y)
153 ;
154 ;screen on PACKAGE LINK field in file 9.6,
155PCK(Y) ;check Package File name, Y=ien in package file
156 N %,Y,Z
157 S Z=^(0)
158 ;DA is undef when you are adding a new Build without a version number
159 Q:'$D(^XPD(9.6,+$G(DA),0)) 1
160 S Y=$L($P(Z,U)),%=$P(^XPD(9.6,DA,0),U),%=$$PKG^XPDUTL(%)
161 Q $P(Z,U)=$E(%,1,Y)!($P(Z,U,2)=%)
162VOLE(X) ;input transform for VOLUME SET multiple in INSTALL file
163 ;X=user input
164 N D,DD,DIC,DICR,DIX,DIY,DO,DS,XPD,Y,%
165 ;(0;11)=SIGNON/PRODUCTION
166 S DIC(0)="QEMZ",DIC="^%ZIS(14.5,",DIC("S")="I $P(^(0),U,11)"
167 D ^DIC K:Y<0 X Q:'$D(X)
168 S X=Y(0,0)
169 Q
170VOLH ;executable help for VOLUME SET multiple in INSTALL file
171 N D,DD,DIC,DIE,DIX,DIY,DO,DS,DZ,X,Y,%
172 S X="??",DIC(0)="QEMZ",DIC="^%ZIS(14.5,",DIC("S")="I $P(^(0),U,11)"
173 D ^DIC
174 Q
175ID97 ;identifier for Install file
176 N XPDET,XPD,XPD0,XPD1,XPD2,XPD9
177 S XPD0=$G(^(0)),XPD1=$G(^(1)),XPD2=$G(^(2)),XPD9=$P(XPD0,U,9),XPD="" Q:XPD9=""
178 D
179 .;Loaded, get DATE LOADED
180 .I 'XPD9 S XPD=$$FMTE^XLFDT($P(XPD0,U,3),2) Q
181 .Q:XPD9>3
182 .;Started, get INSTALL START TIME
183 .I XPD9=2 S XPD=$$FMTE^XLFDT($P(XPD1,U),2) Q
184 .;Completed, get INSTALL COMPLETE TIME
185 .I XPD9=3 S XPD=$$FMTE^XLFDT($P(XPD1,U,3),2) Q
186 .;Queued, get QUEUED TASK NUMBER
187 .I XPD9=1 S XPD="#"_$P(XPD0,U,6) Q
188 S XPDET(1)=" "_$$EXTERNAL^DILFD(9.7,.02,"",XPD9)_" "_XPD,XPDET(1,"F")="?0"
189 S:XPD2]"" XPDET(2)="=> "_$E(XPD2,1,70),XPDET(2,"F")="!?5"
190 D EN^DDIOL(.XPDET)
191 Q
192 ;not being used right now,
193DEL97(Y) ;delete access to file 9.7, 0-can't delete, 1-can
194 N %
195 S %=$P(^XPD(9.7,Y,0),U,9)
196 Q $S(%=3:1,%=2:0,$D(^XPD(9.7,"ASP",Y,1,Y)):1,1:0)
197 ;
198PAR964 ;Clear other fields if file is partial. Called from within form
199 D PUT^DDSVAL(DIE,.DA,222.7,"n","","I") ;Send data NO
200 D PUT^DDSVAL(DIE,.DA,222.5,"","","I") ;Resolve pointer
201 D PUT^DDSVAL(DIE,.DA,222.8,"","","I") ;Sites Data
202 D PUT^DDSVAL(DIE,.DA,222.9,"n","","I") ;User Override
203 D PUT^DDSVAL(DIE,.DA,224,"","","I") ;Data Screen
204 Q
Note: See TracBrowser for help on using the repository browser.