XUPOS259.m

XUPOS259 ;SFISC/SO- Correct DISABLE field in Protocols exported in 236 ;10:32 AM  10 Oct 2002 [ 07/29/2004   9:01 AM ]

 ;;8.0;KERNEL;**259**;Jul 10, 1995

 ; Get domain pointer for site

 N XUX

 S XUX=$$GET1^DIQ(8989.3,"1,",.01)

 ; If Hoholulu then take no action

 I XUX["HONOLULU" D  Q

 . N X

 . S X="Site Honolulu - no action taken."

 . D MES^XPDUTL(X)

 ; Set DISABLE field for Protocols

 D

 . N DA,DIERR,ERR

 . S DA=$$FIND1^DIC(101,"","X","XUHUI FIELD CHANGE EVENT","B","","ERR")

 . I 'DA D  Q  ;Problem with lookup

 . . N X

 . . S X="Unable to lookup protocol 'XUHUI FIELD CHANGE EVENT' - no action taken."

 . . D MES^XPDUTL(X)

 . . Q

 . N DIE,DR

 . S DIE=101

 . S DR="2///*Do NOT remove this message"

 . D ^DIE

 . N X

 . S X="Protocol 'XUHUI FIELD CHANGE EVENT' has been DISABLED."

 . D MES^XPDUTL(X)

 . Q

 D

 . N DA,DIERR,ERR

 . S DA=$$FIND1^DIC(101,"","X","XUHUI SEND MESSAGE","B","","ERR")

 . I 'DA D  Q  ;Problem with lookup

 . . N X

 . . S X="Unable to lookup protocol 'XUHUI SEND MESSAGE' - no action taken."

 . . D MES^XPDUTL(X)

 . . Q

 . N DIE,DR

 . S DIE=101

 . S DR="2///*Do NOT remove this message"

 . D ^DIE

 . N X

 . S X="Protocol 'XUHUI SEND MESSAGE' has been DISABLED."

 . D MES^XPDUTL(X)

 . Q

 Q

XUPOS259  ;SFISC/SO- Correct DISABLE field in Protocols exported in 236 ;10:32 AM  10 Oct 2002 [ 07/29/2004   9:01 AM ]

 +1       ;;8.0;KERNEL;**259**;Jul 10, 1995

 +2       ; Get domain pointer for site

 +3        NEW XUX

 +4        SET XUX=$$GET1^DIQ(8989.3,"1,",.01)

 +5       ; If Hoholulu then take no action

 +6        IF XUX["HONOLULU"

               Begin DoDot:1

 +7                NEW X

 +8                SET X="Site Honolulu - no action taken."

 +9                DO MES^XPDUTL(X)

               End DoDot:1

               QUIT 

 +10      ; Set DISABLE field for Protocols

 +11       Begin DoDot:1

 +12           NEW DA,DIERR,ERR

 +13           SET DA=$$FIND1^DIC(101,"","X","XUHUI FIELD CHANGE EVENT","B","","ERR")

 +14      ;Problem with lookup

               IF 'DA

                   Begin DoDot:2

 +15                   NEW X

 +16                   SET X="Unable to lookup protocol 'XUHUI FIELD CHANGE EVENT' - no action taken."

 +17                   DO MES^XPDUTL(X)

 +18                   QUIT 

                   End DoDot:2

                   QUIT 

 +19           NEW DIE,DR

 +20           SET DIE=101

 +21           SET DR="2///*Do NOT remove this message"

 +22           DO ^DIE

 +23           NEW X

 +24           SET X="Protocol 'XUHUI FIELD CHANGE EVENT' has been DISABLED."

 +25           DO MES^XPDUTL(X)

 +26           QUIT 

           End DoDot:1

 +27       Begin DoDot:1

 +28           NEW DA,DIERR,ERR

 +29           SET DA=$$FIND1^DIC(101,"","X","XUHUI SEND MESSAGE","B","","ERR")

 +30      ;Problem with lookup

               IF 'DA

                   Begin DoDot:2

 +31                   NEW X

 +32                   SET X="Unable to lookup protocol 'XUHUI SEND MESSAGE' - no action taken."

 +33                   DO MES^XPDUTL(X)

 +34                   QUIT 

                   End DoDot:2

                   QUIT 

 +35           NEW DIE,DR

 +36           SET DIE=101

 +37           SET DR="2///*Do NOT remove this message"

 +38           DO ^DIE

 +39           NEW X

 +40           SET X="Protocol 'XUHUI SEND MESSAGE' has been DISABLED."

 +41           DO MES^XPDUTL(X)

 +42           QUIT 

           End DoDot:1

 +43       QUIT