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/XPDIK.m@ 1742

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

initial load of WorldVistAEHR
File size: 7.2 KB
Line 
1XPDIK ;SFISC/RSD - Install Kernel Files & FM Files ;04/26/2004 11:20
2 ;;8.0;KERNEL;**15,58,108,124,146,346**;Jul 10, 1995
3 Q
4KRN ;
5 ;XPDA=package ien in INSTALL FILE, XPDNM=package name, XPDCP= check points
6 N DA,DIC,DIOVRD,EPOS,EPRE,FDEL,FPOS,FPRE,OLDA,ORD,X,XGCEDITR,XPDFIL,XPDFILNM,XPDFL,XPDNEW,XREF,Y,%
7 ;DIOVRD is used to override write protection on a file
8 ;XGCEDITR is check in file 8995, at 'SCR' node of DD
9 S ORD=0,XPDCP="KRN",(DIOVRD,XGCEDITR)=1
10 F S ORD=$O(^XTMP("XPDI",XPDA,"ORD",ORD)) Q:'ORD S XPDFIL=+$O(^(ORD,0)),XREF=$G(^(XPDFIL)),XPDFILNM=$G(^(XPDFIL,0)) D:XPDFIL
11 .;sets up EPOS,EPRE,FDEL,FPOS,FPRE variables
12 .F DA=1:1:5 S @$P("FPRE^EPRE^FPOS^EPOS^FDEL",U,DA)=$P(XREF,";",DA+5)
13 .K DIC,^TMP($J,"XPDEL")
14 .S DIC=$G(^DIC(XPDFIL,0,"GL")),XREF=+$P(XREF,";",3)
15 .;check if file, XPDFIL, exist at this site
16 .I $P($G(^DIC(XPDFIL,0)),U)'=XPDFILNM D BMES^XPDUTL(" File "_XPDFIL_" is not "_XPDFILNM_", nothing installed.") Q
17 .;check if XPDFIL has already been installed
18 .I $P(^XPD(9.7,XPDA,"KRN",XPDFIL,0),U,2) D BMES^XPDUTL(" "_XPDFILNM_" already installed.") Q
19 .D BMES^XPDUTL(" Installing "_XPDFILNM),SETTOT^XPDID(XPDFIL)
20 .;do File Pre-install action, continue if ok
21 .;XPDFL= 0-send,1-delete,2-link,3-merge,4-attach,5-disable
22 .;loops thru the entries for this file
23 .I '$$ACT(FPRE) S OLDA=0 F S OLDA=$O(^XTMP("XPDI",XPDA,"KRN",XPDFIL,OLDA)) Q:'OLDA S XPDFL=+$G(^(OLDA,-1)),OLDA(0)=^(0) D
24 ..;if we are doing VT graphic display, set counter
25 ..I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
26 ..;quit if disable or attach (4 or 5). Attach will be processed under the parent menu.
27 ..Q:XPDFL>3
28 ..;if FM file, need to set screening logic
29 ..I XPDFIL<.44 S %=$S(XPDFIL'=.403:4,1:8),DIC("S")="I $P(^(0),U,"_%_")="_$P(OLDA(0),U,%)
30 ..;if deleting at site and a template, reset the lookup value and DIC("S")
31 ..I XPDFL=1,XPDFIL<.44 S %=$P(OLDA(0),U),$P(OLDA(0),U)=$P(%," FILE #"),DIC("S")="I $P(^(0),U,"_$S(XPDFIL'=.403:4,1:8)_")="_+$P(%," FILE #",2)
32 ..;XPDNEW=1 if entry is new, laygo
33 ..S X=$P(OLDA(0),U),Y=$$DIC(XPDFIL,X,$G(DIC("S")),XPDFL) Q:'Y S DA=+Y,XPDNEW=$P(Y,U,3)
34 ..;if deleting then save and process after FPOS
35 ..I XPDFL=1 S ^TMP($J,"XPDEL",DA)="" Q
36 ..;do Entries Pre-install action
37 ..Q:$$ACT(EPRE)
38 ..;merges the data, if you want the data deleted before the merge, you must
39 ..;do it in the Entry Pre-install node, EPRE.
40 ..M @(DIC_DA_")")=^XTMP("XPDI",XPDA,"KRN",XPDFIL,OLDA)
41 ..;kill the flag node from the live data node
42 ..K @(DIC_DA_",-1)") Q:$$ACT(EPOS)
43 ..;XREF is flag to x-ref file after each entry, it is set in file 9.6
44 ..I XREF N DIK S DIK=DIC D IX1^DIK
45 .;do File Post Install Action
46 .S %=$$ACT(FPOS)
47 .;process the deleting of entries, FDEL should allow the passing of all entries
48 .;to delete in array ^TMP($J,"XPDEL",DA)=""
49 .I $L(FDEL),$D(^TMP($J,"XPDEL")) S %="^TMP($J,""XPDEL"")" D @FDEL
50 .;complete check point
51 .S %=$$XPCOM(XPDFIL)
52 .K ^TMP($J,"XPDEL")
53 .I $D(XPDIDVT) D UPDATE^XPDID(XPDIDCNT)
54 Q
55FIA ;
56 ;XPFIL2=file is new^DD screen failed^data already exists^change file name^don't add data; 1=yes, 0=no
57 N XPGR,XPFIL,XPFILO,XPFIL2,Z
58 S XPFIL=0,XPGR=$NA(^XTMP("XPDI",XPDA))
59 F S XPFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPFIL)) Q:'XPFIL S XPFILO=^(XPFIL,0,1),XPFIL2=^(2) D
60 .;if we are doing VT graphic display, set counter
61 .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
62 .;file is new, alway install DD
63 .S:XPFIL2 $P(XPFILO,U)="y",$P(^XTMP("XPDI",XPDA,"FIA",XPFIL,0,1),U)="y"
64 .;DD failed screen
65 .I $P(XPFIL2,U,2) D Q
66 ..N XPD
67 ..S XPD(1)=" ",XPD(2)="Data Dictionary for File #"_XPFIL_" not installed, failed DD screen."
68 ..D MES^XPDUTL(.XPD) S %=$$XPCOM(XPFIL)
69 .;if udate DD question = no & file is not new update checkpoint
70 .I $P(XPFILO,U)'="y"&'XPFIL2 S %=$$XPCOM(XPFIL)
71 .;check if XPFIL has already been installed
72 .Q:$P(^XPD(9.7,XPDA,4,XPFIL,0),U,2)
73 .;update file name
74 .I $P(XPFIL2,U,4) D
75 ..N DIE,DR,DA
76 ..S DR=".01////"_^XTMP("XPDI",XPDA,"FIA",XPFIL),DA=XPFIL,DIE=1
77 ..D ^DIE
78 .;move DD and check for errors
79 .D DDIN^DIFROMS(XPFIL,"","",XPGR),DIERR("** ERROR IN DATA DICTIONARY FOR FILE # "_XPFIL_" **"):$D(DIERR)
80 .S %=$$XPCOM(XPFIL)
81 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
82 Q
83DAT ;
84 N XPGR,XPFIL,XPFILO,XPFIL2,Z
85 S XPFIL=0,XPGR=$NA(^XTMP("XPDI",XPDA))
86 ;DO if they are sending data
87 F S XPFIL=$O(^XTMP("XPDI",XPDA,"FIA",XPFIL)) Q:'XPFIL S XPFILO=^(XPFIL,0,1),XPFIL2=^(2) D:$P(XPFILO,U,7)="y"
88 .;DD failed screen or answer no to adding data or 'Add if new' & data already exists or file doesn't exist
89 .I $P(XPFIL2,U,2)!$P(XPFIL2,U,5)!($P(XPFILO,U,8)="a"&$P(XPFIL2,U,3))!'$D(^DIC(XPFIL,0)) S %=$$XPCOM(XPFIL,1) Q
90 .;check if XPFIL has already been installed or no data to input
91 .Q:$P(^XPD(9.7,XPDA,4,XPFIL,0),U,3)!('$D(^XTMP("XPDI",XPDA,"DATA",XPFIL)))
92 .;bring in Data and check for error
93 .D DATAIN^DIFROMS(XPFIL,"","",XPGR),DIERR("** ERROR IN DATA FOR FILE # "_XPFIL_" **"):$D(DIERR)
94 .S %=$$XPCOM(XPFIL,1)
95 D RP^DIFROMSR("","",XPGR),DIERR("** ERROR IN POINTER RESOLUTION OF DATA **"):$D(DIERR)
96 Q
97 ;record error
98DIERR(XPDI) N XPD
99 D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)
100 D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)
101 Q
102 ;
103 ;XPDF=file #,X=input,XPDS=screen logic, XPDACT=action
104DIC(XPDF,XPDX,XPDS,XPDACT) ;
105 N DIC,DIERR,XPD,XPDN
106 S DIC=$G(^DIC(XPDF,0,"GL"))
107 D FIND^DIC(XPDF,"","","XQf",XPDX,5,"",$G(XPDS),"","XPD")
108 ;one or more matches, just return first one
109 I $G(XPD(0)) D:XPD(0)>1 Q XPD(1)
110 .N %
111 .S %(1)=$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" is Duplicated,",%(2)=" only ien #"_XPD(1)_" was updated."
112 .D MES^XPDUTL(.%)
113 ;no match and action=(delete,link, or attach), don't write message if deleting
114 I $G(XPDACT),XPDACT'=3 D:XPDACT'=1 BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" Lookup failed, NO Action Taken.") Q 0
115 ;add a new entry
116 N DLAYGO,X,Y
117 S X=XPDX,DIC(0)="LX",DLAYGO=XPDF,DIC("S")=$G(XPDS) D ^DIC
118 I Y<0 D BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
119 Q Y
120 ;code can't be used until UPDATE^DIE allows the creation of a record
121 ;without required identifiers
122 ;K XPD,DIERR
123 ;S XPD(XPDF,"+1,",.01)=XPDX
124 ;D UPDATE^DIE("","XPD","XPDN")
125 ;couldn't add as new
126 ;I $D(DIERR) D DIERR(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
127 ;I '$G(XPDN(1)) D BMES^XPDUTL(" "_$P($G(^DIC(XPDF,0)),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
128 ;Q XPDN(1)
129 ;
130ACT(%) ;execute action, returns 0 to continue, 1 to quit
131 ;user can count on DIC,DA,XPDFIL,OLDA,XPDNM,XPDFL,X,Y being around
132 ;XPDNEW is set only for Entry Pre-install action
133 Q:%="" 0
134 N %1,%2,%3 S %1=$G(DIC),%2=$G(DA),%3=$G(OLDA)
135 N DA,DIC,DIOVRD,OLDA,EPOS,EPRE,FPOS,FPRE,ORD,XREF,XPDQUIT
136 S DIC=%1,DA=%2,OLDA=%3
137 S:%'["^" %="^"_%
138 ;XPDQUIT=quit this level of processing
139 D @% Q $D(XPDQUIT)
140 Q
141 ;
142XPCOM(XPDF,XPDJ) ;complete checkpoint for file XPDF
143 ;XPDJ=1 only for data of fm files, it set the field to edit = 2
144 N XPD,%,Z
145 S %=$$NOW^XLFDT,Z=$S(XPDCP="KRN":9.715,1:9.714),XPD(Z,XPDF_","_XPDA_",",$G(XPDJ)+1)=%
146 ;if Build Components, save the ORDer number
147 S:Z=9.715 XPD(Z,XPDF_","_XPDA_",",2)=ORD
148 D FILE^DIE("","XPD")
149 Q 1
150 ;
151XPCK(XPDI) ;setup check points for file type XPDI
152 ;XPDI="KRN"-components, ="FIA"-files
153 N %,XPD,XPDF,XPDJ,XPDK
154 ;XPDK=sub DD
155 S XPDK=$S(XPDI="KRN":9.715,1:9.714),XPDF=0
156 F %=1:1 S XPDF=$O(^XTMP("XPDI",XPDA,XPDI,XPDF)) Q:'XPDF S (XPDJ(%),XPD(XPDK,"+"_%_","_XPDA_",",.01))=XPDF
157 D:$D(XPD)>9 UPDATE^DIE("","XPD","XPDJ")
158 Q
Note: See TracBrowser for help on using the repository browser.