source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECDUTL.m@ 1608

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

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1ECDUTL ;BIR/MAM,JPW-DSS M Cross References ;30 Apr 96
2 ;;2.0; EVENT CAPTURE ;**4,5**;8 May 96
3ADT ; set 'ADT' x-ref on PROCEDURE DATE/TIME field in file 721
4 S ECULOC=+$P(^ECH(DA,0),"^",4),ECDFN0=+$P(^(0),"^",2),ECUUNIT=+$P(^(0),"^",7)
5 I 'ECULOC!('ECDFN0)!('ECUUNIT) K ECULOC,ECDFN0,ECUUNIT Q
6 S ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,X,DA)=""
7 ;S ^ECH("APAT",ECDFN0,X,DA)=""
8 K ECULOC,ECUUNIT,ECDFN0
9 Q
10KILLADT ; kill 'ADT' x-ref on PROCEDURE DATE/TIME field in file 721
11 S ECULOC=+$P(^ECH(DA,0),"^",4),ECDFN0=+$P(^(0),"^",2),ECUUNIT=+$P(^(0),"^",7)
12 I 'ECULOC!('ECDFN0)!('ECUUNIT) K ECULOC,ECDFN0,ECUUNIT Q
13 K ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,X,DA)
14 ;K ^ECH("APAT",ECDFN0,X,DA),ECULOC,ECUUNIT,ECDFN0
15 K ECULOC,ECUUNIT,ECDFN0
16 Q
17ADTL ; set "ADT" x-ref on LOCATION field in File 721
18 S ECDFN0=+$P(^ECH(DA,0),"^",2),ECUDATE=+$P(^(0),"^",3),ECUUNIT=+$P(^(0),"^",7)
19 I 'ECDFN0!('ECUDATE)!('ECUUNIT) K ECDFN0,ECUDATE,ECUUNIT Q
20 S ^ECH("ADT",X,ECDFN0,ECUUNIT,ECUDATE,DA)=""
21 K ECDFN0,ECUDATE,ECUUNIT
22 Q
23KADTL ; kill "ADT" x-ref on LOCATION field in File 721
24 S ECDFN0=+$P(^ECH(DA,0),"^",2),ECUDATE=+$P(^(0),"^",3),ECUUNIT=+$P(^(0),"^",7)
25 I 'ECDFN0!('ECUDATE)!('ECUUNIT) K ECDFN0,ECUDATE,ECUUNIT Q
26 K ^ECH("ADT",X,ECDFN0,ECUUNIT,ECUDATE,DA),ECDFN0,ECUDATE,ECUUNIT
27 Q
28ADTP ;set "ADT" x-ref on PATIENT field in File 721
29 S ECUDATE=+$P(^ECH(DA,0),"^",3),ECULOC=+$P(^(0),"^",4),ECUUNIT=+$P(^(0),"^",7)
30 I 'ECUDATE!('ECULOC)!('ECUUNIT) K ECUDATE,ECUUNIT,ECULOC Q
31 S ^ECH("ADT",ECULOC,X,ECUUNIT,ECUDATE,DA)=""
32 K ECULOC,ECUDATE,ECUUNIT
33 Q
34KADTP ; kill "ADT" x-ref on PATIENT field in File 721
35 S ECUDATE=+$P(^ECH(DA,0),"^",3),ECULOC=+$P(^(0),"^",4),ECUUNIT=+$P(^(0),"^",7)
36 K ^ECH("ADT",ECULOC,X,ECUUNIT,ECUDATE,DA),ECULOC,ECUDATE,ECUUNIT
37 Q
38ADTU ; sets "ADT" x-ref on DSS UNIT field in File 721
39 S ECULOC=+$P(^ECH(DA,0),"^",4),ECUDATE=+$P(^(0),"^",3),ECDFN0=+$P(^(0),"^",2)
40 I 'ECULOC!('ECUDATE)!('ECDFN0) K ECULOC,ECUDATE,ECDFN0 Q
41 S ^ECH("ADT",ECULOC,ECDFN0,X,ECUDATE,DA)=""
42 K ECULOC,ECDFN0,ECUDATE
43 Q
44KADTU ; kills "ADT" x-ref on DSS UNIT field in File 721
45 S ECULOC=+$P(^ECH(DA,0),"^",4),ECUDATE=+$P(^(0),"^",3),ECDFN0=+$P(^(0),"^",2)
46 I 'ECULOC!('ECUDATE)!('ECDFN0) K ECULOC,ECUDATE,ECDFN0 Q
47 K ^ECH("ADT",ECULOC,ECDFN0,X,ECUDATE,DA),ECULOC,ECDFN0,ECUDATE
48 Q
49APAT ; set "APAT" x-ref on PATIENT field in File 721
50 S ECUDATE=+$P(^ECH(DA,0),"^",3)
51 I 'ECUDATE K ECUDATE Q
52 S ^ECH("APAT",X,ECUDATE,DA)="" K ECUDATE
53 Q
54KAPAT ; kill "APAT" x-ref on PATIENT field in File 721
55 S ECUDATE=+$P(^ECH(DA,0),"^",3)
56 I 'ECUDATE K ECUDATE Q
57 K ^ECH("APAT",X,ECUDATE,DA),ECUDATE
58 Q
59APAT1 ; set "APAT" x-ref on the PROCEDURE DATE/TIME field in File 721
60 S ECDFN0=+$P(^ECH(DA,0),"^",2)
61 I 'ECDFN0 K ECDFN0 Q
62 S ^ECH("APAT",ECDFN0,X,DA)="" K ECDFN0
63 Q
64KAPAT1 ; kill "APAT" x-ref on the PROCEDURE DATE/TIME field in File 721
65 S ECDFN0=+$P(^ECH(DA,0),"^",2)
66 I 'ECDFN0 K ECDFN0 Q
67 K ^ECH("APAT",ECDFN0,X,DA),ECDFN0
68 Q
69KADT ; kill 'ADT' x-ref from .01 field in file 721
70 S ECH(0)=^ECH(DA,0),ECULOC=+$P(ECH(0),"^",4),ECDFN0=+$P(ECH(0),"^",2),ECUUNIT=+$P(ECH(0),"^",7),ECUDATE=+$P(ECH(0),"^",3)
71 I 'ECDFN0!('ECULOC)!('ECUDATE)!('ECUUNIT) K ECDFN0,ECULOC,ECUDATE,ECUUNIT Q
72 K ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,ECUDATE,DA),ECULOC,ECDFN0,ECUUNIT,ECUDATE,ECH
73 Q
74KLOC ; kill 'LOC' x-ref
75 Q
76 ;
77SAC ;ALB/ESD - Set logic for .01 field of file #720.5
78 I '$G(ECSPTR) K ECSPTR Q
79 S ^ECL("AC",+X,+$G(ECSPTR),DA)=""
80 Q
81 ;
82KAC ;ALB/ESD - Kill logic for .01 field of file #720.5
83 I '$G(ECSPTR) K ECSPTR Q
84 K ^ECL("AC",+X,+$G(ECSPTR),DA)
85 Q
Note: See TracBrowser for help on using the repository browser.