SDCODEL ;ALB/RMO,BWF - Delete Check Out ;JAN 15, 2016
;;5.3;Scheduling;**20,27,44,97,105,110,132,257,627,717,831**;Aug 13, 1993;Build 4
;
EN(SDOE,SDMOD,SDELHDL,SDELSRC) ;Delete Check Out
; Input -- SDOE Outpatient Encounter file IEN
; SDMOD 1=Interactive and 0=Non-interactive, 2=Non-interactive/from GUI
; SDELHDL Check Out Deletion Handle [Optional]
; SDELSRC Source of delete
; Output -- Delete Check Out
N DA,DFN,DE,DIE,DR,SDCL,SDDA,SDEVTF,SDOE0,SDOEP,SDORG,SDT,SDVSAV,SDVFLG,X
D SET(SDOE,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
S SDVSAV=$P(SDOE0,U,5)
;
; -- ok to delete?
IF '$$EDITOK^SDCO3(SDOE,SDMOD) G ENQ
;
S SDELSRC=$G(SDELSRC) ;*zeb+1 717 11/6/18 suppress event if coming from cancel appointment
IF SDELSRC'="PCE" S X=$$DELVFILE^PXAPI("ALL",$P($G(^SCE(SDOE,0)),U,5),"","","",0)
S SDVFLG=1
;
; -- get handle if not passed and do 'before'
I '$G(SDELHDL),("^CANCEL^NOSHOW^"'["^"_SDELSRC_"^") N SDATA,SDELHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA) ;*zeb 717 11/6/18 suppress event if coming from cancel or no show
;
I $G(SDMOD)=1 W !!,">>> Deleting check out information..." ;*zeb 10/25/18 717 fix test for SDMOD=2 for GUI
;
; -- delete child data for appts, disposition and stop code addition
I "^1^2^3^"[("^"_SDORG_"^") D CHLD(SDOE,SDMOD) ;SD/257
;
; -- delete SDOE pointers and co d/t
I SDORG=1 D
.S DA(1)=DFN,DA=SDT,DIE="^DPT("_DFN_",""S"",",DR="21///@" D ^DIE
.I $G(SDMOD)=1 W !?3,"...deleting check out date/time"
.S DR="303///@" D DIE^SDCO1(SDCL,SDT,+SDDA,DR)
I SDORG=3 D
.S DA(1)=DFN,DA=+SDDA,DIE="^DPT("_DFN_",""DIS"",",DR="18///@" D ^DIE
;
; -- do final deletes for sdoe
D CO(SDOE,SDMOD)
D OE(SDOE,SDMOD)
D SDEC(DFN,SDT,SDCL) ;delete checkout in SDEC APPOINTMENT ;alb/sat 627
;
I $G(SDMOD)=1 W !,">>> done."
;
; -- if handle not passed, then 'after' and event
I $G(SDEVTF),(SDELSRC'="CANCEL") D EVT^SDCOU1(SDOE,"AFTER",SDELHDL,.SDATA,SDOE0) ;*zeb 717 11/6/18 suppress event if coming from cancel appointment
;
; -- call pce to make sure its data is gone
I $G(SDVFLG) D DEAD^PXUTLSTP(SDVSAV)
ENQ Q
;
CHLD(SDOEP,SDMOD) ;Delete Children
N DFN,SDCL,SDDA,SDOE0,SDOEC,SDORG,SDT
S SDOEC=0
F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
.D SET(SDOEC,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
.D OE(SDOEC,SDMOD)
Q
;
SET(SDOE,SDOE0,SDT,DFN,SDCL,SDORG,SDDA) ;Set Variables
S SDOE0=$G(^SCE(+SDOE,0)),SDT=+SDOE0,DFN=+$P(SDOE0,"^",2),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8),SDDA=$P(SDOE0,"^",9)
Q
;
CO(SDOE,SDMOD) ;Delete Classification
N DA,DIK,SDFL,SDI
I $P($G(^SCE(SDOE,0)),"^",6) G COQ
I $O(^SDD(409.42,"AO",SDOE,0))>0 D
.I $G(SDMOD)=1 W !?3,"...deleting classifications"
.D DEL(SDOE,409.42)
COQ Q
;
DEL(SDOE,SDFL) ;Delete Classification
N DA,DIK,SDI
S DIK="^SDD("_SDFL_",",SDI=0
F S SDI=$O(^SDD(SDFL,"AO",SDOE,SDI)) Q:'SDI S DA=+$O(^(SDI,0)) D ^DIK
Q
;
OE(SDOE,SDMOD) ;Delete Outpatient Encounter
N DA,DIK,SDVSIT,SDORG,SDAT
IF '$$EDITOK^SDCO3(SDOE,SDMOD) G OEQ
S SDAT=$P($G(^SCE(+SDOE,0)),U,1)
S SDVSIT=$P($G(^SCE(SDOE,0)),U,5),SDORG=$P($G(^SCE(SDOE,0)),U,8)
S DA=SDOE,DIK="^SCE(" D ^DIK
S X=$$KILL^VSITKIL(SDVSIT)
OEQ Q
;
COMDT(SDOE,SDMOD) ;Delete Check Out Process Completion Date
N DA,DE,DIE,DQ,DR
I $G(SDMOD)=1 W !?3,"...deleting check out process completion date"
S DA=SDOE,DIE="^SCE(",DR=".07///@" D ^DIE
Q
;
SDEC(DFN,SDT,SDCL) ;delete check out in SDEC APPOINTMENT ;alb/sat 627
N SDECAPID
S SDECAPID=$$APPTGET^SDECUTL(DFN,SDT,SDCL)
D CANAPPT^SDEC25(SDECAPID)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCODEL 3627 printed Jun 11, 2024@22:30:33 Page 2
SDCODEL ;ALB/RMO,BWF - Delete Check Out ;JAN 15, 2016
+1 ;;5.3;Scheduling;**20,27,44,97,105,110,132,257,627,717,831**;Aug 13, 1993;Build 4
+2 ;
EN(SDOE,SDMOD,SDELHDL,SDELSRC) ;Delete Check Out
+1 ; Input -- SDOE Outpatient Encounter file IEN
+2 ; SDMOD 1=Interactive and 0=Non-interactive, 2=Non-interactive/from GUI
+3 ; SDELHDL Check Out Deletion Handle [Optional]
+4 ; SDELSRC Source of delete
+5 ; Output -- Delete Check Out
+6 NEW DA,DFN,DE,DIE,DR,SDCL,SDDA,SDEVTF,SDOE0,SDOEP,SDORG,SDT,SDVSAV,SDVFLG,X
+7 DO SET(SDOE,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
+8 SET SDVSAV=$PIECE(SDOE0,U,5)
+9 ;
+10 ; -- ok to delete?
+11 IF '$$EDITOK^SDCO3(SDOE,SDMOD)
GOTO ENQ
+12 ;
+13 ;*zeb+1 717 11/6/18 suppress event if coming from cancel appointment
SET SDELSRC=$GET(SDELSRC)
+14 IF SDELSRC'="PCE"
SET X=$$DELVFILE^PXAPI("ALL",$PIECE($GET(^SCE(SDOE,0)),U,5),"","","",0)
+15 SET SDVFLG=1
+16 ;
+17 ; -- get handle if not passed and do 'before'
+18 ;*zeb 717 11/6/18 suppress event if coming from cancel or no show
IF '$GET(SDELHDL)
IF ("^CANCEL^NOSHOW^"'["^"_SDELSRC_"^")
NEW SDATA,SDELHDL
SET SDEVTF=1
DO EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA)
+19 ;
+20 ;*zeb 10/25/18 717 fix test for SDMOD=2 for GUI
IF $GET(SDMOD)=1
WRITE !!,">>> Deleting check out information..."
+21 ;
+22 ; -- delete child data for appts, disposition and stop code addition
+23 ;SD/257
IF "^1^2^3^"[("^"_SDORG_"^")
DO CHLD(SDOE,SDMOD)
+24 ;
+25 ; -- delete SDOE pointers and co d/t
+26 IF SDORG=1
Begin DoDot:1
+27 SET DA(1)=DFN
SET DA=SDT
SET DIE="^DPT("_DFN_",""S"","
SET DR="21///@"
DO ^DIE
+28 IF $GET(SDMOD)=1
WRITE !?3,"...deleting check out date/time"
+29 SET DR="303///@"
DO DIE^SDCO1(SDCL,SDT,+SDDA,DR)
End DoDot:1
+30 IF SDORG=3
Begin DoDot:1
+31 SET DA(1)=DFN
SET DA=+SDDA
SET DIE="^DPT("_DFN_",""DIS"","
SET DR="18///@"
DO ^DIE
End DoDot:1
+32 ;
+33 ; -- do final deletes for sdoe
+34 DO CO(SDOE,SDMOD)
+35 DO OE(SDOE,SDMOD)
+36 ;delete checkout in SDEC APPOINTMENT ;alb/sat 627
DO SDEC(DFN,SDT,SDCL)
+37 ;
+38 IF $GET(SDMOD)=1
WRITE !,">>> done."
+39 ;
+40 ; -- if handle not passed, then 'after' and event
+41 ;*zeb 717 11/6/18 suppress event if coming from cancel appointment
IF $GET(SDEVTF)
IF (SDELSRC'="CANCEL")
DO EVT^SDCOU1(SDOE,"AFTER",SDELHDL,.SDATA,SDOE0)
+42 ;
+43 ; -- call pce to make sure its data is gone
+44 IF $GET(SDVFLG)
DO DEAD^PXUTLSTP(SDVSAV)
ENQ QUIT
+1 ;
CHLD(SDOEP,SDMOD) ;Delete Children
+1 NEW DFN,SDCL,SDDA,SDOE0,SDOEC,SDORG,SDT
+2 SET SDOEC=0
+3 FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOEP,SDOEC))
if 'SDOEC
QUIT
Begin DoDot:1
+4 DO SET(SDOEC,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
+5 DO OE(SDOEC,SDMOD)
End DoDot:1
+6 QUIT
+7 ;
SET(SDOE,SDOE0,SDT,DFN,SDCL,SDORG,SDDA) ;Set Variables
+1 SET SDOE0=$GET(^SCE(+SDOE,0))
SET SDT=+SDOE0
SET DFN=+$PIECE(SDOE0,"^",2)
SET SDCL=+$PIECE(SDOE0,"^",4)
SET SDORG=+$PIECE(SDOE0,"^",8)
SET SDDA=$PIECE(SDOE0,"^",9)
+2 QUIT
+3 ;
CO(SDOE,SDMOD) ;Delete Classification
+1 NEW DA,DIK,SDFL,SDI
+2 IF $PIECE($GET(^SCE(SDOE,0)),"^",6)
GOTO COQ
+3 IF $ORDER(^SDD(409.42,"AO",SDOE,0))>0
Begin DoDot:1
+4 IF $GET(SDMOD)=1
WRITE !?3,"...deleting classifications"
+5 DO DEL(SDOE,409.42)
End DoDot:1
COQ QUIT
+1 ;
DEL(SDOE,SDFL) ;Delete Classification
+1 NEW DA,DIK,SDI
+2 SET DIK="^SDD("_SDFL_","
SET SDI=0
+3 FOR
SET SDI=$ORDER(^SDD(SDFL,"AO",SDOE,SDI))
if 'SDI
QUIT
SET DA=+$ORDER(^(SDI,0))
DO ^DIK
+4 QUIT
+5 ;
OE(SDOE,SDMOD) ;Delete Outpatient Encounter
+1 NEW DA,DIK,SDVSIT,SDORG,SDAT
+2 IF '$$EDITOK^SDCO3(SDOE,SDMOD)
GOTO OEQ
+3 SET SDAT=$PIECE($GET(^SCE(+SDOE,0)),U,1)
+4 SET SDVSIT=$PIECE($GET(^SCE(SDOE,0)),U,5)
SET SDORG=$PIECE($GET(^SCE(SDOE,0)),U,8)
+5 SET DA=SDOE
SET DIK="^SCE("
DO ^DIK
+6 SET X=$$KILL^VSITKIL(SDVSIT)
OEQ QUIT
+1 ;
COMDT(SDOE,SDMOD) ;Delete Check Out Process Completion Date
+1 NEW DA,DE,DIE,DQ,DR
+2 IF $GET(SDMOD)=1
WRITE !?3,"...deleting check out process completion date"
+3 SET DA=SDOE
SET DIE="^SCE("
SET DR=".07///@"
DO ^DIE
+4 QUIT
+5 ;
SDEC(DFN,SDT,SDCL) ;delete check out in SDEC APPOINTMENT ;alb/sat 627
+1 NEW SDECAPID
+2 SET SDECAPID=$$APPTGET^SDECUTL(DFN,SDT,SDCL)
+3 DO CANAPPT^SDEC25(SDECAPID)
+4 QUIT
