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

SDESNOSHOW.m

Go to the documentation of this file.
SDESNOSHOW ;ALB/BWF,BLB,ANU - VISTA SCHEDULING RPCS NOSHOW/UNDO NOSHOW ; OCT 25, 2023
 ;;5.3;Scheduling;**831,835,847,853,864**;Aug 13, 1993;Build 15
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 Q
NOSHOW(SDESRES,APPTIEN) ;
 N DFN,APPTDTTM,REQTYPE,PROVIDER,NOTE,RESOURCE,SDECNOEV,SDESENCOUNTER,REQIEN,APPTIENS,NOSHOW
 N SDATA,SDCIHDL,SDDA,CURRENTSTAT,CURNOSHOWDTTM,ERRORS,RESTYPE,CLINICIEN,RESULT,UPDSTAT,FDA
 S SDECNOEV=1 ;Don't execute protocol
 ;
 S APPTIEN=$G(APPTIEN)
 ;validate appointment ID
 D VALAPPTIEN^SDESVALUTIL(.ERRORS,APPTIEN)
 I $D(ERRORS) S ERRORS("NoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 D GETVARS(APPTIEN,.CURRENTSTAT,.CURNOSHOWDTTM,.DFN,.APPTDTTM,.PROVIDER,.REQIEN,.NOSHOW,.REQTYPE,.USERIEN,.RESOURCE)
 S SDESNOSHOWDTTM=$$NOW^XLFDT
 ;
 ; check resource and clinic validity
 I 'RESOURCE D ERRLOG^SDESJSON(.ERRORS,282)
 S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
 I 'CLINICIEN D ERRLOG^SDESJSON(.ERRORS,283)
 ; already in noshow status
 I NOSHOW!(CURRENTSTAT="N"!(CURNOSHOWDTTM]"")) D ERRLOG^SDESJSON(.ERRORS,367)
 I $D(ERRORS) S ERRORS("NoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ; make sure no-show is not occuring before appointment date/time
 I SDESNOSHOWDTTM<APPTDTTM S ERRORS("NoShow",1)="" D ERRLOG^SDESJSON(.ERRORS,369)
 I $D(ERRORS) S ERRORS("NoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 ;  Event driver "BEFORE" actions
 S SDDA=$$FIND^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN)
 D BEFOREEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,.SDCIHDL)
 ;
 ;  Process no show
 ;
 D UPDNOSHOWSTAT(.ERRORS,APPTIEN,USERIEN,SDESNOSHOWDTTM,1)
 ; if an error was returned, build the JSON and quit
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,370)
 .S ERRORS("NoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 D APPTNOSHOW(.ERRORS,CLINICIEN,DFN,APPTDTTM,USERIEN,SDESNOSHOWDTTM,APPTIEN)
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,371)
 .S ERRORS("NoShow",1)=""
 .D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS)
 ;
 ; only update PID if the updates to 409.84 and 2.98 were successful
 ; PID CHANGE ALLOWED Field in 409.85 based on whether no-show or cancel no-show
 S UPDSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
 I REQTYPE="APPT",UPDSTAT="N" D
 .S FDA(409.85,REQIEN_",",19)=""
 .S FDA(409.85,REQIEN_",",20)=""
 .S FDA(409.85,REQIEN_",",21)=""
 .; 864
 .;S FDA(409.85,REQIEN_",",23)="OPEN"
 .S FDA(409.85,REQIEN_",",23)="O"
 .S FDA(409.85,REQIEN_",",49)=1
 .D FILE^DIE("","FDA") K FDA
 ;
 ; fix action required in PCE after no-show from GUI
 ; SDESENCOUNTER - outpatient encounter
 ; Anu
 ;S SDESENCOUNTER=$$GETAPT^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN)
 S SDESENCOUNTER=$$GETAPT^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN,.ERRORS)
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,174)
 .S ERRORS("NoShow",1)=""
 .D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS)
 ;
 I SDESENCOUNTER D EN^SDCODEL(SDESENCOUNTER,2,"","NOSHOW")  ;suppress event logging for cancel checkout when no-showing
 ;
 ;  Event driver "AFTER" actions
 D AFTEREVTS(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
 ;
 S RESULT("NoShow")="No-show complete."
 D BUILDJSON^SDESBUILDJSON(.SDESRES,.RESULT)
 Q
UNDONOSHOW(SDESRES,APPTIEN) ;
 N DFN,APPTDTTM,REQTYPE,CONS,CONSULTIEN,PROVIDER,NOTE,RESOURCE,SDECNOEV,SDESENCOUNTER,REQIEN,APPTIENS,NOSHOW,RESTXT
 N CURRENTSTAT,CURNOSHOWDTTM,ERRORS,RESTYPE,CLINICIEN,RESULT,UPDSTAT,FDA
 N SDATA,SDCIHDL,SDDA
 S SDECNOEV=1 ;Don't execute protocol
 ;
 S APPTIEN=$G(APPTIEN)
 ;validate appointment ID
 D VALAPPTIEN^SDESVALUTIL(.ERRORS,APPTIEN)
 I $D(ERRORS) S ERRORS("UndoNoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 D GETVARS(APPTIEN,.CURRENTSTAT,.CURNOSHOWDTTM,.DFN,.APPTDTTM,.PROVIDER,.REQIEN,.NOSHOW,.REQTYPE,.USERIEN,.RESOURCE)
 S SDESNOSHOWDTTM=""
 ;
 ; check resource and clinic validity
 I 'RESOURCE D ERRLOG^SDESJSON(.ERRORS,282)
 S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
 I 'CLINICIEN D ERRLOG^SDESJSON(.ERRORS,283)
 ;
 ; if not in no-show already do not continue
 I 'NOSHOW!(CURRENTSTAT'="N") D ERRLOG^SDESJSON(.ERRORS,368)
 I $D(ERRORS) S ERRORS("UndoNoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 ;  Event driver "BEFORE" actions
 S SDDA=$$FIND^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN)
 D BEFOREEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,.SDCIHDL)
 ;
 ;  Process no show
 ;
 D UPDNOSHOWSTAT(.ERRORS,APPTIEN,USERIEN,SDESNOSHOWDTTM,0)
 ; if an error was returned, build the JSON and quit
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,370)
 .S ERRORS("UndoNoShow",1)="" D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS) Q
 ;
 D APPTUNDONOSHOW(.ERRORS,CLINICIEN,DFN,APPTDTTM,USERIEN,SDESNOSHOWDTTM,APPTIEN)
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,371)
 .S ERRORS("UndoNoShow",1)=""
 .D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS)
 ;
 ; only update PID if the updates to 409.84 and 2.98 were successful
 ; PID CHANGE ALLOWED Field in 409.85 based on whether no-show or cancel no-show
 S UPDSTAT=$$GET1^DIQ(409.84,APPTIEN,.17,"I")
 I REQTYPE="APPT",UPDSTAT'="N" D
 .S FDA(409.85,REQIEN_",",19)=""
 .S FDA(409.85,REQIEN_",",20)=""
 .S FDA(409.85,REQIEN_",",21)=""
 .; 864
 .;S FDA(409.85,REQIEN_",",23)="CLOSED"
 .S FDA(409.85,REQIEN_",",23)="C"
 .S FDA(409.85,REQIEN_",",49)=0
 .D FILE^DIE("","FDA") K FDA
 ;
 ;
 ; fix action required in PCE after no-show from GUI
 ; SDESENCOUNTER - outpatient encounter
 ; Anu
 ;S SDESENCOUNTER=$$GETAPT^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN)
 S SDESENCOUNTER=$$GETAPT^SDESCHECKOUT(DFN,APPTDTTM,CLINICIEN,.ERRORS)
 I $D(ERRORS) D  Q
 .D ERRLOG^SDESJSON(.ERRORS,174)
 .S ERRORS("UndoNoShow",1)=""
 .D BUILDJSON^SDESBUILDJSON(.SDESRES,.ERRORS)
 ;
 I SDESENCOUNTER D EN^SDCODEL(SDESENCOUNTER,2,"","NOSHOW")  ;suppress event logging for cancel checkout when no-showing
 ;
 ;  Event driver "AFTER" actions
 ;
 ;remove undo no-show from grid; /BLB/
 ;
 I REQTYPE="CONSULT" D CONSREQUESTSET(PROVIDER,APPTDTTM,RESOURCE)
 D AFTEREVTS(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
 ;
 S RESULT("UndoNoShow")="Undo No-show complete."
 D BUILDJSON^SDESBUILDJSON(.SDESRES,.RESULT)
 Q
 ; get variables needed for processing
GETVARS(APPTIEN,CURRENTSTAT,CURNOSHOWDTTM,DFN,APPTDTTM,PROVIDER,REQIEN,NOSHOW,REQTYPE,USERIEN,RESOURCE) ;
 N APPTIENS,APPTDAT,APPTERR
 S APPTIENS=APPTIEN_","
 D GETS^DIQ(409.84,APPTIENS,".01;.05;.07;.16;.17;.1;.101;.102;.22","I","APPTDAT","APPTERR")
 S CURRENTSTAT=$G(APPTDAT(409.84,APPTIENS,.17,"I"))
 S CURNOSHOWDTTM=$G(APPTDAT(409.84,APPTIENS,.101,"I"))
 S DFN=$G(APPTDAT(409.84,APPTIENS,.05,"I"))
 S APPTDTTM=$G(APPTDAT(409.84,APPTIENS,.01,"I"))
 S PROVIDER=$G(APPTDAT(409.84,APPTIENS,.16,"I"))
 S REQIEN=$P($G(APPTDAT(409.84,APPTIENS,.22,"I")),";")
 S NOSHOW=$G(APPTDAT(409.84,APPTIENS,.1,"I"))
 S REQTYPE=$$GET1^DIQ(409.84,APPTIENS,.22,"E")
 S USERIEN=$G(DUZ)
 S RESOURCE=$G(APPTDAT(409.84,APPTIENS,.07,"I"))
 Q
 ;
CONSREQUESTSET(PROVIDER,APPTDTTM,RESOURCE) ;
 N REQTYPE,CONS,CONSULTIEN,NOTE
 S REQTYPE=$$GET1^DIQ(409.84,APPTIEN,.22,"E")
 I REQTYPE="CONSULT" D
 .S CONS=$$GET1^DIQ(409.84,APPTIEN,.22,"I")
 .S CONSULTIEN=$P(CONS,";",1)
 .S NOTE=$$GET1^DIQ(409.84,APPTIEN,1,"E")
 .D REQSET^SDESCONSULTUPD(CONSULTIEN,PROVIDER,,1,,NOTE,APPTDTTM,RESOURCE)
 Q
 ;
 ; update file 2 info
 ;Set noshow for patient DFN in CLINICIEN SDCL
 ;at time SDT
APPTNOSHOW(ERRORS,SDCL,DFN,SDT,USERIEN,SDECCDT,SDAPID)  ;
 N SDRTYP,SDECIENS,SDFDA,SDECMSG,IEN
 S SDECIENS=SDT_","_DFN_","
 S SDFDA(2.98,SDECIENS,3)="N"
 S SDFDA(2.98,SDECIENS,14)=USERIEN
 S SDFDA(2.98,SDECIENS,15)=SDECCDT
 D FILE^DIE("","SDFDA","SDECMSG")
 I $D(SDECMSG) D ERRLOG^SDESJSON(.ERRORS,52,$G(SDECMSG("DIERR",1,"TEXT",1))) Q
 D UPDCNSLT(SDAPID,DFN,SDCL,SDT)
 Q
 ; Remove no-show fields from file 2
APPTUNDONOSHOW(ERRORS,SDCL,DFN,SDT,USERIEN,SDECCDT,SDAPID) ;
 N SDRTYP,SDECIENS,SDFDA,SDECMSG,IEN
 S SDECIENS=SDT_","_DFN_","
 S SDFDA(2.98,SDECIENS,3)=""
 S SDFDA(2.98,SDECIENS,14)=""
 S SDFDA(2.98,SDECIENS,15)=""
 D FILE^DIE("","SDFDA","SDECMSG")
 I $D(SDECMSG) D ERRLOG^SDESJSON(.ERRORS,52,$G(SDECMSG("DIERR",1,"TEXT",1))) Q
 D UPDCNSLT(SDAPID,DFN,SDCL,SDT)
 Q
 ; update consult
UPDCNSLT(SDAPID,DFN,SDCL,SDT) ;
 N SDRTYP,IEN,SDRES
 S SDRTYP=$$GET1^DIQ(409.84,SDAPID_",",.22,"I")
 I $P(SDRTYP,";",2)="GMR(123," D
 .S IEN=$$SCIEN^SDECU2(DFN,SDCL,SDT)
 .D NOSHOW^SDCNSLT(SDCL,SDT,DFN,$P(SDRTYP,";",1),IEN)
 ;for Recall Request APPT NOSHOW
 I $P(SDRTYP,";",2)="SD(403.5," D REOPEN^SDESRECALLREQ(.SDESRES,APPTIEN,SDRTYP)
 Q
 ; set 409.84 no-show fields
UPDNOSHOWSTAT(ERRORS,APPTIEN,USERIEN,SDESNOSHOWDTTM,NOSHOWSTAT) ;
 N SDFDA,SDECIENS,SDECMSG
 S SDECIENS=APPTIEN_","
 S SDFDA(409.84,SDECIENS,.1)=NOSHOWSTAT ;NOSHOW
 S SDFDA(409.84,SDECIENS,.101)=$G(SDESNOSHOWDTTM)  ;NOSHOW DATE
 S SDFDA(409.84,SDECIENS,.102)=$G(USERIEN)   ;NOSHOW USER
 S SDFDA(409.84,SDECIENS,.17)=$S(NOSHOWSTAT:"N",1:"") ;  Update STATUS
 D FILE^DIE("","SDFDA","SDECMSG")
 I $D(SDECMSG("DIERR")) S SDECMSG=$G(SDECMSG("DIERR",1,"TEXT",1)) D ERRLOG^SDESJSON(.ERRORS,52,SDECMSG)
 Q
 ;
BEFOREEVT(SDATA,DFN,APPTDTTM,CLINICIEN,SDCIHDL) ;
 S SDATA=SDDA_U_DFN_U_APPTDTTM_U_CLINICIEN
 S SDCIHDL=$$HANDLE^SDAMEVT(1)
 D BEFORE^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
 Q
AFTEREVTS(SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL) ;
 D AFTER^SDAMEVT(.SDATA,DFN,APPTDTTM,CLINICIEN,SDDA,SDCIHDL)
 ;  Execute event driver.  3=no show (see #409.66), 2=non-interactive
 D EVT^SDAMEVT(.SDATA,3,2,SDCIHDL) ;
 Q