XUPOS259 ;SFISC/SO- Correct DISABLE field in Protocols exported in 236 ;10:32 AM 10 Oct 2002
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPOS259 1234 printed Dec 13, 2024@02:11:35 Page 2
XUPOS259 ;SFISC/SO- Correct DISABLE field in Protocols exported in 236 ;10:32 AM 10 Oct 2002
+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
