SDES843P ;ALB/MGD,LAB - SD*5.3*843 Post Init Routine ; May 10, 2023
;;5.3;SCHEDULING;**843**;AUG 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EN ; Update the VS GUI version in #409.98
D FIND,TASK
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.41
S DA=SDECDA,DIE=409.98,DR="2///1.7.41;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.41;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
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*843 Post-Install to report Recall Appointments ")
D MES^XPDUTL(" cancelled using Block and Move since SD*5.3*842 released")
D MES^XPDUTL(" queued to run in the background. Once it finishes")
D MES^XPDUTL(" a MailMan message will be sent to the installer.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*843 - Post Install Report Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="DATAREPORT^SDES843P",ZTSAVE("*")="" D ^%ZTLOAD
Q
DATAREPORT ;
N PURGEDT,CNT,TEXTCNT,CANCELTM,APPTIEN,CANCREAS,APPTTYP
S PURGEDT=$$FMADD^XLFDT(DT,5)
K ^XTMP("SDES843P")
S ^XTMP("SDES843P",0)=PURGEDT_"^"_DT_"^843 Post Install Recalls Block and moved"
S CNT=0
S TEXTCNT=0
S CANCELTM=3230503
F S CANCELTM=$O(^SDEC(409.84,"AD",CANCELTM)) Q:(CANCELTM="") D
. S APPTIEN=""
. F S APPTIEN=$O(^SDEC(409.84,"AD",CANCELTM,APPTIEN)) Q:(APPTIEN="") D
.. S CANCREAS=$$GET1^DIQ(409.84,APPTIEN_",",.122,"E")
.. Q:CANCREAS'="BLOCK AND MOVE"
.. S APPTTYP=$$GET1^DIQ(409.84,APPTIEN_",",.22,"E")
.. Q:APPTTYP'="RECALL"
.. D GETINFO(APPTIEN,CANCELTM,.APPTDFN,.PATIENTNAME)
S ^XTMP("SDES843P",(TEXTCNT+1))="Total = "_CNT
D MAIL
Q
;
GETINFO(APPTIEN,CANCELTM,APPTDFN,PATIENTNAME) ;
N CREATEDT,APPTDFN,PATIENTNAME,NEWAPPTIEN,CREATEBYUSER,CREATEDBYNAME,NEWAPPTNOTE
N CANBYUSER,APPTNOTE
S CREATEDT=$P(CANCELTM,".")
S APPTDFN=$$GET1^DIQ(409.84,APPTIEN_",",.05,"I")
S PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
S CANBYUSER=$$GET1^DIQ(409.84,APPTIEN_",",.121,"I")
D APPT(APPTIEN,APPTDFN,PATIENTNAME,.CNT,.TEXTCNT)
S NEWAPPTIEN=APPTIEN
F S NEWAPPTIEN=$O(^SDEC(409.84,"CPAT",APPTDFN,NEWAPPTIEN)) Q:NEWAPPTIEN="" D
. Q:(CREATEDT'=$P($$GET1^DIQ(409.84,NEWAPPTIEN_",",.09,"I"),"."))
. S CREATEBYUSER=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"I")
. Q:(CREATEBYUSER'=CANBYUSER)
. S APPTNOTE=$$GET1^DIQ(409.84,APPTIEN_",",1,"E")
. S NEWAPPTNOTE=$$GET1^DIQ(409.84,NEWAPPTIEN_",",1,"E")
. Q:(APPTNOTE'=NEWAPPTNOTE)
. Q:($$GET1^DIQ(409.84,NEWAPPTIEN_",",.22,"E")'="")
. S CREATEDBYNAME=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"E")
. D NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,.TEXTCNT)
Q
APPT(APPTIEN,APPTDFN,PATIENTNAME,CNT,TEXTCNT) ;
S CNT=CNT+1
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" Appointment : "_APPTIEN
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" Appointment Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.01,"E")
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" Cancel Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.12,"E")
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" Patient on appointment : "_APPTDFN_" "_$E(PATIENTNAME,1,1)_$$LAST4SSN^SDESINPUTVALUTL(APPTDFN)
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=""
Q
;
NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,TEXTCNT) ;
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" New Appointment : "_NEWAPPTIEN
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" New Appointment Date/Time : "_$$GET1^DIQ(409.84,NEWAPPTIEN_",",.01,"E")
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=" New Appointment created by : "_CREATEDBYNAME
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES843P",TEXTCNT)=""
Q
;
MAIL ;
; Appointment vs request data report
;
N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
;
; Send MailMan message
S XMDUZ=DUZ
S XMTEXT="^XTMP(""SDES843P"","
S XMSUB=MESS1_"SD*5.3*843 - Post Install Block and Move Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("DILL.MATT@DOMAIN.EXT")=""
S XMY("REESE,DARRYL M@DOMAIN.EXT")=""
D ^XMD
K TEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES843P 4852 printed Sep 23, 2025@20:31:46 Page 2
SDES843P ;ALB/MGD,LAB - SD*5.3*843 Post Init Routine ; May 10, 2023
+1 ;;5.3;SCHEDULING;**843**;AUG 13, 1993;Build 9
+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 TASK
+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.41
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.41;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.41;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
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*843 Post-Install to report Recall Appointments ")
+3 DO MES^XPDUTL(" cancelled using Block and Move since SD*5.3*842 released")
+4 DO MES^XPDUTL(" queued to run in the background. Once it finishes")
+5 DO MES^XPDUTL(" a MailMan message will be sent to the installer.")
+6 DO MES^XPDUTL("")
+7 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+8 SET ZTDESC="SD*5.3*843 - Post Install Report Routine"
+9 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="DATAREPORT^SDES843P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+10 QUIT
DATAREPORT ;
+1 NEW PURGEDT,CNT,TEXTCNT,CANCELTM,APPTIEN,CANCREAS,APPTTYP
+2 SET PURGEDT=$$FMADD^XLFDT(DT,5)
+3 KILL ^XTMP("SDES843P")
+4 SET ^XTMP("SDES843P",0)=PURGEDT_"^"_DT_"^843 Post Install Recalls Block and moved"
+5 SET CNT=0
+6 SET TEXTCNT=0
+7 SET CANCELTM=3230503
+8 FOR
SET CANCELTM=$ORDER(^SDEC(409.84,"AD",CANCELTM))
if (CANCELTM="")
QUIT
Begin DoDot:1
+9 SET APPTIEN=""
+10 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"AD",CANCELTM,APPTIEN))
if (APPTIEN="")
QUIT
Begin DoDot:2
+11 SET CANCREAS=$$GET1^DIQ(409.84,APPTIEN_",",.122,"E")
+12 if CANCREAS'="BLOCK AND MOVE"
QUIT
+13 SET APPTTYP=$$GET1^DIQ(409.84,APPTIEN_",",.22,"E")
+14 if APPTTYP'="RECALL"
QUIT
+15 DO GETINFO(APPTIEN,CANCELTM,.APPTDFN,.PATIENTNAME)
End DoDot:2
End DoDot:1
+16 SET ^XTMP("SDES843P",(TEXTCNT+1))="Total = "_CNT
+17 DO MAIL
+18 QUIT
+19 ;
GETINFO(APPTIEN,CANCELTM,APPTDFN,PATIENTNAME) ;
+1 NEW CREATEDT,APPTDFN,PATIENTNAME,NEWAPPTIEN,CREATEBYUSER,CREATEDBYNAME,NEWAPPTNOTE
+2 NEW CANBYUSER,APPTNOTE
+3 SET CREATEDT=$PIECE(CANCELTM,".")
+4 SET APPTDFN=$$GET1^DIQ(409.84,APPTIEN_",",.05,"I")
+5 SET PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
+6 SET CANBYUSER=$$GET1^DIQ(409.84,APPTIEN_",",.121,"I")
+7 DO APPT(APPTIEN,APPTDFN,PATIENTNAME,.CNT,.TEXTCNT)
+8 SET NEWAPPTIEN=APPTIEN
+9 FOR
SET NEWAPPTIEN=$ORDER(^SDEC(409.84,"CPAT",APPTDFN,NEWAPPTIEN))
if NEWAPPTIEN=""
QUIT
Begin DoDot:1
+10 if (CREATEDT'=$PIECE($$GET1^DIQ(409.84,NEWAPPTIEN_",",.09,"I"),"."))
QUIT
+11 SET CREATEBYUSER=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"I")
+12 if (CREATEBYUSER'=CANBYUSER)
QUIT
+13 SET APPTNOTE=$$GET1^DIQ(409.84,APPTIEN_",",1,"E")
+14 SET NEWAPPTNOTE=$$GET1^DIQ(409.84,NEWAPPTIEN_",",1,"E")
+15 if (APPTNOTE'=NEWAPPTNOTE)
QUIT
+16 if ($$GET1^DIQ(409.84,NEWAPPTIEN_",",.22,"E")'="")
QUIT
+17 SET CREATEDBYNAME=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"E")
+18 DO NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,.TEXTCNT)
End DoDot:1
+19 QUIT
APPT(APPTIEN,APPTDFN,PATIENTNAME,CNT,TEXTCNT) ;
+1 SET CNT=CNT+1
+2 SET TEXTCNT=TEXTCNT+1
+3 SET ^XTMP("SDES843P",TEXTCNT)=" Appointment : "_APPTIEN
+4 SET TEXTCNT=TEXTCNT+1
+5 SET ^XTMP("SDES843P",TEXTCNT)=" Appointment Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.01,"E")
+6 SET TEXTCNT=TEXTCNT+1
+7 SET ^XTMP("SDES843P",TEXTCNT)=" Cancel Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.12,"E")
+8 SET TEXTCNT=TEXTCNT+1
+9 SET ^XTMP("SDES843P",TEXTCNT)=" Patient on appointment : "_APPTDFN_" "_$EXTRACT(PATIENTNAME,1,1)_$$LAST4SSN^SDESINPUTVALUTL(APPTDFN)
+10 SET TEXTCNT=TEXTCNT+1
+11 SET ^XTMP("SDES843P",TEXTCNT)=""
+12 QUIT
+13 ;
NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,TEXTCNT) ;
+1 SET TEXTCNT=TEXTCNT+1
+2 SET ^XTMP("SDES843P",TEXTCNT)=" New Appointment : "_NEWAPPTIEN
+3 SET TEXTCNT=TEXTCNT+1
+4 SET ^XTMP("SDES843P",TEXTCNT)=" New Appointment Date/Time : "_$$GET1^DIQ(409.84,NEWAPPTIEN_",",.01,"E")
+5 SET TEXTCNT=TEXTCNT+1
+6 SET ^XTMP("SDES843P",TEXTCNT)=" New Appointment created by : "_CREATEDBYNAME
+7 SET TEXTCNT=TEXTCNT+1
+8 SET ^XTMP("SDES843P",TEXTCNT)=""
+9 QUIT
+10 ;
MAIL ;
+1 ; Appointment vs request data report
+2 ;
+3 NEW STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
+4 SET STANUM=$$KSP^XUPARAM("INST")_","
+5 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+6 SET MESS1="Station: "_STANUM_" - "
+7 ;
+8 ; Send MailMan message
+9 SET XMDUZ=DUZ
+10 SET XMTEXT="^XTMP(""SDES843P"","
+11 SET XMSUB=MESS1_"SD*5.3*843 - Post Install Block and Move Report"
+12 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+13 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+14 SET XMY("DILL.MATT@DOMAIN.EXT")=""
+15 SET XMY("REESE,DARRYL M@DOMAIN.EXT")=""
+16 DO ^XMD
+17 KILL TEXT
+18 QUIT
