SDES925P ;ALB/LAB - SD*5.3*925 Post Init Routine ; Aug 12, 2025
;;5.3;SCHEDULING;**925**;AUG 13, 1993;Build 1
;;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*925 Post-Install to remove erroneous patient comments from appointment")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*925 Post Install Routine Task 1"
D NOW^%DTC
S ZTDTH=X,ZTIO="",ZTRTN="PATCOM^SDES925P",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
PATCOM ;
N APPTIEN,CREATEDT,UPDATECNT,FDA
K ^XTMP("SDES925P")
S ^XTMP("SDES925P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*925"
K FDA
S UPDATECNT=1
S ^XTMP("SDES925P",UPDATECNT)="Appointment IEN with patient comments removed"
S UPDATECNT=UPDATECNT+1
S CREATEDT=3240205 ;compliance date of patch sd*5.3*866
F S CREATEDT=$O(^SDEC(409.84,"AC",CREATEDT)) Q:CREATEDT="" D
. S APPTIEN=""
. F S APPTIEN=$O(^SDEC(409.84,"AC",CREATEDT,APPTIEN)) Q:APPTIEN="" D
. . I $$GET1^DIQ(409.84,APPTIEN,.22,"E")'="APPT" D
. . . I $D(^SDEC(409.84,APPTIEN,6)) D
. . . . S ^XTMP("SDES925P",UPDATECNT)=APPTIEN
. . . . S UPDATECNT=UPDATECNT+1
. . . . S FDA(409.84,APPTIEN_",",4)="@"
. . . . D FILE^DIE(,"FDA") K FDA
S ^XTMP("SDES925P",UPDATECNT)="Total count = "_(UPDATECNT-2)
D MAIL
K ^XTMP("SDES925P")
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(""SDES925P"","
S XMSUB=MESS1_"SD*5.3*925 - 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[HSDES925P 2178 printed Sep 23, 2025@20:32:22 Page 2
SDES925P ;ALB/LAB - SD*5.3*925 Post Init Routine ; Aug 12, 2025
+1 ;;5.3;SCHEDULING;**925**;AUG 13, 1993;Build 1
+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*925 Post-Install to remove erroneous patient comments from appointment")
+3 DO MES^XPDUTL("")
+4 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+5 SET ZTDESC="SD*5.3*925 Post Install Routine Task 1"
+6 DO NOW^%DTC
+7 SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="PATCOM^SDES925P"
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
PATCOM ;
+1 NEW APPTIEN,CREATEDT,UPDATECNT,FDA
+2 KILL ^XTMP("SDES925P")
+3 SET ^XTMP("SDES925P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*925"
+4 KILL FDA
+5 SET UPDATECNT=1
+6 SET ^XTMP("SDES925P",UPDATECNT)="Appointment IEN with patient comments removed"
+7 SET UPDATECNT=UPDATECNT+1
+8 ;compliance date of patch sd*5.3*866
SET CREATEDT=3240205
+9 FOR
SET CREATEDT=$ORDER(^SDEC(409.84,"AC",CREATEDT))
if CREATEDT=""
QUIT
Begin DoDot:1
+10 SET APPTIEN=""
+11 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"AC",CREATEDT,APPTIEN))
if APPTIEN=""
QUIT
Begin DoDot:2
+12 IF $$GET1^DIQ(409.84,APPTIEN,.22,"E")'="APPT"
Begin DoDot:3
+13 IF $DATA(^SDEC(409.84,APPTIEN,6))
Begin DoDot:4
+14 SET ^XTMP("SDES925P",UPDATECNT)=APPTIEN
+15 SET UPDATECNT=UPDATECNT+1
+16 SET FDA(409.84,APPTIEN_",",4)="@"
+17 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 SET ^XTMP("SDES925P",UPDATECNT)="Total count = "_(UPDATECNT-2)
+19 DO MAIL
+20 KILL ^XTMP("SDES925P")
+21 QUIT
+22 ;
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(""SDES925P"","
+7 SET XMSUB=MESS1_"SD*5.3*925 - 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 ;
