Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DENTXREF

DENTXREF.m

Go to the documentation of this file. 
  1. DENTXREF ;WASH-ISC/JAH- X-refs. for files 226 and 221  13:56 ;
  1.  ;;1.2;DENTAL;**19**;JAN 26, 1989
  1. STATSET(STAT) ;Set logic 4 xref on field .3,station.division,file 226,A1 index
  1.  ;In the case when station.division field is being modified xrefs on 
  1.  ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
  1.  ;need 2 b updated, since part of the key 2 both of those 
  1.  ;xrefs is the station.division field.
  1.  N DATE,PROV,REL
  1.  S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
  1.  S PROV=$P($G(^DENT(226,DA,0)),U,3) ;           provider #
  1.  S REL=$P($G(^DENT(226,DA,.1)),U,1) ;           released by
  1.  I DATE'="" D
  1.  .S ^DENT(226,"A1",STAT,DATE,DA)=""
  1.  .; A xref is set if the data has NOT been released
  1.  .S:$S('$D(^DENT(226,DA,.1)):1,$P(^(.1),"^",1)="":1,1:0) ^DENT(226,"A",STAT,DATE,DA)=""
  1.  I (DATE'="")&(PROV'="") S ^DENT(226,"AC",STAT,DATE,PROV,DA)=""
  1.  K STAT
  1.  Q
  1. STATKIL(STAT) ;kill logic 4 xref on field stat.div,file 226
  1.  ;In the case when station.division field is being modified xrefs on 
  1.  ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
  1.  ;need 2 b updated, since part of the key 2 both of those xrefs is 
  1.  ;the station.division field.
  1.  N DATE,PROV,REL
  1.  S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
  1.  S PROV=$P($G(^DENT(226,DA,0)),U,3)
  1.  S REL=$P($G(^DENT(226,DA,.1)),U,1)
  1.  I DATE'="" D
  1.  .K ^DENT(226,"A1",STAT,DATE,DA)
  1.  .K ^DENT(226,"A",STAT,DATE,DA) ;data has been released xref
  1.  I (DATE'="")&(PROV'="") K ^DENT(226,"AC",STAT,DATE,PROV,DA)
  1.  K STAT
  1.  Q
  1. STASETT(STAT) ;Set logic 4 xref on field .3,station.division,Treatment file 221
  1.  ;In the case when station.division field is being modified xrefs on 
  1.  ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
  1.  ;need 2 b updated, since part of the key 2 both of those 
  1.  ;xrefs is the station.division field.
  1.  ;X holds station.division
  1.  N DATE,PROV,REL
  1.  S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
  1.  S PROV=$P($G(^DENT(221,DA,0)),U,10) ;          provider #
  1.  S REL=$P($G(^DENT(221,DA,.1)),U,1) ;           released by
  1.  S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ;         released date
  1.  ;
  1.  I DATE'="" D
  1.  .;update xref on station field
  1.  .S ^DENT(221,"A1",STAT,DATE,DA)=""
  1.  .S:$S(REL="":1,1:0) ^DENT(221,"A",STAT,DATE,DA)="" ;data NOT released
  1.  ;
  1.  I (DATE'="")&(PROV'="") D
  1.  .;update xref on provider # field
  1.  .S ^DENT(221,"AC1",STAT,DATE,PROV,DA)=""
  1.  .S:$S(REL="":1,1:0) ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
  1.  ;
  1.  ;update xref on Date Released field
  1.  I RELDT'="" S ^DENT(221,"AG",STAT,RELDT,DA)=""
  1.  K STAT
  1.  Q
  1. STAKILT(STAT) ;kill logic 4 xref on field stat.div,Treatment file 221
  1.  ;In the case when station.division field is being modified xrefs on 
  1.  ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
  1.  ;need 2 b updated, since part of the key 2 both of those xrefs is 
  1.  ;the station.division field.
  1.  N DATE,PROV,REL
  1.  S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
  1.  S PROV=$P($G(^DENT(221,DA,0)),U,10) ;          provider #
  1.  S REL=$P($G(^DENT(221,DA,.1)),U,1) ;           released by
  1.  S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ;         released date
  1.  I DATE'="" D
  1.  .;update xref on station field
  1.  .K ^DENT(221,"A1",STAT,DATE,DA)
  1.  .K ^DENT(221,"A",STAT,DATE,DA)
  1.  ;
  1.  I (DATE'="")&(PROV'="") D
  1.  .;update xref on provider # field and released by field
  1.  .K ^DENT(221,"AC1",STAT,DATE,PROV,DA)
  1.  .K ^DENT(221,"AC",STAT,DATE,PROV,DA)
  1.  .;update xref on released by field
  1.  .;S ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
  1.  ;update xref on Date Released field
  1.  I RELDT'="" K ^DENT(221,"AG",STAT,RELDT,DA)
  1.  K STAT
  1.  Q
  1. ASET ;Code to set "A" cross ref in file 221
  1.  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)
  1.  Q
  1. AKILL ;Code called by kill "A" cross reference of file 221
  1.  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)=""
  1.  Q
  1. AC1SET ;AC1 x-ref for field .4 in 221
  1.  I $P(^DENT(221,DA,0),"^",1)'="" D
  1.  .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)=""
  1.  Q
  1. AC1KILL ;AC1 x-ref for field .4 in 221
  1.  I $P(^DENT(221,DA,0),"^",1)'="" D
  1.  .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)
  1.  Q