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

SDES846PENC.m

Go to the documentation of this file.
  1. SDES846PENC ;ALB/BWF - SD*5.3*846 Post Init Routine ; June 15, 2023
  1. ;;5.3;SCHEDULING;**846**;AUG 13, 1993;Build 12
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. ;
  1. TASK ;
  1. D MES^XPDUTL("")
  1. D MES^XPDUTL(" SD*5.3*846 Post-Install to remove orphaned encounters for")
  1. D MES^XPDUTL(" appointments that were cancelled by VAOS.")
  1. D MES^XPDUTL("")
  1. N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
  1. S ZTDESC="SD*5.3*846 Post Install Routine - Encounter Cleanup"
  1. D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="FIXENC^SDES846PENC",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. ;
  1. FIXENC ;
  1. N DFN,APPTDTTM,ENCOUNTER,CLINIC,IEN44,ENCFOUND,TOTCNT,CANRES,ENCLINKED,APPTIEN,RESOURCE,ENCLINKED
  1. N CANREASON,APPTCLIN,ENCCLIN,TOTAPPTS,SDESOITEASTOT,CANBY,CANDTTM,ORPHANENC,APPTENC,APPTCAN
  1. K ^XTMP("SDES846PENC")
  1. S ^XTMP("SDES846PENC",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*846 Post Install Orphaned Encounter Data report"
  1. S (TOTCNT,TOTAPPTS,SDESOITEASTOT)=0
  1. S TOTCNT=TOTCNT+1 S ^XTMP("SDES846PENC",TOTCNT)="APPT DATE/TIME^APPT IEN^PATIENT IEN^ENCOUNTER IEN^CANCELLED BY^UPDATE STATUS"
  1. S CANDTTM=3230509.99
  1. F S CANDTTM=$O(^SDEC(409.84,"AD",CANDTTM)) Q:'CANDTTM D
  1. .S APPTIEN=0 F S APPTIEN=$O(^SDEC(409.84,"AD",CANDTTM,APPTIEN)) Q:'APPTIEN D
  1. ..S APPTDTTM=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
  1. ..S DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
  1. ..S CANBY=$$GET1^DIQ(409.84,APPTIEN,.121,"E")
  1. ..; only process encounters for appointments that have been CANCELLED by SDESOITEAS,SRV
  1. ..Q:CANBY'="SDESOITEAS,SRV"
  1. ..S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I") Q:'RESOURCE
  1. ..S CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I") Q:'CLINIC
  1. ..S TOTAPPTS=TOTAPPTS+1
  1. ..S (ENCLINKED,ENCFOUND)=0
  1. ..S ENCOUNTER=0 F S ENCOUNTER=$O(^SCE("C",DFN,ENCOUNTER)) Q:'ENCOUNTER!(ENCFOUND) D
  1. ...; must match date/time
  1. ...I $$GET1^DIQ(409.68,ENCOUNTER,.01,"I")'=APPTDTTM Q
  1. ...; encounter clinic must match the appointment clinic
  1. ...S ENCCLIN=$$GET1^DIQ(409.68,ENCOUNTER,.04,"I")
  1. ...I CLINIC'=ENCCLIN Q
  1. ...S APPTENC=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",21,"I")
  1. ...S APPTCAN=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",15,"I")
  1. ...; if the encounter is still on the appointment and this is not the correct encounter, quit
  1. ...I APPTENC'="",APPTENC'=ENCOUNTER Q
  1. ...; if the patient appointment is linked to the encounter and the appointment is not cancelled, quit
  1. ...I APPTENC'="",APPTENC=ENCOUNTER,APPTCAN="" Q
  1. ...; if there is an encounter on the appointment, it is not this encounter and the appointment is cancelled, set ENCLINKED/ENCFOUND and quit
  1. ...I APPTENC'="",APPTENC=ENCOUNTER,APPTCAN'="" S ENCFOUND=ENCOUNTER,ENCLINKED=1 Q
  1. ...; this means if the appointment is linked to the encounter and the appointment IS cancelled, we want to close this encounter
  1. ...S ENCFOUND=ENCOUNTER
  1. ..; if there is no encounter found for this cancelled or no-show appointment, quit
  1. ..Q:'ENCFOUND
  1. ..S TOTCNT=TOTCNT+1
  1. ..; get the appointment from file 44, if it cannot be found log it.
  1. ..S IEN44=$$SCIEN(DFN,CLINIC,APPTDTTM)
  1. ..I 'IEN44 D Q
  1. ...S ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_"0;Could not locate clinic appointment in the HOSPITAL LOCATION file (#44)."
  1. ...M ^XTMP("SDES846PENC",TOTCNT)=^SCE(ENCFOUND)
  1. ..; if checked-in?? - do we cancel the checkin and proceed to clean up, or report that this entry needs to be handled manually?
  1. ..I $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44) D
  1. ...D CANCHECKIN^SDESCANCHECKIN(.CANRES,APPTIEN)
  1. ..; check again before updating the record - if we could not cancel the check-in log it and quit
  1. ..I $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44) D Q
  1. ...S ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_"0;Could not cancel Check-in. Encounter not updated."
  1. ..I ENCLINKED S FDA(2.98,APPTDTTM_","_DFN_",",21)="@" D FILE^DIE(,"FDA") K FDA
  1. ..S ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_1
  1. ..S SDESOITEASTOT=$G(SDESOITEASTOT)+1
  1. ..D EN^SDCODEL(ENCFOUND,2,"","CANCEL") ;remove OUTPATIENT ENCOUNTER link
  1. S ORPHANENC=$G(TOTCNT)
  1. S TOTCNT=TOTCNT+1
  1. S $P(^XTMP("SDES846PENC",TOTCNT),"-",80)=""
  1. S TOTCNT=TOTCNT+1
  1. S ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS: "_ORPHANENC
  1. S TOTCNT=TOTCNT+1
  1. S ^XTMP("SDES846PENC",TOTCNT)="TOTAL APPOINTMENTS SEARCHED: "_TOTAPPTS
  1. S TOTCNT=TOTCNT+1
  1. S ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS REMOVED: "_SDESOITEASTOT
  1. D MAIL
  1. Q
  1. SCIEN(PAT,CLINIC,DATE) ;returns ien for appt in ^SC
  1. N X,IEN
  1. S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
  1. .; only look at cancelled appts
  1. .Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)'="C"
  1. .I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
  1. Q $G(IEN)
  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(""SDES846PENC"","
  1. S XMSUB=MESS1_"SD*5.3*846 post install - Orphaned Encounter Clean-up 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