SDES904P ;ALB/JHV/JSJ,JAS,BWF - SD*5.3*904 Post Init Routine ; MAR 27, 2025
;;5.3;SCHEDULING;**904**;AUG 13, 1993;Build 1
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to NEW PERSON (200), KEY (200.051) in ICR #7054
; Reference to SECURITY KEY (19.1) in ICR #505
;
Q
;
EN ;
D TASK,TASK2,TASK3,VSE9529,TASK4
Q
;
TASK ; tasks off process to remove null comment audit entries from Recall Reminders file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the COMMENT")
D MES^XPDUTL(" AUDIT (#403.57) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*904 Post Install Routine Task 1"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNRECREMS^SDES904P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNRECREMS ;
;
N RECREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
S RECREQIEN=0
F S RECREQIEN=$O(^SD(403.5,RECREQIEN)) Q:'RECREQIEN I $D(^SD(403.5,RECREQIEN,2)) D
. S COMAUDIEN=0
. F S COMAUDIEN=$O(^SD(403.5,RECREQIEN,2,COMAUDIEN)) Q:'COMAUDIEN D
. . Q:'$D(^SD(403.5,RECREQIEN,2,COMAUDIEN,0))
. . S COMMENT=$$GET1^DIQ(403.57,COMAUDIEN_","_RECREQIEN_",",2)
. . I COMMENT="" D
. . . S FDA(403.57,COMAUDIEN_","_RECREQIEN_",",.01)="@"
. . . D FILE^DIE("","FDA") K FDA
Q
;
TASK2 ; tasks off process to remove null comment audit entries from SDEC Appt Request file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the COMMENTS")
D MES^XPDUTL(" AUDIT (#409.8527) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*904 Post Install Routine Task 2"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPREQS^SDES904P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNAPREQS ;
;
N APREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
S APREQIEN=0
F S APREQIEN=$O(^SDEC(409.85,APREQIEN)) Q:'APREQIEN I $D(^SDEC(409.85,APREQIEN,"COMAUD")) D
. S COMAUDIEN=0
. F S COMAUDIEN=$O(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN)) Q:'COMAUDIEN D
. . S COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
. . I COMMENT="" D
. . . S FDA(409.8527,COMAUDIEN_","_APREQIEN_",",.01)="@"
. . . D FILE^DIE("","FDA") K FDA
Q
;
TASK3 ; tasks off process to remove null note audit entries from SDEC Appointment file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the NOTE")
D MES^XPDUTL(" AUDIT (#409.847) sub-file is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*904 Post Install Routine Task 3"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="CLNAPPTS^SDES904P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
CLNAPPTS ;
;
N APPTIEN,APREQIEN,COMAUDIEN,COMMARRAY,COMMENT,COMMENTS,COMMIEN,DATEIEN,EDITEDNOTE,FDA,REQREC
S DATEIEN=3231130.999999
F S DATEIEN=$O(^SDEC(409.84,"B",DATEIEN)) Q:'DATEIEN D
. S APPTIEN=0
. F S APPTIEN=$O(^SDEC(409.84,"B",DATEIEN,APPTIEN)) Q:'APPTIEN I $D(^SDEC(409.84,APPTIEN,"NOTEAUD")) D
. . S COMAUDIEN=0
. . F S COMAUDIEN=$O(^SDEC(409.84,APPTIEN,"NOTEAUD",COMAUDIEN)) Q:'COMAUDIEN D
. . . S COMMENT=$$GET1^DIQ(409.847,COMAUDIEN_","_APPTIEN_",",2)
. . . I COMMENT="" D
. . . . S FDA(409.847,COMAUDIEN_","_APPTIEN_",",.01)="@"
. . . . D UPDATE^DIE("","FDA") K FDA
Q
;
VSE9529 ;report of appointments booked for 3/1/2026 and after and were booked before 3/10/2025
N APPTST,MDDT
K ^XTMP("SDES904P","VSE-9529")
S APPTST=$$ISOTFM^SDAMUTDT("2026-03-01T00:01-0400")
S MDDT=$$ISOTFM^SDAMUTDT("2025-03-10T00:00-0400")
D ACTIVAPT(APPTST,MDDT)
D MAIL
Q
;
ACTIVAPT(APPTST,MDDT) ;
N APPTDT,RECCNT,APPTIEN,WHOMADE,WHOMADENM,CLINIC,CLINICTXT,WHENMADE,WHENMADETXT,APPTDTTX,NODENUM,RESOURCE,STATUS
S RECCNT=0
S ^XTMP("SDES904P","VSE-9529",1)="CLINIC NAME;APPOINTMENT DATE/TIME;APPOINTMENT MADE DATE/TIME;WHO MADE"
S NODENUM=1
S APPTDT=APPTST-.0001
F S APPTDT=$O(^SDEC(409.84,"B",APPTDT)) Q:'APPTDT D
. S APPTDTTX=$P($$FMTISO^SDAMUTDT(APPTDT),"-",1,3)
. S APPTIEN=0 F S APPTIEN=$O(^SDEC(409.84,"B",APPTDT,APPTIEN)) Q:'APPTIEN D
.. S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
.. S CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
.. S CLINICTXT=$$GET1^DIQ(44,CLINIC,.01,"I")
.. S STATUS=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
.. I STATUS'="" I ",C,CA,PC,PCA,"[STATUS Q
.. S WHOMADE=$$GET1^DIQ(409.84,APPTIEN,.08,"I")
.. S WHOMADENM="UNKNOWN"
.. I WHOMADE'="" S WHOMADENM=$$GET1^DIQ(200,WHOMADE,.01,"I")
.. S WHENMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
.. I WHENMADE>MDDT Q
.. S WHENMADETXT="UNKNOWN"
.. I WHENMADE'="" S WHENMADETXT=$P($$FMTISO^SDAMUTDT(WHENMADE,CLINIC),"-",1,3)
.. S RECCNT=RECCNT+1,NODENUM=NODENUM+1
.. S ^XTMP("SDES904P","VSE-9529",NODENUM)=CLINICTXT_";"_APPTDTTX_";"_WHENMADETXT_";"_WHOMADENM
S NODENUM=NODENUM+1
S ^XTMP("SDES904P","VSE-9529",NODENUM)="TOTAL NUMBER RECORDS IMPACTED: "_RECCNT
Q
TASK4 ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*904 Post-Install to assign SDECVIEW to appropriate users")
D MES^XPDUTL(" is being queued to run in the background.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*904 Post Install Routine - SDECVIEW key assignment"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="SDECVIEW^SDES904P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
SDECVIEW ;
N KEYS,RES,USER,SDECVIEWIEN,FDA,DINUMIEN,USERKEY,KEYIEN,KEYNAME,HASSDKEY
S KEYS(1)="ORES"
S KEYS(2)="ORELSE"
S SDECVIEWIEN=$$LKUP^XPDKEY("SDECVIEW")
I 'SDECVIEWIEN Q
;
S USER=0 F S USER=$O(^VA(200,USER)) Q:'USER D
.Q:'+$$ACTIVE^XUSER(USER)
.; do not add to any user that has an SD* key
.S (USERKEY,HASSDKEY)=0
.F S USERKEY=$O(^VA(200,USER,51,USERKEY)) Q:'USERKEY!(HASSDKEY) D
..S KEYIEN=$$GET1^DIQ(200.051,USERKEY_","_USER_",",.01,"I")
..S KEYNAME=$$GET1^DIQ(19.1,KEYIEN,.01,"E")
..I $E(KEYNAME,1,2)="SD"!(KEYNAME="SDECVIEW") S HASSDKEY=1
.Q:HASSDKEY
.K RES
.D OWNSKEY^XUSRB(.RES,.KEYS,USER)
.; User has ORES or ORELSE
.I RES(1)!(RES(2)) D
..; add key to current user
..S FDA(200.051,"+1,"_USER_",",.01)=SDECVIEWIEN
..S FDA(200.051,"+1,"_USER_",",1)=.5
..S FDA(200.051,"+1,"_USER_",",2)=DT
..S DINUMIEN(1)=SDECVIEWIEN
..D UPDATE^DIE(,"FDA","DINUMIEN") K FDA
Q
;
MAIL ;
N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES904P"",""VSE-9529"","
S XMSUB=MESS1_"SD*5.3*904 - Post Install Data Report VSE-9529"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
S XMY("CRUZ RIVERA,ORLANDO E@DOMAIN.EXT")=""
S XMY("JACK.STEVENS@DOMAIN.EXT")=""
D ^XMD
K ^XTMP("SDES904","VSE-9529")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES904P 7812 printed Sep 23, 2025@20:32:18 Page 2
SDES904P ;ALB/JHV/JSJ,JAS,BWF - SD*5.3*904 Post Init Routine ; MAR 27, 2025
+1 ;;5.3;SCHEDULING;**904**;AUG 13, 1993;Build 1
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to NEW PERSON (200), KEY (200.051) in ICR #7054
+5 ; Reference to SECURITY KEY (19.1) in ICR #505
+6 ;
+7 QUIT
+8 ;
EN ;
+1 DO TASK
DO TASK2
DO TASK3
DO VSE9529
DO TASK4
+2 QUIT
+3 ;
TASK ; tasks off process to remove null comment audit entries from Recall Reminders file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the COMMENT")
+3 DO MES^XPDUTL(" AUDIT (#403.57) sub-file is being queued to run in the background.")
+4 DO MES^XPDUTL("")
+5 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+6 SET ZTDESC="SD*5.3*904 Post Install Routine Task 1"
+7 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNRECREMS^SDES904P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
Begin DoDot:1
+9 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+10 DO MES^XPDUTL("")
End DoDot:1
+11 IF '$DATA(ZTSK)
Begin DoDot:1
+12 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+13 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+14 QUIT
+15 ;
CLNRECREMS ;
+1 ;
+2 NEW RECREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
+3 SET RECREQIEN=0
+4 FOR
SET RECREQIEN=$ORDER(^SD(403.5,RECREQIEN))
if 'RECREQIEN
QUIT
IF $DATA(^SD(403.5,RECREQIEN,2))
Begin DoDot:1
+5 SET COMAUDIEN=0
+6 FOR
SET COMAUDIEN=$ORDER(^SD(403.5,RECREQIEN,2,COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:2
+7 if '$DATA(^SD(403.5,RECREQIEN,2,COMAUDIEN,0))
QUIT
+8 SET COMMENT=$$GET1^DIQ(403.57,COMAUDIEN_","_RECREQIEN_",",2)
+9 IF COMMENT=""
Begin DoDot:3
+10 SET FDA(403.57,COMAUDIEN_","_RECREQIEN_",",.01)="@"
+11 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
TASK2 ; tasks off process to remove null comment audit entries from SDEC Appt Request file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the COMMENTS")
+3 DO MES^XPDUTL(" AUDIT (#409.8527) sub-file is being queued to run in the background.")
+4 DO MES^XPDUTL("")
+5 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+6 SET ZTDESC="SD*5.3*904 Post Install Routine Task 2"
+7 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNAPREQS^SDES904P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
Begin DoDot:1
+9 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+10 DO MES^XPDUTL("")
End DoDot:1
+11 IF '$DATA(ZTSK)
Begin DoDot:1
+12 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+13 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+14 QUIT
+15 ;
CLNAPREQS ;
+1 ;
+2 NEW APREQIEN,COMAUDIEN,COMMENT,COMMENTS,FDA
+3 SET APREQIEN=0
+4 FOR
SET APREQIEN=$ORDER(^SDEC(409.85,APREQIEN))
if 'APREQIEN
QUIT
IF $DATA(^SDEC(409.85,APREQIEN,"COMAUD"))
Begin DoDot:1
+5 SET COMAUDIEN=0
+6 FOR
SET COMAUDIEN=$ORDER(^SDEC(409.85,APREQIEN,"COMAUD",COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:2
+7 SET COMMENT=$$GET1^DIQ(409.8527,COMAUDIEN_","_APREQIEN_",",2)
+8 IF COMMENT=""
Begin DoDot:3
+9 SET FDA(409.8527,COMAUDIEN_","_APREQIEN_",",.01)="@"
+10 DO FILE^DIE("","FDA")
KILL FDA
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
TASK3 ; tasks off process to remove null note audit entries from SDEC Appointment file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*904 Post-Install to remove null entries from the NOTE")
+3 DO MES^XPDUTL(" AUDIT (#409.847) sub-file is being queued to run in the background.")
+4 DO MES^XPDUTL("")
+5 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+6 SET ZTDESC="SD*5.3*904 Post Install Routine Task 3"
+7 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="CLNAPPTS^SDES904P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
Begin DoDot:1
+9 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+10 DO MES^XPDUTL("")
End DoDot:1
+11 IF '$DATA(ZTSK)
Begin DoDot:1
+12 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+13 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+14 QUIT
+15 ;
CLNAPPTS ;
+1 ;
+2 NEW APPTIEN,APREQIEN,COMAUDIEN,COMMARRAY,COMMENT,COMMENTS,COMMIEN,DATEIEN,EDITEDNOTE,FDA,REQREC
+3 SET DATEIEN=3231130.999999
+4 FOR
SET DATEIEN=$ORDER(^SDEC(409.84,"B",DATEIEN))
if 'DATEIEN
QUIT
Begin DoDot:1
+5 SET APPTIEN=0
+6 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",DATEIEN,APPTIEN))
if 'APPTIEN
QUIT
IF $DATA(^SDEC(409.84,APPTIEN,"NOTEAUD"))
Begin DoDot:2
+7 SET COMAUDIEN=0
+8 FOR
SET COMAUDIEN=$ORDER(^SDEC(409.84,APPTIEN,"NOTEAUD",COMAUDIEN))
if 'COMAUDIEN
QUIT
Begin DoDot:3
+9 SET COMMENT=$$GET1^DIQ(409.847,COMAUDIEN_","_APPTIEN_",",2)
+10 IF COMMENT=""
Begin DoDot:4
+11 SET FDA(409.847,COMAUDIEN_","_APPTIEN_",",.01)="@"
+12 DO UPDATE^DIE("","FDA")
KILL FDA
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
VSE9529 ;report of appointments booked for 3/1/2026 and after and were booked before 3/10/2025
+1 NEW APPTST,MDDT
+2 KILL ^XTMP("SDES904P","VSE-9529")
+3 SET APPTST=$$ISOTFM^SDAMUTDT("2026-03-01T00:01-0400")
+4 SET MDDT=$$ISOTFM^SDAMUTDT("2025-03-10T00:00-0400")
+5 DO ACTIVAPT(APPTST,MDDT)
+6 DO MAIL
+7 QUIT
+8 ;
ACTIVAPT(APPTST,MDDT) ;
+1 NEW APPTDT,RECCNT,APPTIEN,WHOMADE,WHOMADENM,CLINIC,CLINICTXT,WHENMADE,WHENMADETXT,APPTDTTX,NODENUM,RESOURCE,STATUS
+2 SET RECCNT=0
+3 SET ^XTMP("SDES904P","VSE-9529",1)="CLINIC NAME;APPOINTMENT DATE/TIME;APPOINTMENT MADE DATE/TIME;WHO MADE"
+4 SET NODENUM=1
+5 SET APPTDT=APPTST-.0001
+6 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"B",APPTDT))
if 'APPTDT
QUIT
Begin DoDot:1
+7 SET APPTDTTX=$PIECE($$FMTISO^SDAMUTDT(APPTDT),"-",1,3)
+8 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",APPTDT,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+9 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+10 SET CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+11 SET CLINICTXT=$$GET1^DIQ(44,CLINIC,.01,"I")
+12 SET STATUS=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
+13 IF STATUS'=""
IF ",C,CA,PC,PCA,"[STATUS
QUIT
+14 SET WHOMADE=$$GET1^DIQ(409.84,APPTIEN,.08,"I")
+15 SET WHOMADENM="UNKNOWN"
+16 IF WHOMADE'=""
SET WHOMADENM=$$GET1^DIQ(200,WHOMADE,.01,"I")
+17 SET WHENMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
+18 IF WHENMADE>MDDT
QUIT
+19 SET WHENMADETXT="UNKNOWN"
+20 IF WHENMADE'=""
SET WHENMADETXT=$PIECE($$FMTISO^SDAMUTDT(WHENMADE,CLINIC),"-",1,3)
+21 SET RECCNT=RECCNT+1
SET NODENUM=NODENUM+1
+22 SET ^XTMP("SDES904P","VSE-9529",NODENUM)=CLINICTXT_";"_APPTDTTX_";"_WHENMADETXT_";"_WHOMADENM
End DoDot:2
End DoDot:1
+23 SET NODENUM=NODENUM+1
+24 SET ^XTMP("SDES904P","VSE-9529",NODENUM)="TOTAL NUMBER RECORDS IMPACTED: "_RECCNT
+25 QUIT
TASK4 ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*904 Post-Install to assign SDECVIEW to appropriate users")
+3 DO MES^XPDUTL(" is being queued to run in the background.")
+4 DO MES^XPDUTL("")
+5 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+6 SET ZTDESC="SD*5.3*904 Post Install Routine - SDECVIEW key assignment"
+7 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="SDECVIEW^SDES904P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
Begin DoDot:1
+9 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+10 DO MES^XPDUTL("")
End DoDot:1
+11 IF '$DATA(ZTSK)
Begin DoDot:1
+12 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+13 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+14 QUIT
SDECVIEW ;
+1 NEW KEYS,RES,USER,SDECVIEWIEN,FDA,DINUMIEN,USERKEY,KEYIEN,KEYNAME,HASSDKEY
+2 SET KEYS(1)="ORES"
+3 SET KEYS(2)="ORELSE"
+4 SET SDECVIEWIEN=$$LKUP^XPDKEY("SDECVIEW")
+5 IF 'SDECVIEWIEN
QUIT
+6 ;
+7 SET USER=0
FOR
SET USER=$ORDER(^VA(200,USER))
if 'USER
QUIT
Begin DoDot:1
+8 if '+$$ACTIVE^XUSER(USER)
QUIT
+9 ; do not add to any user that has an SD* key
+10 SET (USERKEY,HASSDKEY)=0
+11 FOR
SET USERKEY=$ORDER(^VA(200,USER,51,USERKEY))
if 'USERKEY!(HASSDKEY)
QUIT
Begin DoDot:2
+12 SET KEYIEN=$$GET1^DIQ(200.051,USERKEY_","_USER_",",.01,"I")
+13 SET KEYNAME=$$GET1^DIQ(19.1,KEYIEN,.01,"E")
+14 IF $EXTRACT(KEYNAME,1,2)="SD"!(KEYNAME="SDECVIEW")
SET HASSDKEY=1
End DoDot:2
+15 if HASSDKEY
QUIT
+16 KILL RES
+17 DO OWNSKEY^XUSRB(.RES,.KEYS,USER)
+18 ; User has ORES or ORELSE
+19 IF RES(1)!(RES(2))
Begin DoDot:2
+20 ; add key to current user
+21 SET FDA(200.051,"+1,"_USER_",",.01)=SDECVIEWIEN
+22 SET FDA(200.051,"+1,"_USER_",",1)=.5
+23 SET FDA(200.051,"+1,"_USER_",",2)=DT
+24 SET DINUMIEN(1)=SDECVIEWIEN
+25 DO UPDATE^DIE(,"FDA","DINUMIEN")
KILL FDA
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
MAIL ;
+1 NEW STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,%,D,D0,D1,D2,DG,DIC,DICR,DIW,XMDUN,XMZ
+2 SET STANUM=$$KSP^XUPARAM("INST")_","
+3 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+4 SET MESS1="Station: "_STANUM_" - "
+5 SET XMDUZ=DUZ
+6 SET XMTEXT="^XTMP(""SDES904P"",""VSE-9529"","
+7 SET XMSUB=MESS1_"SD*5.3*904 - Post Install Data Report VSE-9529"
+8 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+9 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+10 SET XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
+11 SET XMY("CRUZ RIVERA,ORLANDO E@DOMAIN.EXT")=""
+12 SET XMY("JACK.STEVENS@DOMAIN.EXT")=""
+13 DO ^XMD
+14 KILL ^XTMP("SDES904","VSE-9529")
+15 QUIT
