XU8P463.m

XU8P463 ;ISF/RWF - POST-INIT FOR XU*8*463 ;6/21/07  09:54

 ;;8.0;KERNEL;**463**;Jul 10, 1995;Build 4

 Q

POST ;

 D TT,PROT

 Q

TT ;Clean-up the TT DD's.

 N DIK,DA,DIE,%

 I $E($G(^DD(3.2,5,0)),1)="*" D

 . F DA=0:0 S DA=$O(^%ZIS(2,DA)) Q:'DA  S %=$G(^(DA,1)) I $L($P(%,U,5)) S $P(^(1),U,5)=""

 . S DIK="^DD(3.2,",DA=5,DA(1)=3.2 D ^DIK

 . Q

 I $G(^DD(3.2,5.2,1,1,"%D",1,0))["temporary trigger" D

 . S DIK="^DD(3.2,DA(1),1,",DA=1,DA(1)=5.2,DA(2)=3.2 D ^DIK

 . Q

 Q

PROT ; add 'Edit a Protocol' option into the 'Menu Management' menu.

 N XUS

 S XUS=$$ADD^XPDMENU("XUMAINT","XUPROTOCOL EDIT")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XU8P463   608     printed  Apr 09, 2024@21:07:02                                                                                                                                                                                                      Page 2

XU8P463   ;ISF/RWF - POST-INIT FOR XU*8*463 ;6/21/07  09:54

 +1       ;;8.0;KERNEL;**463**;Jul 10, 1995;Build 4

 +2        QUIT 

POST      ;

 +1        DO TT

           DO PROT

 +2        QUIT 

TT        ;Clean-up the TT DD's.

 +1        NEW DIK,DA,DIE,%

 +2        IF $EXTRACT($GET(^DD(3.2,5,0)),1)="*"

               Begin DoDot:1

 +3                FOR DA=0:0

                       SET DA=$ORDER(^%ZIS(2,DA))

                       if 'DA

                           QUIT 

                       SET %=$GET(^(DA,1))

                       IF $LENGTH($PIECE(%,U,5))

                           SET $PIECE(^(1),U,5)=""

 +4                SET DIK="^DD(3.2,"

                   SET DA=5

                   SET DA(1)=3.2

                   DO ^DIK

 +5                QUIT 

               End DoDot:1

 +6        IF $GET(^DD(3.2,5.2,1,1,"%D",1,0))["temporary trigger"

               Begin DoDot:1

 +7                SET DIK="^DD(3.2,DA(1),1,"

                   SET DA=1

                   SET DA(1)=5.2

                   SET DA(2)=3.2

                   DO ^DIK

 +8                QUIT 

               End DoDot:1

 +9        QUIT 

PROT      ; add 'Edit a Protocol' option into the 'Menu Management' menu.

 +1        NEW XUS

 +2        SET XUS=$$ADD^XPDMENU("XUMAINT","XUPROTOCOL EDIT")

 +3        QUIT