- 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 Feb 19, 2025@00:15:59 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