source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDDI1.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1SCDDI1 ;ALB/SCK/JLU - DD Calls used by Incomplete Encounter Management ; 6/6/97
2 ;;5.3;Scheduling;**66**;AUG 13, 1993
3 Q
4SETAEDT(DA,X) ;
5 Q:'$G(DA)!('$G(X))
6 N SDT,SDTD,SDX
7 S (SDT,SDTD)=""
8 S SDT=$P($G(^SD(409.73,X,0)),"^",2)
9 I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
10 Q:'SDT&('SDTD)
11 I SDT S SDT=$P($G(^SCE(SDT,0)),"^")
12 I SDTD S SDT=$P($G(^SD(409.74,SDTD,0)),"^")
13 S:SDT ^SD(409.75,"AEDT",SDT,X,DA)=""
14 Q
15 ;
16KILAEDT(DA,X) ;
17 Q:'$G(DA)!('$G(X))
18 N SDT,SDTD,SDX
19 S (SDT,SDTD)=""
20 S SDT=$P($G(^SD(409.73,X,0)),"^",2)
21 I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
22 Q:'SDT&('SDTD)
23 I SDT S SDT=$P($G(^SCE(SDT,0)),"^")
24 I SDTD S SDT=$P($G(^SD(409.74,SDTD,0)),"^")
25 K:SDT ^SD(409.75,"AEDT",SDT,X,DA)
26 Q
27 ;
28SETAECL(DA,X) ;
29 Q:'$G(DA)!('$G(X))
30 N SDCL,SDX,SDT,SDTD
31 S (SDCL,SDT,SDTD)=""
32 S SDT=$P($G(^SD(409.73,X,0)),"^",2)
33 I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
34 Q:'SDT&('SDTD)
35 I SDT S SDCL=$P($G(^SCE(SDT,0)),"^",4)
36 I SDTD S SDCL=$P($G(^SD(409.74,SDTD,1)),"^",4)
37 Q:'SDCL
38 S:SDCL ^SD(409.75,"AECL",SDCL,DA)=""
39 Q
40 ;
41KILAECL(DA,X) ;
42 Q:'$G(DA)!('$G(X))
43 N SDT,SDTD,SDCL
44 S (SDT,SDTD,SDCL)=""
45 S SDT=$P($G(^SD(409.73,X,0)),"^",2)
46 I 'SDT S SDTD=$P($G(^SD(409.73,X,0)),"^",3)
47 Q:'SDT&('SDTD)
48 I SDT S SDCL=$P($G(^SCE(SDT,0)),"^",4)
49 I SDTD S SDCL=$P($G(^SD(409.74,SDTD,1)),"^",4)
50 Q:'SDCL
51 K ^SD(409.75,"AECL",SDCL,DA)
52 Q
53 ;
54SETACOD1(DA,X) ;
55 Q:'$G(DA)!('$G(X))
56 N DFN,COD
57 S COD=$P(^SD(409.75,DA,0),U,2)
58 I COD']"" Q
59 S COD=$P($G(^SD(409.76,COD,0)),U,1)
60 I COD']"" Q
61 S DFN=$P(^SD(409.75,DA,0),U,1)
62 I 'DFN Q
63 D PATDFN^SCDXUTL2(DFN)
64 I 'DFN Q
65 S ^SD(409.75,"ACOD",DFN,COD,DA)=""
66 Q
67 ;
68KILACOD1(DA,X) ;
69 Q:'$G(DA)!('$G(X))
70 N DFN,COD
71 S COD=$P(^SD(409.75,DA,0),U,2)
72 I COD']"" Q
73 S COD=$P($G(^SD(409.76,COD,0)),U,1)
74 I COD']"" Q
75 S DFN=$P(^SD(409.75,DA,0),U,1)
76 I 'DFN Q
77 D PATDFN^SCDXUTL2(DFN)
78 I 'DFN Q
79 K ^SD(409.75,"ACOD",DFN,COD,DA)
80 Q
81 ;
82SETACOD2(DA,X) ;
83 Q:'$G(DA)!('$G(X))
84 N DFN,COD
85 S DFN=$P(^SD(409.75,DA,0),U,1)
86 I 'DFN Q
87 D PATDFN^SCDXUTL2(DFN)
88 I 'DFN Q
89 S COD=$P($G(^SD(409.76,$E(X,1,30),0)),U,1)
90 I COD']"" Q
91 S ^SD(409.75,"ACOD",DFN,COD,DA)=""
92 Q
93 ;
94KILACOD2(DA,X) ;
95 Q:'$G(DA)!('$G(X))
96 N DFN,COD
97 S DFN=$P(^SD(409.75,DA,0),U,1)
98 I 'DFN Q
99 D PATDFN^SCDXUTL2(DFN)
100 I 'DFN Q
101 S COD=$P($G(^SD(409.76,$E(X,1,30),0)),U,1)
102 I COD']"" Q
103 K ^SD(409.75,"ACOD",DFN,COD,DA)
104 Q
Note: See TracBrowser for help on using the repository browser.