- SDES846PENC ;ALB/BWF - SD*5.3*846 Post Init Routine ; June 15, 2023
- ;;5.3;SCHEDULING;**846**;AUG 13, 1993;Build 12
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- Q
- ;
- TASK ;
- D MES^XPDUTL("")
- D MES^XPDUTL(" SD*5.3*846 Post-Install to remove orphaned encounters for")
- D MES^XPDUTL(" appointments that were cancelled by VAOS.")
- D MES^XPDUTL("")
- N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
- S ZTDESC="SD*5.3*846 Post Install Routine - Encounter Cleanup"
- D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="FIXENC^SDES846PENC",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
- ;
- FIXENC ;
- N DFN,APPTDTTM,ENCOUNTER,CLINIC,IEN44,ENCFOUND,TOTCNT,CANRES,ENCLINKED,APPTIEN,RESOURCE,ENCLINKED
- N CANREASON,APPTCLIN,ENCCLIN,TOTAPPTS,SDESOITEASTOT,CANBY,CANDTTM,ORPHANENC,APPTENC,APPTCAN
- K ^XTMP("SDES846PENC")
- S ^XTMP("SDES846PENC",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*846 Post Install Orphaned Encounter Data report"
- S (TOTCNT,TOTAPPTS,SDESOITEASTOT)=0
- S TOTCNT=TOTCNT+1 S ^XTMP("SDES846PENC",TOTCNT)="APPT DATE/TIME^APPT IEN^PATIENT IEN^ENCOUNTER IEN^CANCELLED BY^UPDATE STATUS"
- S CANDTTM=3230509.99
- F S CANDTTM=$O(^SDEC(409.84,"AD",CANDTTM)) Q:'CANDTTM D
- .S APPTIEN=0 F S APPTIEN=$O(^SDEC(409.84,"AD",CANDTTM,APPTIEN)) Q:'APPTIEN D
- ..S APPTDTTM=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
- ..S DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
- ..S CANBY=$$GET1^DIQ(409.84,APPTIEN,.121,"E")
- ..; only process encounters for appointments that have been CANCELLED by SDESOITEAS,SRV
- ..Q:CANBY'="SDESOITEAS,SRV"
- ..S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I") Q:'RESOURCE
- ..S CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I") Q:'CLINIC
- ..S TOTAPPTS=TOTAPPTS+1
- ..S (ENCLINKED,ENCFOUND)=0
- ..S ENCOUNTER=0 F S ENCOUNTER=$O(^SCE("C",DFN,ENCOUNTER)) Q:'ENCOUNTER!(ENCFOUND) D
- ...; must match date/time
- ...I $$GET1^DIQ(409.68,ENCOUNTER,.01,"I")'=APPTDTTM Q
- ...; encounter clinic must match the appointment clinic
- ...S ENCCLIN=$$GET1^DIQ(409.68,ENCOUNTER,.04,"I")
- ...I CLINIC'=ENCCLIN Q
- ...S APPTENC=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",21,"I")
- ...S APPTCAN=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",15,"I")
- ...; if the encounter is still on the appointment and this is not the correct encounter, quit
- ...I APPTENC'="",APPTENC'=ENCOUNTER Q
- ...; if the patient appointment is linked to the encounter and the appointment is not cancelled, quit
- ...I APPTENC'="",APPTENC=ENCOUNTER,APPTCAN="" Q
- ...; if there is an encounter on the appointment, it is not this encounter and the appointment is cancelled, set ENCLINKED/ENCFOUND and quit
- ...I APPTENC'="",APPTENC=ENCOUNTER,APPTCAN'="" S ENCFOUND=ENCOUNTER,ENCLINKED=1 Q
- ...; this means if the appointment is linked to the encounter and the appointment IS cancelled, we want to close this encounter
- ...S ENCFOUND=ENCOUNTER
- ..; if there is no encounter found for this cancelled or no-show appointment, quit
- ..Q:'ENCFOUND
- ..S TOTCNT=TOTCNT+1
- ..; get the appointment from file 44, if it cannot be found log it.
- ..S IEN44=$$SCIEN(DFN,CLINIC,APPTDTTM)
- ..I 'IEN44 D Q
- ...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)."
- ...M ^XTMP("SDES846PENC",TOTCNT)=^SCE(ENCFOUND)
- ..; if checked-in?? - do we cancel the checkin and proceed to clean up, or report that this entry needs to be handled manually?
- ..I $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44) D
- ...D CANCHECKIN^SDESCANCHECKIN(.CANRES,APPTIEN)
- ..; check again before updating the record - if we could not cancel the check-in log it and quit
- ..I $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44) D Q
- ...S ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_"0;Could not cancel Check-in. Encounter not updated."
- ..I ENCLINKED S FDA(2.98,APPTDTTM_","_DFN_",",21)="@" D FILE^DIE(,"FDA") K FDA
- ..S ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_1
- ..S SDESOITEASTOT=$G(SDESOITEASTOT)+1
- ..D EN^SDCODEL(ENCFOUND,2,"","CANCEL") ;remove OUTPATIENT ENCOUNTER link
- S ORPHANENC=$G(TOTCNT)
- S TOTCNT=TOTCNT+1
- S $P(^XTMP("SDES846PENC",TOTCNT),"-",80)=""
- S TOTCNT=TOTCNT+1
- S ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS: "_ORPHANENC
- S TOTCNT=TOTCNT+1
- S ^XTMP("SDES846PENC",TOTCNT)="TOTAL APPOINTMENTS SEARCHED: "_TOTAPPTS
- S TOTCNT=TOTCNT+1
- S ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS REMOVED: "_SDESOITEASTOT
- D MAIL
- Q
- SCIEN(PAT,CLINIC,DATE) ;returns ien for appt in ^SC
- N X,IEN
- S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
- .; only look at cancelled appts
- .Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)'="C"
- .I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
- Q $G(IEN)
- 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(""SDES846PENC"","
- S XMSUB=MESS1_"SD*5.3*846 post install - Orphaned Encounter Clean-up 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES846PENC 5465 printed Feb 19, 2025@00:21:38 Page 2
- SDES846PENC ;ALB/BWF - SD*5.3*846 Post Init Routine ; June 15, 2023
- +1 ;;5.3;SCHEDULING;**846**;AUG 13, 1993;Build 12
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- TASK ;
- +1 DO MES^XPDUTL("")
- +2 DO MES^XPDUTL(" SD*5.3*846 Post-Install to remove orphaned encounters for")
- +3 DO MES^XPDUTL(" appointments that were cancelled by VAOS.")
- +4 DO MES^XPDUTL("")
- +5 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
- +6 SET ZTDESC="SD*5.3*846 Post Install Routine - Encounter Cleanup"
- +7 DO NOW^%DTC
- SET ZTDTH=X
- SET ZTIO=""
- SET ZTRTN="FIXENC^SDES846PENC"
- SET ZTSAVE("*")=""
- DO ^%ZTLOAD
- +8 IF $DATA(ZTSK)
- Begin DoDot:1
- +9 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
- +10 DO MES^XPDUTL("")
- End DoDot:1
- +11 IF '$DATA(ZTSK)
- Begin DoDot:1
- +12 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
- +13 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
- End DoDot:1
- +14 QUIT
- +15 ;
- FIXENC ;
- +1 NEW DFN,APPTDTTM,ENCOUNTER,CLINIC,IEN44,ENCFOUND,TOTCNT,CANRES,ENCLINKED,APPTIEN,RESOURCE,ENCLINKED
- +2 NEW CANREASON,APPTCLIN,ENCCLIN,TOTAPPTS,SDESOITEASTOT,CANBY,CANDTTM,ORPHANENC,APPTENC,APPTCAN
- +3 KILL ^XTMP("SDES846PENC")
- +4 SET ^XTMP("SDES846PENC",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^SD*5.3*846 Post Install Orphaned Encounter Data report"
- +5 SET (TOTCNT,TOTAPPTS,SDESOITEASTOT)=0
- +6 SET TOTCNT=TOTCNT+1
- SET ^XTMP("SDES846PENC",TOTCNT)="APPT DATE/TIME^APPT IEN^PATIENT IEN^ENCOUNTER IEN^CANCELLED BY^UPDATE STATUS"
- +7 SET CANDTTM=3230509.99
- +8 FOR
- SET CANDTTM=$ORDER(^SDEC(409.84,"AD",CANDTTM))
- if 'CANDTTM
- QUIT
- Begin DoDot:1
- +9 SET APPTIEN=0
- FOR
- SET APPTIEN=$ORDER(^SDEC(409.84,"AD",CANDTTM,APPTIEN))
- if 'APPTIEN
- QUIT
- Begin DoDot:2
- +10 SET APPTDTTM=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
- +11 SET DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
- +12 SET CANBY=$$GET1^DIQ(409.84,APPTIEN,.121,"E")
- +13 ; only process encounters for appointments that have been CANCELLED by SDESOITEAS,SRV
- +14 if CANBY'="SDESOITEAS,SRV"
- QUIT
- +15 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
- if 'RESOURCE
- QUIT
- +16 SET CLINIC=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
- if 'CLINIC
- QUIT
- +17 SET TOTAPPTS=TOTAPPTS+1
- +18 SET (ENCLINKED,ENCFOUND)=0
- +19 SET ENCOUNTER=0
- FOR
- SET ENCOUNTER=$ORDER(^SCE("C",DFN,ENCOUNTER))
- if 'ENCOUNTER!(ENCFOUND)
- QUIT
- Begin DoDot:3
- +20 ; must match date/time
- +21 IF $$GET1^DIQ(409.68,ENCOUNTER,.01,"I")'=APPTDTTM
- QUIT
- +22 ; encounter clinic must match the appointment clinic
- +23 SET ENCCLIN=$$GET1^DIQ(409.68,ENCOUNTER,.04,"I")
- +24 IF CLINIC'=ENCCLIN
- QUIT
- +25 SET APPTENC=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",21,"I")
- +26 SET APPTCAN=$$GET1^DIQ(2.98,APPTDTTM_","_DFN_",",15,"I")
- +27 ; if the encounter is still on the appointment and this is not the correct encounter, quit
- +28 IF APPTENC'=""
- IF APPTENC'=ENCOUNTER
- QUIT
- +29 ; if the patient appointment is linked to the encounter and the appointment is not cancelled, quit
- +30 IF APPTENC'=""
- IF APPTENC=ENCOUNTER
- IF APPTCAN=""
- QUIT
- +31 ; if there is an encounter on the appointment, it is not this encounter and the appointment is cancelled, set ENCLINKED/ENCFOUND and quit
- +32 IF APPTENC'=""
- IF APPTENC=ENCOUNTER
- IF APPTCAN'=""
- SET ENCFOUND=ENCOUNTER
- SET ENCLINKED=1
- QUIT
- +33 ; this means if the appointment is linked to the encounter and the appointment IS cancelled, we want to close this encounter
- +34 SET ENCFOUND=ENCOUNTER
- End DoDot:3
- +35 ; if there is no encounter found for this cancelled or no-show appointment, quit
- +36 if 'ENCFOUND
- QUIT
- +37 SET TOTCNT=TOTCNT+1
- +38 ; get the appointment from file 44, if it cannot be found log it.
- +39 SET IEN44=$$SCIEN(DFN,CLINIC,APPTDTTM)
- +40 IF 'IEN44
- Begin DoDot:3
- +41 SET ^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)."
- +42 MERGE ^XTMP("SDES846PENC",TOTCNT)=^SCE(ENCFOUND)
- End DoDot:3
- QUIT
- +43 ; if checked-in?? - do we cancel the checkin and proceed to clean up, or report that this entry needs to be handled manually?
- +44 IF $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44)
- Begin DoDot:3
- +45 DO CANCHECKIN^SDESCANCHECKIN(.CANRES,APPTIEN)
- End DoDot:3
- +46 ; check again before updating the record - if we could not cancel the check-in log it and quit
- +47 IF $$CI^SDECU2(DFN,CLINIC,APPTDTTM,IEN44)
- Begin DoDot:3
- +48 SET ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_"0;Could not cancel Check-in. Encounter not updated."
- End DoDot:3
- QUIT
- +49 IF ENCLINKED
- SET FDA(2.98,APPTDTTM_","_DFN_",",21)="@"
- DO FILE^DIE(,"FDA")
- KILL FDA
- +50 SET ^XTMP("SDES846PENC",TOTCNT)=APPTDTTM_U_APPTIEN_U_DFN_U_ENCFOUND_U_CANBY_U_1
- +51 SET SDESOITEASTOT=$GET(SDESOITEASTOT)+1
- +52 ;remove OUTPATIENT ENCOUNTER link
- DO EN^SDCODEL(ENCFOUND,2,"","CANCEL")
- End DoDot:2
- End DoDot:1
- +53 SET ORPHANENC=$GET(TOTCNT)
- +54 SET TOTCNT=TOTCNT+1
- +55 SET $PIECE(^XTMP("SDES846PENC",TOTCNT),"-",80)=""
- +56 SET TOTCNT=TOTCNT+1
- +57 SET ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS: "_ORPHANENC
- +58 SET TOTCNT=TOTCNT+1
- +59 SET ^XTMP("SDES846PENC",TOTCNT)="TOTAL APPOINTMENTS SEARCHED: "_TOTAPPTS
- +60 SET TOTCNT=TOTCNT+1
- +61 SET ^XTMP("SDES846PENC",TOTCNT)="TOTAL ORPHANED ENCOUNTERS REMOVED: "_SDESOITEASTOT
- +62 DO MAIL
- +63 QUIT
- SCIEN(PAT,CLINIC,DATE) ;returns ien for appt in ^SC
- +1 NEW X,IEN
- +2 SET X=0
- FOR
- SET X=$ORDER(^SC(CLINIC,"S",DATE,1,X))
- if 'X
- QUIT
- if $GET(IEN)
- QUIT
- Begin DoDot:1
- +3 ; only look at cancelled appts
- +4 if $PIECE($GET(^SC(CLINIC,"S",DATE,1,X,0)),U,9)'="C"
- QUIT
- +5 IF +$GET(^SC(CLINIC,"S",DATE,1,X,0))=PAT
- SET IEN=X
- End DoDot:1
- +6 QUIT $GET(IEN)
- MAIL ;
- +1 ; Get Station Number
- +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(""SDES846PENC"","
- +11 SET XMSUB=MESS1_"SD*5.3*846 post install - Orphaned Encounter Clean-up Report"
- +12 SET XMDUZ=.5
- SET XMY(DUZ)=""
- SET XMY(XMDUZ)=""
- +13 SET XMY("DUNNAM.DAVID W@DOMAIN.EXT")=""
- +14 SET XMY("REESE,DARRYL M@DOMAIN.EXT")=""
- +15 SET XMY("FISHER.BRADLEY@DOMAIN.EXT")=""
- +16 DO ^XMD
- +17 QUIT