Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDES843P

SDES843P.m

Go to the documentation of this file. 
  1. SDES843P ;ALB/MGD,LAB - SD*5.3*843 Post Init Routine ; May 10, 2023
  1.  ;;5.3;SCHEDULING;**843**;AUG 13, 1993;Build 9
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. EN ; Update the VS GUI version in #409.98
  1.  D FIND,TASK
  1.  Q
  1.  ;
  1. FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
  1.  N SDECDA,SDECDA1
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   Updating SDEC SETTINGS file (#409.98)")
  1.  S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
  1.  D VERSION   ;update GUI version number and date
  1.  Q
  1. VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.41
  1.  S DA=SDECDA,DIE=409.98,DR="2///1.7.41;3///"_DT D ^DIE  ;update VS GUI NATIONAL
  1.  K DIE,DR,DA
  1.  S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)=""    ;get DA for the VS GUI LOCAL
  1.  S DA=SDECDA1,DIE=409.98,DR="2///1.7.41;3///"_DT D ^DIE  ;update VS GUI LOCAL
  1.  K DIE,DR,DA
  1.  Q
  1.  ;
  1. NOFIND ;"VS GUI NATIONAL" NOT FOUND
  1.  D MES^XPDUTL("   VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
  1.  Q
  1. TASK ;
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*843 Post-Install to report Recall Appointments ")
  1.  D MES^XPDUTL("   cancelled using Block and Move since SD*5.3*842 released")
  1.  D MES^XPDUTL("   queued to run in the background. Once it finishes")
  1.  D MES^XPDUTL("   a MailMan message will be sent to the installer.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*843 -  Post Install Report Routine"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="DATAREPORT^SDES843P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  Q
  1. DATAREPORT ;
  1.  N PURGEDT,CNT,TEXTCNT,CANCELTM,APPTIEN,CANCREAS,APPTTYP
  1.  S PURGEDT=$$FMADD^XLFDT(DT,5)
  1.  K ^XTMP("SDES843P")
  1.  S ^XTMP("SDES843P",0)=PURGEDT_"^"_DT_"^843 Post Install Recalls Block and moved"
  1.  S CNT=0
  1.  S TEXTCNT=0
  1.  S CANCELTM=3230503
  1.  F  S CANCELTM=$O(^SDEC(409.84,"AD",CANCELTM)) Q:(CANCELTM="")  D
  1.  . S APPTIEN=""
  1.  . F  S APPTIEN=$O(^SDEC(409.84,"AD",CANCELTM,APPTIEN)) Q:(APPTIEN="")  D
  1.  .. S CANCREAS=$$GET1^DIQ(409.84,APPTIEN_",",.122,"E")
  1.  .. Q:CANCREAS'="BLOCK AND MOVE"
  1.  .. S APPTTYP=$$GET1^DIQ(409.84,APPTIEN_",",.22,"E")
  1.  .. Q:APPTTYP'="RECALL"
  1.  .. D GETINFO(APPTIEN,CANCELTM,.APPTDFN,.PATIENTNAME)
  1.  S ^XTMP("SDES843P",(TEXTCNT+1))="Total = "_CNT
  1.  D MAIL
  1.  Q
  1.  ;
  1. GETINFO(APPTIEN,CANCELTM,APPTDFN,PATIENTNAME) ;
  1.  N CREATEDT,APPTDFN,PATIENTNAME,NEWAPPTIEN,CREATEBYUSER,CREATEDBYNAME,NEWAPPTNOTE
  1.  N CANBYUSER,APPTNOTE
  1.  S CREATEDT=$P(CANCELTM,".")
  1.  S APPTDFN=$$GET1^DIQ(409.84,APPTIEN_",",.05,"I")
  1.  S PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
  1.  S CANBYUSER=$$GET1^DIQ(409.84,APPTIEN_",",.121,"I")
  1.  D APPT(APPTIEN,APPTDFN,PATIENTNAME,.CNT,.TEXTCNT)
  1.  S NEWAPPTIEN=APPTIEN
  1.  F  S NEWAPPTIEN=$O(^SDEC(409.84,"CPAT",APPTDFN,NEWAPPTIEN)) Q:NEWAPPTIEN=""  D
  1.  . Q:(CREATEDT'=$P($$GET1^DIQ(409.84,NEWAPPTIEN_",",.09,"I"),"."))
  1.  . S CREATEBYUSER=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"I")
  1.  . Q:(CREATEBYUSER'=CANBYUSER)
  1.  . S APPTNOTE=$$GET1^DIQ(409.84,APPTIEN_",",1,"E")
  1.  . S NEWAPPTNOTE=$$GET1^DIQ(409.84,NEWAPPTIEN_",",1,"E")
  1.  . Q:(APPTNOTE'=NEWAPPTNOTE)
  1.  . Q:($$GET1^DIQ(409.84,NEWAPPTIEN_",",.22,"E")'="")
  1.  . S CREATEDBYNAME=$$GET1^DIQ(409.84,NEWAPPTIEN_",",.08,"E")
  1.  . D NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,.TEXTCNT)
  1.  Q
  1. APPT(APPTIEN,APPTDFN,PATIENTNAME,CNT,TEXTCNT) ;
  1.  S CNT=CNT+1
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=" Appointment                   : "_APPTIEN
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=" Appointment Date/Time         : "_$$GET1^DIQ(409.84,APPTIEN_",",.01,"E")
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=" Cancel Date/Time              : "_$$GET1^DIQ(409.84,APPTIEN_",",.12,"E")
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=" Patient on appointment        : "_APPTDFN_"  "_$E(PATIENTNAME,1,1)_$$LAST4SSN^SDESINPUTVALUTL(APPTDFN)
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=""
  1.  Q
  1.  ;
  1. NEWAPPT(NEWAPPTIEN,CREATEDBYNAME,TEXTCNT) ;
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)="   New Appointment               : "_NEWAPPTIEN
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)="   New Appointment Date/Time     : "_$$GET1^DIQ(409.84,NEWAPPTIEN_",",.01,"E")
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)="   New Appointment created by    : "_CREATEDBYNAME
  1.  S TEXTCNT=TEXTCNT+1
  1.  S ^XTMP("SDES843P",TEXTCNT)=""
  1.  Q
  1.  ;
  1. MAIL ;
  1.  ; Appointment vs request data report
  1.  ;
  1.  N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
  1.  S STANUM=$$KSP^XUPARAM("INST")_","
  1.  S STANUM=$$GET1^DIQ(4,STANUM,99)
  1.  S MESS1="Station: "_STANUM_" - "
  1.  ;
  1.  ; Send MailMan message
  1.  S XMDUZ=DUZ
  1.  S XMTEXT="^XTMP(""SDES843P"","
  1.  S XMSUB=MESS1_"SD*5.3*843 - Post Install Block and Move Report"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
  1.  S XMY("BARBER.LORI@DOMAIN.EXT")=""
  1.  S XMY("DILL.MATT@DOMAIN.EXT")=""
  1.  S XMY("REESE,DARRYL M@DOMAIN.EXT")=""
  1.  D ^XMD
  1.  K TEXT
  1.  Q