XPDIA0.m

XPDIA0 ;SFISC/RSD - Cont. of XPDIA ;03/09/2000  06:50 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1007**;APR 1, 2003

 ;;8.0;KERNEL;**131,144**;Jul 10, 1995

 Q

PROE1 ;protocols entry pre

 N %,I

 S ^TMP($J,"XPD",DA)=XPDFL

 ;if Event Driver, subscriber multiple is on node 775

 I $P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,4)="E" D

 . Q:$D(^XTMP("XPDI",XPDA,"KRN",101,OLDA,775))

 . ;pre patch HL*1.6*57, convert menu multiple to subscriber

 . M ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)

 . K ^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)

 ;if Menu linking or merge save menu and subscriber mult. and process in FPOS code

 I XPDFL>1 D

 . 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)

 . K ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775),^(10)

 ;if Menu link, XPDQUIT prevents data merge

 I XPDFL=2 S XPDQUIT=1 Q

 ;if this is new to the site then disable and quit

 I $G(XPDNEW) D:XPDSET  Q

 .;quit if option already has out of order msg.

 .Q:$P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)]""

 .S $P(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)=$P(XPDSET,U,3)

 .D ADD^XQOO1($P(XPDSET,U,2),101,DA)

 S I=^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),%=^ORD(101,DA,0)

 ;$P(%,U,3)=disable message,

 S:$P(I,U,3)]"" $P(I,U,3)=$P(%,U,3)

 ;if there is no new Security Key, save the old Key

 S:$P(I,U,6)="" $P(I,U,6)=$P(%,U,6)

 S ^XTMP("XPDI",XPDA,"KRN",101,OLDA,0)=I

 ;if there is a new Description, kill the old Description

 K:$O(^XTMP("XPDI",XPDA,"KRN",101,OLDA,1,0)) ^ORD(101,DA,1)

 ;kill old ACCESS multiple

 K ^ORD(101,DA,3) S I=0

 ;XPDFL=3-merge menu items, Quit

 ;the new menu items have already been saved into ^TMP, will restore in

 ;the file post action as a relink

 Q:XPDFL=3

 ;we are replacing menu items, kill the old.

 ;loop thru and kill "AD" and "AB" x-ref., it will be reset with new options

 F  S I=$O(^ORD(101,DA,10,I)) Q:'I  S %=+$G(^(I,0)) K:% ^ORD(101,"AD",%,DA,I)

 F  S I=$O(^ORD(101,DA,775,I)) Q:'I  S %=+$G(^(I,0)) K:% ^ORD(101,"AB",%,DA,I)

 K ^ORD(101,DA,10),^ORD(101,DA,775)

 Q

XPDIA0    ;SFISC/RSD - Cont. of XPDIA ;03/09/2000  06:50 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**131,144**;Jul 10, 1995

 +3        QUIT 

PROE1     ;protocols entry pre

 +1        NEW %,I

 +2        SET ^TMP($JOB,"XPD",DA)=XPDFL

 +3       ;if Event Driver, subscriber multiple is on node 775

 +4        IF $PIECE(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,4)="E"

               Begin DoDot:1

 +5                IF $DATA(^XTMP("XPDI",XPDA,"KRN",101,OLDA,775))

                       QUIT 

 +6       ;pre patch HL*1.6*57, convert menu multiple to subscriber

 +7                MERGE ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)

 +8                KILL ^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)

               End DoDot:1

 +9       ;if Menu linking or merge save menu and subscriber mult. and process in FPOS code

 +10       IF XPDFL>1

               Begin DoDot:1

 +11               MERGE ^TMP($JOB,"XPD",DA,775)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,775),^TMP($JOB,"XPD",DA,10)=^XTMP("XPDI",XPDA,"KRN",101,OLDA,10)

 +12               KILL ^XTMP("XPDI",XPDA,"KRN",101,OLDA,775),^(10)

               End DoDot:1

 +13      ;if Menu link, XPDQUIT prevents data merge

 +14       IF XPDFL=2

               SET XPDQUIT=1

               QUIT 

 +15      ;if this is new to the site then disable and quit

 +16       IF $GET(XPDNEW)

               IF XPDSET

                   Begin DoDot:1

 +17      ;quit if option already has out of order msg.

 +18                   IF $PIECE(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)]""

                           QUIT 

 +19                   SET $PIECE(^XTMP("XPDI",XPDA,"KRN",101,OLDA,0),U,3)=$PIECE(XPDSET,U,3)

 +20                   DO ADD^XQOO1($PIECE(XPDSET,U,2),101,DA)

                   End DoDot:1

               QUIT 

 +21       SET I=^XTMP("XPDI",XPDA,"KRN",101,OLDA,0)

           SET %=^ORD(101,DA,0)

 +22      ;$P(%,U,3)=disable message,

 +23       IF $PIECE(I,U,3)]""

               SET $PIECE(I,U,3)=$PIECE(%,U,3)

 +24      ;if there is no new Security Key, save the old Key

 +25       IF $PIECE(I,U,6)=""

               SET $PIECE(I,U,6)=$PIECE(%,U,6)

 +26       SET ^XTMP("XPDI",XPDA,"KRN",101,OLDA,0)=I

 +27      ;if there is a new Description, kill the old Description

 +28       IF $ORDER(^XTMP("XPDI",XPDA,"KRN",101,OLDA,1,0))

               KILL ^ORD(101,DA,1)

 +29      ;kill old ACCESS multiple

 +30       KILL ^ORD(101,DA,3)

           SET I=0

 +31      ;XPDFL=3-merge menu items, Quit

 +32      ;the new menu items have already been saved into ^TMP, will restore in

 +33      ;the file post action as a relink

 +34       IF XPDFL=3

               QUIT 

 +35      ;we are replacing menu items, kill the old.

 +36      ;loop thru and kill "AD" and "AB" x-ref., it will be reset with new options

 +37       FOR 

               SET I=$ORDER(^ORD(101,DA,10,I))

               IF 'I

                   QUIT 

               SET %=+$GET(^(I,0))

               IF %

                   KILL ^ORD(101,"AD",%,DA,I)

 +38       FOR 

               SET I=$ORDER(^ORD(101,DA,775,I))

               IF 'I

                   QUIT 

               SET %=+$GET(^(I,0))

               IF %

                   KILL ^ORD(101,"AB",%,DA,I)

 +39       KILL ^ORD(101,DA,10),^ORD(101,DA,775)

 +40       QUIT