SDEC797P.m

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 ---SDEC797P   2843     printed  Apr 23, 2025@19:05:47                                                                                                                                                                                                    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       ;