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 ---[H[J[2J[HXU8P463 608 printed Oct 16, 2024@18:08:35 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
