DG53739P.m

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 ---DG53739P   1638     printed  Apr 09, 2024@22:05:50                                                                                                                                                                                                    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      ;