SDEC797P ;ALB/MGD - SD*5.3*797 Post Init Routine ; Sep 9, 2021@12:18
;;5.3;SCHEDULING;**797**;AUG 13, 1993;Build 8
;
;External References Supported by ICR# Type
;------------------- ----------------- ----------
; $$FIND1^DIC 2051 Supported
; ^DIE 2053 Supported
; UPDATE^DIE 2053 Supported
; BMES^XPDUTL 10141 Supported
; MES^XPDUTL 10141 Supported
;
D FIND
D ADDCNRSN ;add Block and Move to CANCELLATION REASONS File #409.2
Q
;
FIND(SDXPD) ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
W !!?3,"Updating SDEC SETTINGS file (#409.98)",!!
S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
D VERSION ;update GUI version number and date
Q
;
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.13
S DA=SDECDA,DIE=409.98,DR="2///1.7.13;3///"_DT D ^DIE ;update VS GUI NATIONAL
K DIE,DR,DA
S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)="" ;get DA for the VS GUI LOCAL
S DA=SDECDA1,DIE=409.98,DR="2///1.7.13;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
W !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
Q
;
ADDCNRSN ;add Block and Move to CANCELLATION REASONS File #409.2
N SDRSN ;Cancellation Reason name
N SDRSNIEN ;Cancellation Reason IEN
N SDFDA ;FDA for DBS call
N SDERR ;Error array for DBS call
N MES ;message
;
S MES(1)="Checking for existence of the BLOCK AND MOVE in the"
S MES(2)="CANCELLATION REASONS File #409.2."
D MES^XPDUTL(.MES)
K SDERR S SDRSN="BLOCK AND MOVE",SDRSNIEN=$$FIND1^DIC(409.2,"","MX",SDRSN,"","","SDERR")
I +SDRSNIEN>0 D Q
. K MES
. S MES(1)=" "
. S MES(2)="The BLOCK AND MOVE cancellation reason already exist in File #409.2."
. S MES(3)="No Action Taken."
. S MES(4)=" "
. D MES^XPDUTL(.MES)
I $D(SDERR) D DISPERR($G(SDERR("DIERR",1,"TEXT",1))) Q ;do not continue if error occurs
;
D BMES^XPDUTL("Adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2")
S SDFDA(409.2,"+1,",.01)=SDRSN ;Cancellation Reason Name
S SDFDA(409.2,"+1,",2)="C" ;'C'linic - cancellation reason type
K SDERR D UPDATE^DIE("E","SDFDA","","SDERR")
I $D(SDERR) D DISPERR($G(SDERR("DIERR",1,"TEXT",1))) Q ;do not continue if error occurs
;
D BMES^XPDUTL("BLOCK AND MOVE successfully added to CANCELLATION REASONS File #409.2.")
Q
;
DISPERR(ERROR) ; display error message
K MES
S MES(1)=" "
S MES(2)="Error while adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2."
S MES(3)="Error: "_ERROR
S MES(4)=" "
D MES^XPDUTL(.MES)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC797P 2843 printed Apr 09, 2024@21:56:59 Page 2
SDEC797P ;ALB/MGD - SD*5.3*797 Post Init Routine ; Sep 9, 2021@12:18
+1 ;;5.3;SCHEDULING;**797**;AUG 13, 1993;Build 8
+2 ;
+3 ;External References Supported by ICR# Type
+4 ;------------------- ----------------- ----------
+5 ; $$FIND1^DIC 2051 Supported
+6 ; ^DIE 2053 Supported
+7 ; UPDATE^DIE 2053 Supported
+8 ; BMES^XPDUTL 10141 Supported
+9 ; MES^XPDUTL 10141 Supported
+10 ;
+11 DO FIND
+12 ;add Block and Move to CANCELLATION REASONS File #409.2
DO ADDCNRSN
+13 QUIT
+14 ;
FIND(SDXPD) ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 WRITE !!?3,"Updating SDEC SETTINGS file (#409.98)",!!
+3 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+4 ;update GUI version number and date
DO VERSION
+5 QUIT
+6 ;
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.13
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.13;3///"_DT
DO ^DIE
+2 KILL DIE,DR,DA
+3 ;get DA for the VS GUI LOCAL
SET SDECDA1=0
SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
if $GET(SDECDA1)=""
QUIT
+4 ;update VS GUI LOCAL
SET DA=SDECDA1
SET DIE=409.98
SET DR="2///1.7.13;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
+1 WRITE !!?3,"VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)"
+2 QUIT
+3 ;
ADDCNRSN ;add Block and Move to CANCELLATION REASONS File #409.2
+1 ;Cancellation Reason name
NEW SDRSN
+2 ;Cancellation Reason IEN
NEW SDRSNIEN
+3 ;FDA for DBS call
NEW SDFDA
+4 ;Error array for DBS call
NEW SDERR
+5 ;message
NEW MES
+6 ;
+7 SET MES(1)="Checking for existence of the BLOCK AND MOVE in the"
+8 SET MES(2)="CANCELLATION REASONS File #409.2."
+9 DO MES^XPDUTL(.MES)
+10 KILL SDERR
SET SDRSN="BLOCK AND MOVE"
SET SDRSNIEN=$$FIND1^DIC(409.2,"","MX",SDRSN,"","","SDERR")
+11 IF +SDRSNIEN>0
Begin DoDot:1
+12 KILL MES
+13 SET MES(1)=" "
+14 SET MES(2)="The BLOCK AND MOVE cancellation reason already exist in File #409.2."
+15 SET MES(3)="No Action Taken."
+16 SET MES(4)=" "
+17 DO MES^XPDUTL(.MES)
End DoDot:1
QUIT
+18 ;do not continue if error occurs
IF $DATA(SDERR)
DO DISPERR($GET(SDERR("DIERR",1,"TEXT",1)))
QUIT
+19 ;
+20 DO BMES^XPDUTL("Adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2")
+21 ;Cancellation Reason Name
SET SDFDA(409.2,"+1,",.01)=SDRSN
+22 ;'C'linic - cancellation reason type
SET SDFDA(409.2,"+1,",2)="C"
+23 KILL SDERR
DO UPDATE^DIE("E","SDFDA","","SDERR")
+24 ;do not continue if error occurs
IF $DATA(SDERR)
DO DISPERR($GET(SDERR("DIERR",1,"TEXT",1)))
QUIT
+25 ;
+26 DO BMES^XPDUTL("BLOCK AND MOVE successfully added to CANCELLATION REASONS File #409.2.")
+27 QUIT
+28 ;
DISPERR(ERROR) ; display error message
+1 KILL MES
+2 SET MES(1)=" "
+3 SET MES(2)="Error while adding BLOCK AND MOVE entry to CANCELLATION REASONS File #409.2."
+4 SET MES(3)="Error: "_ERROR
+5 SET MES(4)=" "
+6 DO MES^XPDUTL(.MES)
+7 QUIT
+8 ;
