| 1 | XPDIA0 ;SFISC/RSD - Cont. of XPDIA ;03/09/2000 06:50
|
|---|
| 2 | ;;8.0;KERNEL;**131,144**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | PROE1 ;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
|
|---|
