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

SDES852P.m

Go to the documentation of this file. 
  1. SDES852P ;ALB/BWF - SD*5.3*852 Post Init Routine ; May 24, 2023
  1.  ;;5.3;SCHEDULING;**852**;AUG 13, 1993;Build 3
  1.  ;;Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1. EN ; Scheduling Consult Clean-up
  1.  D TASK
  1.  Q
  1.  ;
  1. TASK ;
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("   SD*5.3*852 Pre-Install is being queued to run in the background.")
  1.  D MES^XPDUTL("   This PRE-install will report consult requests for appointments that")
  1.  D MES^XPDUTL("   have been cancelled, where the consult request was not properly re-opened")
  1.  D MES^XPDUTL("   due to a <PARAMETER> error during appointment cancellation.")
  1.  D MES^XPDUTL("   This report will be sent to your Mailman Mailbox.")
  1.  D MES^XPDUTL("")
  1.  N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1.  S ZTDESC="SD*5.3*852 Post Install Routine"
  1.  D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="FIXCONSREQS^SDES852P",ZTSAVE("*")="" D ^%ZTLOAD
  1.  I $D(ZTSK) D
  1.  . D MES^XPDUTL("  >>>Task "_ZTSK_" has been queued.")
  1.  . D MES^XPDUTL("")
  1.  I '$D(ZTSK) D
  1.  . D MES^XPDUTL("  UNABLE TO QUEUE THIS JOB.")
  1.  . D MES^XPDUTL("  Please contact the National Help Desk to report this issue.")
  1.  Q
  1. FIXCONSREQS ; fix consult requests that were not correctly re-opened
  1.  N CANDTTM,POINTER,CONSIEN,CPRSSTAT,APPTSTARTTIME,APPTIEN,DFN,REQUESTIEN,PROVIEN,NOTE
  1.  N RESOURCE,CANBYCLINORPAT,CLINICIEN,APPTLENGTH,SDATA,RETURN,BEFOREDATA,CNT,PATNM,SDLINE,TOTCNT
  1.  N RESPAPPTIEN,SCHIEN,ORDERIEN
  1.  S (TOTCNT,CNT)=0
  1.  K ^XTMP("SDES852P")
  1.  S ^XTMP("SDES852P",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*852 Post Install Data report"
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="********************   IMPORTANT   *****************************"
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="PLEASE SEND THIS REPORT TO YOUR LOCAL SCHEDULING STAFF TO"
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="RESOLVE ACTIVE CONSULTS AND CONSULTS IN A SCHEDULED STATUS"
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="WITHOUT A LINKED SCHEDULED APPOINTMENT."
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="****************************************************************"
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)=""
  1.  ;
  1.  S $P(SDLINE,"-",80)=""
  1.  S SCHIEN=$O(^ORD(100.01,"B","SCHEDULED",0)) Q:'SCHIEN
  1.  S ORDERIEN=0 F  S ORDERIEN=$O(^GMR(123,"D",SCHIEN,ORDERIEN)) Q:'ORDERIEN  D
  1.  .S DFN=$$GET1^DIQ(123,ORDERIEN,.02,"I") Q:'DFN
  1.  .S POINTER=ORDERIEN_";GMR(123,"
  1.  .; check if this has been re-scheduled
  1.  .S RESCHED=$$RESCHEDULED(DFN,POINTER)
  1.  .I $P(RESCHED,U)=1 Q
  1.  .; appointment responsible for the incorrect consult status
  1.  .S RESPAPPTIEN=$P(RESCHED,U,2) Q:'RESPAPPTIEN
  1.  .; SETUP REQUIRED VARIABLES
  1.  .S APPTSTARTTIME=$$GET1^DIQ(409.84,RESPAPPTIEN,.01,"I")
  1.  .S NOTE="Re-opened request - SD*5.3*852"
  1.  .S REQUESTIEN=ORDERIEN
  1.  .S CANBYCLINORPAT=$$GET1^DIQ(409.84,RESPAPPTIEN,.17,"I")
  1.  .S RESOURCE=$$GET1^DIQ(409.84,RESPAPPTIEN,.07,"I") Q:'RESOURCE
  1.  .S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I") Q:'CLINICIEN
  1.  .; PROVIEN is not used by the api, just set to null
  1.  .S PROVIEN=""
  1.  .; only fix entries cancelled by SDESOITEAS,SRV
  1.  .I $$GET1^DIQ(409.84,RESPAPPTIEN,.121,"E")="SDESOITEAS,SRV" D
  1.  ..S BEFOREDATA=$$BEFOREEVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),.SDATA)
  1.  ..; re-open the consult request - cancelled appointment
  1.  ..D REQSET^SDESCONSULTUPD(REQUESTIEN,PROVIEN,"",2,CANBYCLINORPAT,NOTE,APPTSTARTTIME,RESOURCE)
  1.  ..; update contact main sequence upon re-open
  1.  ..D UPDCONTSEQ^SDESCONTACTS($G(DFN),$G(REQUESTIEN))
  1.  ..S APPTLENGTH=$$GET1^DIQ(409.84,RESPAPPTIEN,.18,"I")
  1.  ..; update clinic availability
  1.  ..D AVUPDT^SDEC08A(CLINICIEN,APPTSTARTTIME,APPTLENGTH)
  1.  ..D AFTEREVENT($G(DFN),$G(APPTSTARTTIME),$G(CLINICIEN),$G(BEFOREDATA),.SDATA)
  1.  ..; Update AMIE C&P EXAM TRACKING (#396.95) record if this appointment is a Compensation and Pension appointment
  1.  ..I $$GET1^DIQ(409.84,RESPAPPTIEN,.06,"E")="COMPENSATION & PENSION" D AMIECAN^SDESCOMPPEN(.RETURN,DFN,APPTSTARTTIME)
  1.  .S TOTCNT=TOTCNT+1
  1.  .S PATNM=$$GET1^DIQ(2,DFN,.01,"E")
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)=""
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)="Appointment Date/Time : "_$$FMTE^XLFDT(APPTSTARTTIME)
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)="Appointment IEN       : "_RESPAPPTIEN
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)="Consult IEN           : "_ORDERIEN
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)="Consult Status        : "_$$GET1^DIQ(123,ORDERIEN,8,"E")
  1.  .I $$GET1^DIQ(409.84,RESPAPPTIEN,.12,"I") D
  1.  ..S CNT=CNT+1
  1.  ..S ^XTMP("SDES852P",CNT)="Canceled Date/Time    : "_$$GET1^DIQ(409.84,RESPAPPTIEN,.12,"E")
  1.  ..S CNT=CNT+1
  1.  ..S ^XTMP("SDES852P",CNT)="Canceled By           : "_$$GET1^DIQ(409.84,RESPAPPTIEN,.121,"E")
  1.  .I $$GET1^DIQ(409.84,RESPAPPTIEN,.1,"I") D
  1.  ..S CNT=CNT+1
  1.  ..S ^XTMP("SDES852P",CNT)="Noshow Date/Time      : "_$$GET1^DIQ(409.84,RESPAPPTIEN,.101,"E")
  1.  ..S CNT=CNT+1
  1.  ..S ^XTMP("SDES852P",CNT)="Noshow By             : "_$$GET1^DIQ(409.84,RESPAPPTIEN,.102,"E")
  1.  .S CNT=CNT+1
  1.  .S ^XTMP("SDES852P",CNT)=SDLINE
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)=""
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)=SDLINE
  1.  S CNT=CNT+1
  1.  S ^XTMP("SDES852P",CNT)="Total: "_TOTCNT
  1.  D MAIL
  1.  Q
  1. RESCHEDULED(DFN,VARPTR) ;
  1.  N DTLOOP,CHECKAPTIEN,CHKPTR,RESCHED,CANDT,NOSHOWDT,LASTNOSHOWCAN,NOSHOWCANAPTIEN
  1.  K ^TMP("SDES852P",$J)
  1.  S RESCHED=0
  1.  S DTLOOP=0 F  S DTLOOP=$O(^SDEC(409.84,"APTDT",DFN,DTLOOP)) Q:'DTLOOP  D
  1.  .S CHECKAPTIEN=0 F  S CHECKAPTIEN=$O(^SDEC(409.84,"APTDT",DFN,DTLOOP,CHECKAPTIEN)) Q:'CHECKAPTIEN  D
  1.  ..; only records that point to the same consult
  1.  ..S CHKPTR=$$GET1^DIQ(409.84,CHECKAPTIEN,.22,"I")
  1.  ..I CHKPTR'=VARPTR Q
  1.  ..; cancellation date/time
  1.  ..S CANDT=$$GET1^DIQ(409.84,CHECKAPTIEN,.12,"I")
  1.  ..; no-show date/time
  1.  ..S NOSHOWDT=$$GET1^DIQ(409.84,CHECKAPTIEN,.1,"I")
  1.  ..;log cancel and no-show dates with appointmet IEN
  1.  ..I CANDT S ^TMP("SDES852P",$J,CANDT,CHECKAPTIEN)=""
  1.  ..I NOSHOWDT S ^TMP("SDES852P",$J,NOSHOWDT,CHECKAPTIEN)=""
  1.  ..I 'CANDT,'NOSHOWDT S RESCHED=CHECKAPTIEN
  1.  I 'RESCHED D  Q 0_U_$G(NOSHOWCANAPTIEN)
  1.  .S LASTNOSHOWCAN=$O(^TMP("SDES852P",$J,999999999),-1)
  1.  .I $G(LASTNOSHOWCAN) S NOSHOWCANAPTIEN=$O(^TMP("SDES852P",$J,LASTNOSHOWCAN,0))
  1.  K ^TMP("SDES852P",$J)
  1.  Q 1_U_RESCHED
  1.  ;
  1. AFTEREVENT(DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDATA) ;
  1.  N SDCPHDL
  1.  S SDCPHDL=$$HANDLE^SDAMEVT(1)
  1.  S SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
  1.  D CANCEL^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,2,SDCPHDL)
  1.  Q
  1. BEFOREEVENT(DFN,APPTSTARTTIME,CLINICIEN,SDATA) ;
  1.  N SDDA,SDCPHDL
  1.  S SDDA=$$SCIEN^SDECU2(DFN,CLINICIEN,APPTSTARTTIME)
  1.  S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
  1.  D BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,SDDA,SDCPHDL)
  1.  Q $G(SDDA)
  1. MAIL ;
  1.  ; Get Station Number
  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(""SDES852P"","
  1.  S XMSUB=MESS1_"SD*5.3*852 post install - Re-opened Consults Report"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
  1.  S XMY("DUNNAM.DAVID W@DOMAIN.EXT")=""
  1.  S XMY("REESE,DARRYL M@DOMAIN.EXT")=""
  1.  S XMY("FISHER.BRADLEY@DOMAIN.EXT")=""
  1.  D ^XMD
  1.  Q