- 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 Mar 13, 2025@22:00:12 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
