SDES920P ;ALB/TAW - SD*5.3*920 Post Init Routine ; Oct 3, 2025
;;5.3;SCHEDULING;**920**;AUG 13, 1993;Build 7
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
EN ;
D TASK
Q
;
;
TASK ; tasks off process to update the direct patient schedule field in the hospital location file
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*920 Post-Install to report on appointment on 11/2/2025 or 11/1/2026 via EAS")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*920 Post Install Routine Task 1"
D NOW^%DTC
S ZTDTH=X,ZTIO="",ZTRTN="VSE10986^SDES920P",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
;
VSE10986 ;report of appointments on 11/2/2025 or 11/1/2026 and has EAS number
K ^XTMP("SDES920P")
S ^XTMP("SDES920P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*920"
D ACTIVAPT
D MAIL
K ^XTMP("SDES920P")
Q
;
ACTIVAPT ;
N APPTDT,RECCNT,APPTIEN,WHOMADE,WHOMADENM,CLINIC,CLINICTXT,WHENMADE,WHENMADETXT,APPTDTTX,NODENUM,RESOURCE,STATUS,APPTST
S RECCNT=0
S ^XTMP("SDES920P",1)="CLINIC NAME;APPOINTMENT DATE/TIME;APPOINTMENT MADE DATE/TIME;WHO MADE"
S NODENUM=2
D APPTLOOP(3251102)
D APPTLOOP(3261101)
S NODENUM=NODENUM+1
S ^XTMP("SDES920P",NODENUM)="TOTAL NUMBER RECORDS IMPACTED: "_RECCNT
Q
APPTLOOP(APPTST) ;
N ENDDT,EAS
S ENDDT=APPTST+1
S APPTDT=APPTST-.0001
F S APPTDT=$O(^SDEC(409.84,"B",APPTDT)) Q:('APPTDT)!(APPTDT>=ENDDT) 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 EAS=$$GET1^DIQ(409.84,APPTIEN,100)
.. Q:$G(EAS)=""
.. 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>3260311 Q
.. S WHENMADETXT="UNKNOWN"
.. I WHENMADE'="" S WHENMADETXT=$P($$FMTISO^SDAMUTDT(WHENMADE,CLINIC),"-",1,3)
.. S RECCNT=RECCNT+1,NODENUM=NODENUM+1
.. S ^XTMP("SDES920P",NODENUM)=CLINICTXT_";"_APPTDTTX_";"_WHENMADETXT_";"_WHOMADENM
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(""SDES920P"","
S XMSUB=MESS1_"SD*5.3*920 - Post Install Data Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("DUNNAM.DAVID@DOMAIN.EXT")=""
S XMY("CRUZ.ORLANDO@DOMAIN.EXT")=""
D ^XMD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES920P 3021 printed Jan 29, 2026@15:54:59 Page 2
SDES920P ;ALB/TAW - SD*5.3*920 Post Init Routine ; Oct 3, 2025
+1 ;;5.3;SCHEDULING;**920**;AUG 13, 1993;Build 7
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
EN ;
+1 DO TASK
+2 QUIT
+3 ;
+4 ;
TASK ; tasks off process to update the direct patient schedule field in the hospital location file
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*920 Post-Install to report on appointment on 11/2/2025 or 11/1/2026 via EAS")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*920 Post Install Routine Task 1"
+6 DO NOW^%DTC
+7 SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="VSE10986^SDES920P"
SET ZTSAVE("*")=""
+8 DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+11 DO MES^XPDUTL("")
End DoDot:1
+12 IF '$DATA(ZTSK)
Begin DoDot:1
+13 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+14 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+15 QUIT
+16 ;
VSE10986 ;report of appointments on 11/2/2025 or 11/1/2026 and has EAS number
+1 KILL ^XTMP("SDES920P")
+2 SET ^XTMP("SDES920P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*920"
+3 DO ACTIVAPT
+4 DO MAIL
+5 KILL ^XTMP("SDES920P")
+6 QUIT
+7 ;
ACTIVAPT ;
+1 NEW APPTDT,RECCNT,APPTIEN,WHOMADE,WHOMADENM,CLINIC,CLINICTXT,WHENMADE,WHENMADETXT,APPTDTTX,NODENUM,RESOURCE,STATUS,APPTST
+2 SET RECCNT=0
+3 SET ^XTMP("SDES920P",1)="CLINIC NAME;APPOINTMENT DATE/TIME;APPOINTMENT MADE DATE/TIME;WHO MADE"
+4 SET NODENUM=2
+5 DO APPTLOOP(3251102)
+6 DO APPTLOOP(3261101)
+7 SET NODENUM=NODENUM+1
+8 SET ^XTMP("SDES920P",NODENUM)="TOTAL NUMBER RECORDS IMPACTED: "_RECCNT
+9 QUIT
APPTLOOP(APPTST) ;
+1 NEW ENDDT,EAS
+2 SET ENDDT=APPTST+1
+3 SET APPTDT=APPTST-.0001
+4 FOR
SET APPTDT=$ORDER(^SDEC(409.84,"B",APPTDT))
if ('APPTDT)!(APPTDT>=ENDDT)
QUIT
Begin DoDot:1
+5 SET APPTDTTX=$PIECE($$FMTISO^SDAMUTDT(APPTDT),"-",1,3)
+6 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",APPTDT,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+7 SET EAS=$$GET1^DIQ(409.84,APPTIEN,100)
+8 if $GET(EAS)=""
QUIT
+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 ;I WHENMADE>3260311 Q
+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("SDES920P",NODENUM)=CLINICTXT_";"_APPTDTTX_";"_WHENMADETXT_";"_WHOMADENM
End DoDot:2
End DoDot:1
+23 QUIT
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(""SDES920P"","
+7 SET XMSUB=MESS1_"SD*5.3*920 - Post Install Data Report"
+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.ORLANDO@DOMAIN.EXT")=""
+12 DO ^XMD
+13 QUIT
+14 ;
