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