SDES845P ;ALB/MGD,JAS - SD*5.3*845 Post Init Routine ; May 04, 2023
 ;;5.3;SCHEDULING;**845**;AUG 13, 1993;Build 8
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q
 ;
EN ; Update the VS GUI version in #409.98
 D FIND,UPDTRSNS
 Q
 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
 N SDECDA,SDECDA1
 D MES^XPDUTL("")
 D MES^XPDUTL("   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.43
 S DA=SDECDA,DIE=409.98,DR="2///1.7.43;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.43;3///"_DT D ^DIE  ;update VS GUI LOCAL
 K DIE,DR,DA
 Q
 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
 D MES^XPDUTL("   VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
 Q
 ;
UPDTRSNS ;
 ;
 ;   Update CANCELLATION REASONS file
 ;
 D MES^XPDUTL("")
 D MES^XPDUTL("   Updating CANCELLATION REASONS file (#409.2)")
 ;
 N SYSUSELST
 S SYSUSELST("AUTOMATED CANCELLATION")=""
 S SYSUSELST("BLOCK AND MOVE")=""
 S SYSUSELST("DO NOT RESCHEDULE")=""
 S SYSUSELST("RESCHEDULE - CALL BACK")=""
 S SYSUSELST("RESCHEDULE - VET WILL CALL")=""
 ;
 N CANRSNIEN,CANRSNNAME
 S CANRSNNAME=""
 F  S CANRSNNAME=$O(^SD(409.2,"B",CANRSNNAME)) Q:CANRSNNAME=""  D
 . S CANRSNIEN=0
 . F  S CANRSNIEN=$O(^SD(409.2,"B",CANRSNNAME,CANRSNIEN)) Q:'CANRSNIEN  D
 . . I $D(^SD(409.2,CANRSNIEN,0)) D
 . . . N FDA,FERR
 . . . S FDA(409.2,CANRSNIEN_",",6)=0
 . . . I $D(SYSUSELST(CANRSNNAME)) D
 . . . . S FDA(409.2,CANRSNIEN_",",6)=1
 . . . D FILE^DIE("","FDA","FERR")
 . . . I $D(FERR) D
 . . . . D MES^XPDUTL("")
 . . . . D MES^XPDUTL("   Cancellation Reason "_CANRSNNAME_" could not be updated at this time.")
 . . . . D MES^XPDUTL(" Please set the SYSTEM USE ONLY field (#6) manually.")
 D MES^XPDUTL("")
 D MES^XPDUTL("   The update of the CANCELLATION REASONS file (#409.2) has completed.")
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES845P   2183     printed  Sep 23, 2025@20:31:48                                                                                                                                                                                                    Page 2
SDES845P  ;ALB/MGD,JAS - SD*5.3*845 Post Init Routine ; May 04, 2023
 +1       ;;5.3;SCHEDULING;**845**;AUG 13, 1993;Build 8
 +2       ;;Per VHA Directive 6402, this routine should not be modified
 +3       ;
 +4        QUIT 
 +5       ;
EN        ; Update the VS GUI version in #409.98
 +1        DO FIND
           DO UPDTRSNS
 +2        QUIT 
 +3       ;
FIND      ;FIND THE IEN FOR "VS GUI NATIONAL"
 +1        NEW SDECDA,SDECDA1
 +2        DO MES^XPDUTL("")
 +3        DO MES^XPDUTL("   Updating SDEC SETTINGS file (#409.98)")
 +4        SET SDECDA=0
           SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
           if $GET(SDECDA)=""
               GOTO NOFIND
 +5       ;update GUI version number and date
           DO VERSION
 +6        QUIT 
VERSION   ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.43
 +1       ;update VS GUI NATIONAL
           SET DA=SDECDA
           SET DIE=409.98
           SET DR="2///1.7.43;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.43;3///"_DT
           DO ^DIE
 +5        KILL DIE,DR,DA
 +6        QUIT 
 +7       ;
NOFIND    ;"VS GUI NATIONAL" NOT FOUND
 +1        DO MES^XPDUTL("   VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
 +2        QUIT 
 +3       ;
UPDTRSNS  ;
 +1       ;
 +2       ;   Update CANCELLATION REASONS file
 +3       ;
 +4        DO MES^XPDUTL("")
 +5        DO MES^XPDUTL("   Updating CANCELLATION REASONS file (#409.2)")
 +6       ;
 +7        NEW SYSUSELST
 +8        SET SYSUSELST("AUTOMATED CANCELLATION")=""
 +9        SET SYSUSELST("BLOCK AND MOVE")=""
 +10       SET SYSUSELST("DO NOT RESCHEDULE")=""
 +11       SET SYSUSELST("RESCHEDULE - CALL BACK")=""
 +12       SET SYSUSELST("RESCHEDULE - VET WILL CALL")=""
 +13      ;
 +14       NEW CANRSNIEN,CANRSNNAME
 +15       SET CANRSNNAME=""
 +16       FOR 
               SET CANRSNNAME=$ORDER(^SD(409.2,"B",CANRSNNAME))
               if CANRSNNAME=""
                   QUIT 
               Begin DoDot:1
 +17               SET CANRSNIEN=0
 +18               FOR 
                       SET CANRSNIEN=$ORDER(^SD(409.2,"B",CANRSNNAME,CANRSNIEN))
                       if 'CANRSNIEN
                           QUIT 
                       Begin DoDot:2
 +19                       IF $DATA(^SD(409.2,CANRSNIEN,0))
                               Begin DoDot:3
 +20                               NEW FDA,FERR
 +21                               SET FDA(409.2,CANRSNIEN_",",6)=0
 +22                               IF $DATA(SYSUSELST(CANRSNNAME))
                                       Begin DoDot:4
 +23                                       SET FDA(409.2,CANRSNIEN_",",6)=1
                                       End DoDot:4
 +24                               DO FILE^DIE("","FDA","FERR")
 +25                               IF $DATA(FERR)
                                       Begin DoDot:4
 +26                                       DO MES^XPDUTL("")
 +27                                       DO MES^XPDUTL("   Cancellation Reason "_CANRSNNAME_" could not be updated at this time.")
 +28                                       DO MES^XPDUTL(" Please set the SYSTEM USE ONLY field (#6) manually.")
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +29       DO MES^XPDUTL("")
 +30       DO MES^XPDUTL("   The update of the CANCELLATION REASONS file (#409.2) has completed.")
 +31       QUIT