DG53739P ;ALB/DHH - post-install for DG*5.3*739 ; 1/18/07 9:42am
;;5.3;Registration;**739**;Aug 13, 1993;Build 5
EN ;
;FIND SERVER
N DGI,DGPROT,DA,Y,DIC,X,DGS,DIK
F DGI=1:1 S DGPROT=$P($T(PROT+DGI),";;",2) Q:DGPROT="QUIT" D
. S X=$P(DGPROT,"^")
. S DIC="^ORD(101," D ^DIC Q:+Y'>0 D
.. S DGS=+Y D ITEM
.. I +Y'>0&(DGPROT'["A19") D MES^XPDUTL(" "_$P(DGPROT,"^",2)_" client item was not found!!!")
.. S X=$P(DGPROT,"^",2),DIC="^ORD(101,"_DGS_",775," D ^DIC Q:+Y'>0 D
... S DA(1)=DGS,DA=+Y,DIK="^ORD(101,"_DA(1)_",775," D ^DIK S Y=1
... D MES^XPDUTL(" "_$P(DGPROT,"^",2)_" client subscriber deleted ")
. I Y'>0 D MES^XPDUTL(" "_$P(DGPROT,"^",2)_" client subscriber not found !!!")
I +Y'>0&(DGPROT'="QUIT") D MES^XPDUTL(" "_$P(DGPROT,"^",1)_" server protocol not found!!!")
Q
;
ITEM ;Remove item entry from server protocol
S DIC="^ORD(101,"_DGS_",10,",X=$P(DGPROT,"^",2) D ^DIC Q:+Y'>0 D
. S DA=+Y,DA(1)=DGS,DIK="^ORD(101,"_DA(1)_",10," D ^DIK S Y=1
. D MES^XPDUTL(" "_$P(DGPROT,"^",2)_" client item has been deleted from "_$P(DGPROT,"^")_" server protocol")
Q
;
PROT ;Protocol (Server)^Protocol (Subscriber)
;;VAFC ADT-A01 SERVER^DG PTF ADT-A01 CLIENT
;;VAFC ADT-A02 SERVER^DG PTF ADT-A02 CLIENT
;;VAFC ADT-A03 SERVER^DG PTF ADT-A03 CLIENT
;;VAFC ADT-A04 SERVER^DG PTF ADT-A04 CLIENT
;;VAFC ADT-A08 SERVER^DG PTF ADT-A08 CLIENT
;;VAFC ADT-A08-TSP SERVER^DG PTF ADT-A08-TSP CLIENT
;;VAFC ADT-A11 SERVER^DG PTF ADT-A11 CLIENT
;;VAFC ADT-A12 SERVER^DG PTF ADT-A12 CLIENT
;;VAFC ADT-A13 SERVER^DG PTF ADT-A13 CLIENT
;;VAFC ADT-A19 SERVER^DG PTF ADT-A19 CLIENT
;;QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53739P 1638 printed Nov 22, 2024@17:48:36 Page 2
DG53739P ;ALB/DHH - post-install for DG*5.3*739 ; 1/18/07 9:42am
+1 ;;5.3;Registration;**739**;Aug 13, 1993;Build 5
EN ;
+1 ;FIND SERVER
+2 NEW DGI,DGPROT,DA,Y,DIC,X,DGS,DIK
+3 FOR DGI=1:1
SET DGPROT=$PIECE($TEXT(PROT+DGI),";;",2)
if DGPROT="QUIT"
QUIT
Begin DoDot:1
+4 SET X=$PIECE(DGPROT,"^")
+5 SET DIC="^ORD(101,"
DO ^DIC
if +Y'>0
QUIT
Begin DoDot:2
+6 SET DGS=+Y
DO ITEM
+7 IF +Y'>0&(DGPROT'["A19")
DO MES^XPDUTL(" "_$PIECE(DGPROT,"^",2)_" client item was not found!!!")
+8 SET X=$PIECE(DGPROT,"^",2)
SET DIC="^ORD(101,"_DGS_",775,"
DO ^DIC
if +Y'>0
QUIT
Begin DoDot:3
+9 SET DA(1)=DGS
SET DA=+Y
SET DIK="^ORD(101,"_DA(1)_",775,"
DO ^DIK
SET Y=1
+10 DO MES^XPDUTL(" "_$PIECE(DGPROT,"^",2)_" client subscriber deleted ")
End DoDot:3
End DoDot:2
+11 IF Y'>0
DO MES^XPDUTL(" "_$PIECE(DGPROT,"^",2)_" client subscriber not found !!!")
End DoDot:1
+12 IF +Y'>0&(DGPROT'="QUIT")
DO MES^XPDUTL(" "_$PIECE(DGPROT,"^",1)_" server protocol not found!!!")
+13 QUIT
+14 ;
ITEM ;Remove item entry from server protocol
+1 SET DIC="^ORD(101,"_DGS_",10,"
SET X=$PIECE(DGPROT,"^",2)
DO ^DIC
if +Y'>0
QUIT
Begin DoDot:1
+2 SET DA=+Y
SET DA(1)=DGS
SET DIK="^ORD(101,"_DA(1)_",10,"
DO ^DIK
SET Y=1
+3 DO MES^XPDUTL(" "_$PIECE(DGPROT,"^",2)_" client item has been deleted from "_$PIECE(DGPROT,"^")_" server protocol")
End DoDot:1
+4 QUIT
+5 ;
PROT ;Protocol (Server)^Protocol (Subscriber)
+1 ;;VAFC ADT-A01 SERVER^DG PTF ADT-A01 CLIENT
+2 ;;VAFC ADT-A02 SERVER^DG PTF ADT-A02 CLIENT
+3 ;;VAFC ADT-A03 SERVER^DG PTF ADT-A03 CLIENT
+4 ;;VAFC ADT-A04 SERVER^DG PTF ADT-A04 CLIENT
+5 ;;VAFC ADT-A08 SERVER^DG PTF ADT-A08 CLIENT
+6 ;;VAFC ADT-A08-TSP SERVER^DG PTF ADT-A08-TSP CLIENT
+7 ;;VAFC ADT-A11 SERVER^DG PTF ADT-A11 CLIENT
+8 ;;VAFC ADT-A12 SERVER^DG PTF ADT-A12 CLIENT
+9 ;;VAFC ADT-A13 SERVER^DG PTF ADT-A13 CLIENT
+10 ;;VAFC ADT-A19 SERVER^DG PTF ADT-A19 CLIENT
+11 ;;QUIT
+12 ;
