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/XPDIA0.m@ 701

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1XPDIA0 ;SFISC/RSD - Cont. of XPDIA ;03/09/2000 06:50
2 ;;8.0;KERNEL;**131,144**;Jul 10, 1995
3 Q
4PROE1 ;protocols entry pre
5 N %,I
6 S ^TMP($J,"XPD",DA)=XPDFL
7 ;if Event Driver, subscriber multiple is on node 775
8 I $P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,4)="E" D
9 . Q:$D(^XTMP("XPDI",XPDA,"KRN",101,OLDA,775))
10 . ;pre patch HL*1.6*57, convert menu multiple to subscriber
11 . M ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)
12 . K ^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)
13 ;if Menu linking or merge save menu and subscriber mult. and process in FPOS code
14 I XPDFL>1 D
15 . M ^TMP($J,"XPD",DA,775)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,775),^TMP($J,"XPD",DA,10)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)
16 . K ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775),^(10)
17 ;if Menu link, XPDQUIT prevents data merge
18 I XPDFL=2 S XPDQUIT=1 Q
19 ;if this is new to the site then disable and quit
20 I $G(XPDNEW) D:XPDSET Q
21 .;quit if option already has out of order msg.
22 .Q:$P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)]""
23 .S $P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)=$P(XPDSET,U,3)
24 .D ADD^XQOO1($P(XPDSET,U,2),101,DA)
25 S I=^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),%=^ORD(101,DA,0)
26 ;$P(%,U,3)=disable message,
27 S:$P(I,U,3)]"" $P(I,U,3)=$P(%,U,3)
28 ;if there is no new Security Key, save the old Key
29 S:$P(I,U,6)="" $P(I,U,6)=$P(%,U,6)
30 S ^XTMP("XPDI",XPDA,"KRN",101,OLDA,0)=I
31 ;if there is a new Description, kill the old Description
32 K:$O(^XTMP("XPDI",XPDA,"KRN",101,OLDA,1,0)) ^ORD(101,DA,1)
33 ;kill old ACCESS multiple
34 K ^ORD(101,DA,3) S I=0
35 ;XPDFL=3-merge menu items, Quit
36 ;the new menu items have already been saved into ^TMP, will restore in
37 ;the file post action as a relink
38 Q:XPDFL=3
39 ;we are replacing menu items, kill the old.
40 ;loop thru and kill "AD" and "AB" x-ref., it will be reset with new options
41 F S I=$O(^ORD(101,DA,10,I)) Q:'I S %=+$G(^(I,0)) K:% ^ORD(101,"AD",%,DA,I)
42 F S I=$O(^ORD(101,DA,775,I)) Q:'I S %=+$G(^(I,0)) K:% ^ORD(101,"AB",%,DA,I)
43 K ^ORD(101,DA,10),^ORD(101,DA,775)
44 Q
Note: See TracBrowser for help on using the repository browser.