source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCODEL.m@ 1672

Last change on this file since 1672 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1SDCODEL ;ALB/RMO,ESW - Delete - Check Out; 27 APR 1993 3:00 pm ; 10/10/02 5:38pm
2 ;;5.3;Scheduling;**20,27,44,97,105,110,132,257**;Aug 13, 1993
3 ;
4EN(SDOE,SDMOD,SDELHDL,SDELSRC) ;Delete Check Out
5 ; Input -- SDOE Outpatient Encounter file IEN
6 ; SDMOD 1=Interactive and 0=Non-interactive
7 ; SDELHDL Check Out Deletion Handle [Optional]
8 ; SDELSRC Source of delete
9 ; Output -- Delete Check Out
10 N DA,DFN,DE,DIE,DR,SDCL,SDDA,SDEVTF,SDOE0,SDOEP,SDORG,SDT,SDVSAV,SDVFLG
11 D SET(SDOE,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
12 S SDVSAV=$P(SDOE0,U,5)
13 ;
14 ; -- ok to delete?
15 IF '$$EDITOK^SDCO3(SDOE,SDMOD) G ENQ
16 ;
17 IF $G(SDELSRC)'="PCE" S X=$$DELVFILE^PXAPI("ALL",$P($G(^SCE(SDOE,0)),U,5),"","","",1)
18 S SDVFLG=1
19 ;
20 ; -- get handle if not passed and do 'before'
21 I '$G(SDELHDL) N SDATA,SDELHDL S SDEVTF=1 D EVT^SDCOU1(SDOE,"BEFORE",.SDELHDL,.SDATA)
22 ;
23 I $G(SDMOD) W !!,">>> Deleting check out information..."
24 ;
25 ; -- delete child data for appts, dispos and stop code addition
26 I "^1^2^3^"[("^"_SDORG_"^") D CHLD(SDOE,SDMOD) ;SD/257
27 ;
28 ; -- delete SDOE pointers and co d/t
29 I SDORG=1 D
30 .S DA(1)=DFN,DA=SDT,DIE="^DPT("_DFN_",""S"",",DR="21///@" D ^DIE
31 .I $G(SDMOD) W !?3,"...deleting check out date/time"
32 .S DR="303///@" D DIE^SDCO1(SDCL,SDT,+SDDA,DR)
33 I SDORG=3 D
34 .S DA(1)=DFN,DA=+SDDA,DIE="^DPT("_DFN_",""DIS"",",DR="18///@" D ^DIE
35 ;
36 ; -- do final deletes for sdoe
37 D CO(SDOE,SDMOD)
38 D OE(SDOE,SDMOD)
39 ;
40 I $G(SDMOD) W !,">>> done."
41 ;
42 ; -- if handle not passed, then 'after' and event
43 I $G(SDEVTF) D EVT^SDCOU1(SDOE,"AFTER",SDELHDL,.SDATA,SDOE0)
44 ;
45 ; -- call pce to make sure its data is gone
46 I $G(SDVFLG) D DEAD^PXUTLSTP(SDVSAV)
47ENQ Q
48 ;
49CHLD(SDOEP,SDMOD) ;Delete Children
50 N DFN,SDCL,SDDA,SDOE0,SDOEC,SDORG,SDT
51 S SDOEC=0
52 F S SDOEC=$O(^SCE("APAR",SDOEP,SDOEC)) Q:'SDOEC D
53 .D SET(SDOEC,.SDOE0,.SDT,.DFN,.SDCL,.SDORG,.SDDA)
54 .D OE(SDOEC,SDMOD)
55 Q
56 ;
57SET(SDOE,SDOE0,SDT,DFN,SDCL,SDORG,SDDA) ;Set Variables
58 S SDOE0=$G(^SCE(+SDOE,0)),SDT=+SDOE0,DFN=+$P(SDOE0,"^",2),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8),SDDA=$P(SDOE0,"^",9)
59 Q
60 ;
61CO(SDOE,SDMOD) ;Delete Classification
62 N DA,DIK,SDFL,SDI
63 I $P($G(^SCE(SDOE,0)),"^",6) G COQ
64 I $O(^SDD(409.42,"AO",SDOE,0))>0 D
65 .I $G(SDMOD) W !?3,"...deleting classifications"
66 .D DEL(SDOE,409.42)
67COQ Q
68 ;
69DEL(SDOE,SDFL) ;Delete Classification
70 N DA,DIK,SDI
71 S DIK="^SDD("_SDFL_",",SDI=0
72 F S SDI=$O(^SDD(SDFL,"AO",SDOE,SDI)) Q:'SDI S DA=+$O(^(SDI,0)) D ^DIK
73 Q
74 ;
75OE(SDOE,SDMOD) ;Delete Outpatient Encounter
76 N DA,DIK,SDVSIT,SDORG,SDAT
77 IF '$$EDITOK^SDCO3(SDOE,SDMOD) G OEQ
78 S SDAT=$P($G(^SCE(+SDOE,0)),U,1)
79 S SDVSIT=$P($G(^SCE(SDOE,0)),U,5),SDORG=$P($G(^SCE(SDOE,0)),U,8)
80 S DA=SDOE,DIK="^SCE(" D ^DIK
81 S X=$$KILL^VSITKIL(SDVSIT)
82OEQ Q
83 ;
84COMDT(SDOE,SDMOD) ;Delete Check Out Process Completion Date
85 N DA,DE,DIE,DQ,DR
86 I $G(SDMOD) W !?3,"...deleting check out process completion date"
87 S DA=SDOE,DIE="^SCE(",DR=".07///@" D ^DIE
88 Q
Note: See TracBrowser for help on using the repository browser.