SDES903P ;ALB/TJB - SD*5.3*903 Post Init Routine ; MAR 31, 2025
;;5.3;SCHEDULING;**903**;AUG 13, 1993;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EN ; Update the VS GUI version in #409.98
D APPTYPE
Q
;
APPTYPE ;
N FDA,DESC,FDAIEN,ERR,FILEERR,NEWIEN
Q:$D(^SD(409.1,"B","HUD/VASH"))&($D(^SD(409.1,"B","ALLIED VETERAN")))&($D(^SD(409.1,"B","REGISTRY EXAM")))
D MES^XPDUTL("")
D MES^XPDUTL(" Adding HUD/VASH to the Appointment Type file (#409.1)")
S FDA(409.1,"+1,",.01)="HUD/VASH"
S FDA(409.1,"+1,",2)=1
S FDA(409.1,"+1,",4)="HV"
S FDA(409.1,"+1,",5)=1
S FDA(409.1,"+1,",6)=$O(^DIC(8,"B","HUD-VASH",0))
D UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
I $D(FILEERR) D Q
.D MES^XPDUTL("")
.D MES^XPDUTL("Error adding HUD/VASH to the Appointment Type file.")
.D MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
.D MES^XPDUTL("team.")
;
D MES^XPDUTL("")
D MES^XPDUTL(" Adding ALLIED VETERAN to the Appointment Type file (#409.1)")
K FDA,NEWIEN,FILERRR
S FDA(409.1,"+1,",.01)="ALLIED VETERAN"
S FDA(409.1,"+1,",2)=1
S FDA(409.1,"+1,",4)="AV"
S FDA(409.1,"+1,",5)=1
S FDA(409.1,"+1,",6)=$O(^DIC(8,"B","ALLIED VETERAN",0))
D UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
I $D(FILEERR) D Q
.D MES^XPDUTL("")
.D MES^XPDUTL("Error adding ALLIED VETERAN to the Appointment Type file.")
.D MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
.D MES^XPDUTL("team.")
;
D MES^XPDUTL("")
D MES^XPDUTL(" Adding REGISTRY EXAM to the Appointment Type file (#409.1)")
K FDA,NEWIEN,FILERRR
S FDA(409.1,"+1,",.01)="REGISTRY EXAM"
S FDA(409.1,"+1,",2)=1
S FDA(409.1,"+1,",4)="RE"
S FDA(409.1,"+1,",5)=1
S FDA(409.1,"+1,",6)=$O(^DIC(8,"B","CLINICAL EVALUATION",0))
D UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
I $D(FILEERR) D Q
.D MES^XPDUTL("")
.D MES^XPDUTL("Error adding REGISTRY EXAM to the Appointment Type file.")
.D MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
.D MES^XPDUTL("team.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES903P 2079 printed Sep 23, 2025@20:32:17 Page 2
SDES903P ;ALB/TJB - SD*5.3*903 Post Init Routine ; MAR 31, 2025
+1 ;;5.3;SCHEDULING;**903**;AUG 13, 1993;Build 3
+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 APPTYPE
+2 QUIT
+3 ;
APPTYPE ;
+1 NEW FDA,DESC,FDAIEN,ERR,FILEERR,NEWIEN
+2 if $DATA(^SD(409.1,"B","HUD/VASH"))&($DATA(^SD(409.1,"B","ALLIED VETERAN")))&($DATA(^SD(409.1,"B","REGISTRY EXAM")))
QUIT
+3 DO MES^XPDUTL("")
+4 DO MES^XPDUTL(" Adding HUD/VASH to the Appointment Type file (#409.1)")
+5 SET FDA(409.1,"+1,",.01)="HUD/VASH"
+6 SET FDA(409.1,"+1,",2)=1
+7 SET FDA(409.1,"+1,",4)="HV"
+8 SET FDA(409.1,"+1,",5)=1
+9 SET FDA(409.1,"+1,",6)=$ORDER(^DIC(8,"B","HUD-VASH",0))
+10 DO UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
+11 IF $DATA(FILEERR)
Begin DoDot:1
+12 DO MES^XPDUTL("")
+13 DO MES^XPDUTL("Error adding HUD/VASH to the Appointment Type file.")
+14 DO MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
+15 DO MES^XPDUTL("team.")
End DoDot:1
QUIT
+16 ;
+17 DO MES^XPDUTL("")
+18 DO MES^XPDUTL(" Adding ALLIED VETERAN to the Appointment Type file (#409.1)")
+19 KILL FDA,NEWIEN,FILERRR
+20 SET FDA(409.1,"+1,",.01)="ALLIED VETERAN"
+21 SET FDA(409.1,"+1,",2)=1
+22 SET FDA(409.1,"+1,",4)="AV"
+23 SET FDA(409.1,"+1,",5)=1
+24 SET FDA(409.1,"+1,",6)=$ORDER(^DIC(8,"B","ALLIED VETERAN",0))
+25 DO UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
+26 IF $DATA(FILEERR)
Begin DoDot:1
+27 DO MES^XPDUTL("")
+28 DO MES^XPDUTL("Error adding ALLIED VETERAN to the Appointment Type file.")
+29 DO MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
+30 DO MES^XPDUTL("team.")
End DoDot:1
QUIT
+31 ;
+32 DO MES^XPDUTL("")
+33 DO MES^XPDUTL(" Adding REGISTRY EXAM to the Appointment Type file (#409.1)")
+34 KILL FDA,NEWIEN,FILERRR
+35 SET FDA(409.1,"+1,",.01)="REGISTRY EXAM"
+36 SET FDA(409.1,"+1,",2)=1
+37 SET FDA(409.1,"+1,",4)="RE"
+38 SET FDA(409.1,"+1,",5)=1
+39 SET FDA(409.1,"+1,",6)=$ORDER(^DIC(8,"B","CLINICAL EVALUATION",0))
+40 DO UPDATE^DIE(,"FDA","NEWIEN","FILEERR")
+41 IF $DATA(FILEERR)
Begin DoDot:1
+42 DO MES^XPDUTL("")
+43 DO MES^XPDUTL("Error adding REGISTRY EXAM to the Appointment Type file.")
+44 DO MES^XPDUTL("Please create a SNOW ticket and route to the Vista Scheduling")
+45 DO MES^XPDUTL("team.")
End DoDot:1
QUIT
+46 QUIT
