source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTXREF.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1DENTXREF ;WASH-ISC/JAH- X-refs. for files 226 and 221 13:56 ;
2 ;;1.2;DENTAL;**19**;JAN 26, 1989
3STATSET(STAT) ;Set logic 4 xref on field .3,station.division,file 226,A1 index
4 ;In the case when station.division field is being modified xrefs on
5 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
6 ;need 2 b updated, since part of the key 2 both of those
7 ;xrefs is the station.division field.
8 N DATE,PROV,REL
9 S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
10 S PROV=$P($G(^DENT(226,DA,0)),U,3) ; provider #
11 S REL=$P($G(^DENT(226,DA,.1)),U,1) ; released by
12 I DATE'="" D
13 .S ^DENT(226,"A1",STAT,DATE,DA)=""
14 .; A xref is set if the data has NOT been released
15 .S:$S('$D(^DENT(226,DA,.1)):1,$P(^(.1),"^",1)="":1,1:0) ^DENT(226,"A",STAT,DATE,DA)=""
16 I (DATE'="")&(PROV'="") S ^DENT(226,"AC",STAT,DATE,PROV,DA)=""
17 K STAT
18 Q
19STATKIL(STAT) ;kill logic 4 xref on field stat.div,file 226
20 ;In the case when station.division field is being modified xrefs on
21 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
22 ;need 2 b updated, since part of the key 2 both of those xrefs is
23 ;the station.division field.
24 N DATE,PROV,REL
25 S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
26 S PROV=$P($G(^DENT(226,DA,0)),U,3)
27 S REL=$P($G(^DENT(226,DA,.1)),U,1)
28 I DATE'="" D
29 .K ^DENT(226,"A1",STAT,DATE,DA)
30 .K ^DENT(226,"A",STAT,DATE,DA) ;data has been released xref
31 I (DATE'="")&(PROV'="") K ^DENT(226,"AC",STAT,DATE,PROV,DA)
32 K STAT
33 Q
34STASETT(STAT) ;Set logic 4 xref on field .3,station.division,Treatment file 221
35 ;In the case when station.division field is being modified xrefs on
36 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
37 ;need 2 b updated, since part of the key 2 both of those
38 ;xrefs is the station.division field.
39 ;X holds station.division
40 N DATE,PROV,REL
41 S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
42 S PROV=$P($G(^DENT(221,DA,0)),U,10) ; provider #
43 S REL=$P($G(^DENT(221,DA,.1)),U,1) ; released by
44 S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ; released date
45 ;
46 I DATE'="" D
47 .;update xref on station field
48 .S ^DENT(221,"A1",STAT,DATE,DA)=""
49 .S:$S(REL="":1,1:0) ^DENT(221,"A",STAT,DATE,DA)="" ;data NOT released
50 ;
51 I (DATE'="")&(PROV'="") D
52 .;update xref on provider # field
53 .S ^DENT(221,"AC1",STAT,DATE,PROV,DA)=""
54 .S:$S(REL="":1,1:0) ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
55 ;
56 ;update xref on Date Released field
57 I RELDT'="" S ^DENT(221,"AG",STAT,RELDT,DA)=""
58 K STAT
59 Q
60STAKILT(STAT) ;kill logic 4 xref on field stat.div,Treatment file 221
61 ;In the case when station.division field is being modified xrefs on
62 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
63 ;need 2 b updated, since part of the key 2 both of those xrefs is
64 ;the station.division field.
65 N DATE,PROV,REL
66 S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
67 S PROV=$P($G(^DENT(221,DA,0)),U,10) ; provider #
68 S REL=$P($G(^DENT(221,DA,.1)),U,1) ; released by
69 S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ; released date
70 I DATE'="" D
71 .;update xref on station field
72 .K ^DENT(221,"A1",STAT,DATE,DA)
73 .K ^DENT(221,"A",STAT,DATE,DA)
74 ;
75 I (DATE'="")&(PROV'="") D
76 .;update xref on provider # field and released by field
77 .K ^DENT(221,"AC1",STAT,DATE,PROV,DA)
78 .K ^DENT(221,"AC",STAT,DATE,PROV,DA)
79 .;update xref on released by field
80 .;S ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
81 ;update xref on Date Released field
82 I RELDT'="" K ^DENT(221,"AG",STAT,RELDT,DA)
83 K STAT
84 Q
85ASET ;Code to set "A" cross ref in file 221
86 K ^DENT(221,"A",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),DA) K:$P(^DENT(221,DA,0),"^",10)]"" ^DENT(221,"AC",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),$P(^DENT(221,DA,0),"^",10),DA)
87 Q
88AKILL ;Code called by kill "A" cross reference of file 221
89 S ^DENT(221,"A",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),DA)="" S:$P(^DENT(221,DA,0),"^",10)]"" ^DENT(221,"AC",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),$P(^DENT(221,DA,0),"^",10),DA)=""
90 Q
91AC1SET ;AC1 x-ref for field .4 in 221
92 I $P(^DENT(221,DA,0),"^",1)'="" D
93 .S ^DENT(221,"AC1",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),X,DA)="" S:$S('$D(^DENT(221,DA,.1)):1,$P(^(.1),"^")="":1,1:0) ^DENT(221,"AC",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),X,DA)=""
94 Q
95AC1KILL ;AC1 x-ref for field .4 in 221
96 I $P(^DENT(221,DA,0),"^",1)'="" D
97 .K ^DENT(221,"AC1",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),X,DA) K:$S('$D(^DENT(221,DA,.1)):1,$P(^(.1),"^")="":1,1:0) ^DENT(221,"AC",$P(^DENT(221,DA,0),"^",40),$P($P(^DENT(221,DA,0),"^"),"."),X,DA)
98 Q
Note: See TracBrowser for help on using the repository browser.