SDESUNDOCHECKOUT ;ALB/BLB,CGP - VISTA SCHEDULING RPCS - SDES UNDO CHECKOUT;JAN 25, 2023
;;5.3;Scheduling;**831,836**;Aug 13, 1993;Build 20
;;Per VHA Directive 6402, this routine should not be modified
; Reference to MAS PARAMETERS in ICR #483
; Reference to WARD LOCATION in ICR #1377
; Reference to MAS PARAMETERS in ICR #2296
; Reference to VISIT in ICR #2028
;
Q
;
UNDOCHECKOUT(JSONRETURN,APPTIEN) ;
N ERRORS,RETURN,APPTSUBIEN44,APPTSTARTTIME,DFN,CLINICIEN,RESOURCEIEN,SDATA,SDCIHDL
;
D VALIDATE(.ERRORS,$G(APPTIEN))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
S APPTSTARTTIME=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
S DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
S RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
S CLINICIEN=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
S APPTSUBIEN44=$$FIND^SDESCHECKOUT(DFN,APPTSTARTTIME,CLINICIEN)
S SDATA=APPTSUBIEN44_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
S SDCIHDL=$$HANDLE^SDAMEVT(1)
;
D BEFOREEVENT($G(APPTSTARTTIME),$G(DFN),$G(CLINICIEN),$G(APPTSUBIEN44),SDCIHDL,.SDATA)
;
D UNDO($G(APPTIEN),$G(CLINICIEN),$G(APPTSTARTTIME),$G(DFN))
;
D AFTEREVENT($G(APPTSTARTTIME),$G(DFN),$G(CLINICIEN),$G(APPTSUBIEN44),SDCIHDL,.SDATA)
;
S RETURN("UndoCheckOut",1)="Undo Check Out Completed." D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
;
Q
;
UNDO(APPTIEN,CLINICIEN,APPTSTARTTIME,DFN) ;
N FDA84,ERR84,FDA44,ERR44,IENS44,ENCOUNTERIEN,VISITFILEIEN,FDA9000010,ERR9000010,FDA40968,ERR40968
;
S FDA84(409.84,APPTIEN_",",.14)="@"
S FDA84(409.84,APPTIEN_",",.08)=$G(DUZ)
D FILE^DIE(,"FDA84","ERR84") K FDA84
;
;
S IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTSTARTTIME,DFN)
I $G(IENS44) D
.S FDA44(44.003,IENS44,303)="@"
.S FDA44(44.003,IENS44,304)="@"
.S FDA44(44.003,IENS44,306)="@"
.D FILE^DIE(,"FDA44","ERR44") K FDA44
;
;
S ENCOUNTERIEN=$$GETAPT^SDVSIT2(DFN,APPTSTARTTIME,CLINICIEN)
S VISITFILEIEN=$$GET1^DIQ(409.68,ENCOUNTERIEN,.05,"I")
I $D(^AUPNVSIT($G(VISITFILEIEN),0)) D
.S FDA9000010(9000010,VISITFILEIEN_",",.18)="@"
.D FILE^DIE(,"FDA9000010","ERR9000010") K FDA9000010
;
;
I $D(^SCE($G(ENCOUNTERIEN),0)),$$GET1^DIQ(409.84,APPTIEN,.19,"I") D
.S FDA40968(409.68,ENCOUNTERIEN_",",.07)="@"
.S FDA40968(409.68,ENCOUNTERIEN_",",.12)=$$GET1^DIQ(409.84,APPTIEN,.19,"I")
.S FDA40968(409.68,ENCOUNTERIEN_",",101)=$G(DUZ)
.S FDA40968(409.68,ENCOUNTERIEN_",",102)=$$NOW^XLFDT
.D FILE^DIE(,"FDA40968","ERR40968") K FDA40968
;
Q
;
BEFOREEVENT(APPTSTARTTIME,DFN,CLINICIEN,APPTSUBIEN44,SDCIHDL,SDATA) ;
D BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,APPTSUBIEN44,SDCIHDL)
Q
;
AFTEREVENT(APPTSTARTTIME,DFN,CLINICIEN,APPTSUBIEN44,SDCIHDL,SDATA) ;
D AFTER^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,APPTSUBIEN44,SDCIHDL)
D EVT^SDAMEVT(.SDATA,5,2,SDCIHDL) ;
Q
;
VALIDATE(ERRORS,APPTIEN) ;
D VALIDATEAPPT(.ERRORS,$G(APPTIEN))
I $D(ERRORS) Q
;
D ISAPPTCHECKEDOUT(.ERRORS,$G(APPTIEN))
Q
;
ISAPPTCHECKEDOUT(ERRORS,APPTIEN) ;
I '$$GET1^DIQ(409.84,APPTIEN,.14,"I") D ERRLOG^SDESJSON(.ERRORS,377)
Q
;
VALIDATEAPPT(ERRORS,APPTIEN) ;
I APPTIEN="" D ERRLOG^SDESJSON(.ERRORS,14)
I APPTIEN'="",'$D(^SDEC(409.84,APPTIEN,0)) D ERRLOG^SDESJSON(.ERRORS,15)
Q
;
VALIDATESUPERVIS(ERRORS) ;
;;Jira-4706 Acheron requested removal of requiered SD SUPERVISOR Key -CGP
;;I '$$KCHK^XUSRB("SD SUPERVISOR",DUZ) D ERRLOG^SDESJSON(.ERRORS,316)
Q
;
BUILDJSON(JSONRETURN,RETURN) ;.
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESUNDOCHECKOUT 3545 printed Oct 16, 2024@18:58:12 Page 2
SDESUNDOCHECKOUT ;ALB/BLB,CGP - VISTA SCHEDULING RPCS - SDES UNDO CHECKOUT;JAN 25, 2023
+1 ;;5.3;Scheduling;**831,836**;Aug 13, 1993;Build 20
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to MAS PARAMETERS in ICR #483
+4 ; Reference to WARD LOCATION in ICR #1377
+5 ; Reference to MAS PARAMETERS in ICR #2296
+6 ; Reference to VISIT in ICR #2028
+7 ;
+8 QUIT
+9 ;
UNDOCHECKOUT(JSONRETURN,APPTIEN) ;
+1 NEW ERRORS,RETURN,APPTSUBIEN44,APPTSTARTTIME,DFN,CLINICIEN,RESOURCEIEN,SDATA,SDCIHDL
+2 ;
+3 DO VALIDATE(.ERRORS,$GET(APPTIEN))
+4 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+5 ;
+6 SET APPTSTARTTIME=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
+7 SET DFN=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
+8 SET RESOURCEIEN=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+9 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCEIEN,.04,"I")
+10 SET APPTSUBIEN44=$$FIND^SDESCHECKOUT(DFN,APPTSTARTTIME,CLINICIEN)
+11 SET SDATA=APPTSUBIEN44_U_DFN_U_APPTSTARTTIME_U_CLINICIEN
+12 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
+13 ;
+14 DO BEFOREEVENT($GET(APPTSTARTTIME),$GET(DFN),$GET(CLINICIEN),$GET(APPTSUBIEN44),SDCIHDL,.SDATA)
+15 ;
+16 DO UNDO($GET(APPTIEN),$GET(CLINICIEN),$GET(APPTSTARTTIME),$GET(DFN))
+17 ;
+18 DO AFTEREVENT($GET(APPTSTARTTIME),$GET(DFN),$GET(CLINICIEN),$GET(APPTSUBIEN44),SDCIHDL,.SDATA)
+19 ;
+20 SET RETURN("UndoCheckOut",1)="Undo Check Out Completed."
DO BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURN)
+21 ;
+22 QUIT
+23 ;
UNDO(APPTIEN,CLINICIEN,APPTSTARTTIME,DFN) ;
+1 NEW FDA84,ERR84,FDA44,ERR44,IENS44,ENCOUNTERIEN,VISITFILEIEN,FDA9000010,ERR9000010,FDA40968,ERR40968
+2 ;
+3 SET FDA84(409.84,APPTIEN_",",.14)="@"
+4 SET FDA84(409.84,APPTIEN_",",.08)=$GET(DUZ)
+5 DO FILE^DIE(,"FDA84","ERR84")
KILL FDA84
+6 ;
+7 ;
+8 SET IENS44=$$GET44RECORDIENS^SDESCANCELAPPTS(CLINICIEN,APPTSTARTTIME,DFN)
+9 IF $GET(IENS44)
Begin DoDot:1
+10 SET FDA44(44.003,IENS44,303)="@"
+11 SET FDA44(44.003,IENS44,304)="@"
+12 SET FDA44(44.003,IENS44,306)="@"
+13 DO FILE^DIE(,"FDA44","ERR44")
KILL FDA44
End DoDot:1
+14 ;
+15 ;
+16 SET ENCOUNTERIEN=$$GETAPT^SDVSIT2(DFN,APPTSTARTTIME,CLINICIEN)
+17 SET VISITFILEIEN=$$GET1^DIQ(409.68,ENCOUNTERIEN,.05,"I")
+18 IF $DATA(^AUPNVSIT($GET(VISITFILEIEN),0))
Begin DoDot:1
+19 SET FDA9000010(9000010,VISITFILEIEN_",",.18)="@"
+20 DO FILE^DIE(,"FDA9000010","ERR9000010")
KILL FDA9000010
End DoDot:1
+21 ;
+22 ;
+23 IF $DATA(^SCE($GET(ENCOUNTERIEN),0))
IF $$GET1^DIQ(409.84,APPTIEN,.19,"I")
Begin DoDot:1
+24 SET FDA40968(409.68,ENCOUNTERIEN_",",.07)="@"
+25 SET FDA40968(409.68,ENCOUNTERIEN_",",.12)=$$GET1^DIQ(409.84,APPTIEN,.19,"I")
+26 SET FDA40968(409.68,ENCOUNTERIEN_",",101)=$GET(DUZ)
+27 SET FDA40968(409.68,ENCOUNTERIEN_",",102)=$$NOW^XLFDT
+28 DO FILE^DIE(,"FDA40968","ERR40968")
KILL FDA40968
End DoDot:1
+29 ;
+30 QUIT
+31 ;
BEFOREEVENT(APPTSTARTTIME,DFN,CLINICIEN,APPTSUBIEN44,SDCIHDL,SDATA) ;
+1 DO BEFORE^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,APPTSUBIEN44,SDCIHDL)
+2 QUIT
+3 ;
AFTEREVENT(APPTSTARTTIME,DFN,CLINICIEN,APPTSUBIEN44,SDCIHDL,SDATA) ;
+1 DO AFTER^SDAMEVT(.SDATA,DFN,APPTSTARTTIME,CLINICIEN,APPTSUBIEN44,SDCIHDL)
+2 ;
DO EVT^SDAMEVT(.SDATA,5,2,SDCIHDL)
+3 QUIT
+4 ;
VALIDATE(ERRORS,APPTIEN) ;
+1 DO VALIDATEAPPT(.ERRORS,$GET(APPTIEN))
+2 IF $DATA(ERRORS)
QUIT
+3 ;
+4 DO ISAPPTCHECKEDOUT(.ERRORS,$GET(APPTIEN))
+5 QUIT
+6 ;
ISAPPTCHECKEDOUT(ERRORS,APPTIEN) ;
+1 IF '$$GET1^DIQ(409.84,APPTIEN,.14,"I")
DO ERRLOG^SDESJSON(.ERRORS,377)
+2 QUIT
+3 ;
VALIDATEAPPT(ERRORS,APPTIEN) ;
+1 IF APPTIEN=""
DO ERRLOG^SDESJSON(.ERRORS,14)
+2 IF APPTIEN'=""
IF '$DATA(^SDEC(409.84,APPTIEN,0))
DO ERRLOG^SDESJSON(.ERRORS,15)
+3 QUIT
+4 ;
VALIDATESUPERVIS(ERRORS) ;
+1 ;;Jira-4706 Acheron requested removal of requiered SD SUPERVISOR Key -CGP
+2 ;;I '$$KCHK^XUSRB("SD SUPERVISOR",DUZ) D ERRLOG^SDESJSON(.ERRORS,316)
+3 QUIT
+4 ;
BUILDJSON(JSONRETURN,RETURN) ;.
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERR")
+3 QUIT
+4 ;
