DENTXREF ;WASH-ISC/JAH- X-refs. for files 226 and 221 13:56 ;
;;1.2;DENTAL;**19**;JAN 26, 1989
STATSET(STAT) ;Set logic 4 xref on field .3,station.division,file 226,A1 index
;In the case when station.division field is being modified xrefs on
;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
;need 2 b updated, since part of the key 2 both of those
;xrefs is the station.division field.
N DATE,PROV,REL
S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
S PROV=$P($G(^DENT(226,DA,0)),U,3) ; provider #
S REL=$P($G(^DENT(226,DA,.1)),U,1) ; released by
I DATE'="" D
.S ^DENT(226,"A1",STAT,DATE,DA)=""
.; A xref is set if the data has NOT been released
.S:$S('$D(^DENT(226,DA,.1)):1,$P(^(.1),"^",1)="":1,1:0) ^DENT(226,"A",STAT,DATE,DA)=""
I (DATE'="")&(PROV'="") S ^DENT(226,"AC",STAT,DATE,PROV,DA)=""
K STAT
Q
STATKIL(STAT) ;kill logic 4 xref on field stat.div,file 226
;In the case when station.division field is being modified xrefs on
;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
;need 2 b updated, since part of the key 2 both of those xrefs is
;the station.division field.
N DATE,PROV,REL
S DATE=$P($P($G(^DENT(226,DA,0)),U,1),".",1)
S PROV=$P($G(^DENT(226,DA,0)),U,3)
S REL=$P($G(^DENT(226,DA,.1)),U,1)
I DATE'="" D
.K ^DENT(226,"A1",STAT,DATE,DA)
.K ^DENT(226,"A",STAT,DATE,DA) ;data has been released xref
I (DATE'="")&(PROV'="") K ^DENT(226,"AC",STAT,DATE,PROV,DA)
K STAT
Q
STASETT(STAT) ;Set logic 4 xref on field .3,station.division,Treatment file 221
;In the case when station.division field is being modified xrefs on
;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
;need 2 b updated, since part of the key 2 both of those
;xrefs is the station.division field.
;X holds station.division
N DATE,PROV,REL
S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
S PROV=$P($G(^DENT(221,DA,0)),U,10) ; provider #
S REL=$P($G(^DENT(221,DA,.1)),U,1) ; released by
S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ; released date
;
I DATE'="" D
.;update xref on station field
.S ^DENT(221,"A1",STAT,DATE,DA)=""
.S:$S(REL="":1,1:0) ^DENT(221,"A",STAT,DATE,DA)="" ;data NOT released
;
I (DATE'="")&(PROV'="") D
.;update xref on provider # field
.S ^DENT(221,"AC1",STAT,DATE,PROV,DA)=""
.S:$S(REL="":1,1:0) ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
;
;update xref on Date Released field
I RELDT'="" S ^DENT(221,"AG",STAT,RELDT,DA)=""
K STAT
Q
STAKILT(STAT) ;kill logic 4 xref on field stat.div,Treatment file 221
;In the case when station.division field is being modified xrefs on
;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
;need 2 b updated, since part of the key 2 both of those xrefs is
;the station.division field.
N DATE,PROV,REL
S DATE=$P($P($G(^DENT(221,DA,0)),U,1),".",1)
S PROV=$P($G(^DENT(221,DA,0)),U,10) ; provider #
S REL=$P($G(^DENT(221,DA,.1)),U,1) ; released by
S RELDT=$P($G(^DENT(221,DA,.1)),U,2) ; released date
I DATE'="" D
.;update xref on station field
.K ^DENT(221,"A1",STAT,DATE,DA)
.K ^DENT(221,"A",STAT,DATE,DA)
;
I (DATE'="")&(PROV'="") D
.;update xref on provider # field and released by field
.K ^DENT(221,"AC1",STAT,DATE,PROV,DA)
.K ^DENT(221,"AC",STAT,DATE,PROV,DA)
.;update xref on released by field
.;S ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
;update xref on Date Released field
I RELDT'="" K ^DENT(221,"AG",STAT,RELDT,DA)
K STAT
Q
ASET ;Code to set "A" cross ref in file 221
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)
Q
AKILL ;Code called by kill "A" cross reference of file 221
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)=""
Q
AC1SET ;AC1 x-ref for field .4 in 221
I $P(^DENT(221,DA,0),"^",1)'="" D
.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)=""
Q
AC1KILL ;AC1 x-ref for field .4 in 221
I $P(^DENT(221,DA,0),"^",1)'="" D
.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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTXREF 4699 printed Dec 13, 2024@01:46:52 Page 2
DENTXREF ;WASH-ISC/JAH- X-refs. for files 226 and 221 13:56 ;
+1 ;;1.2;DENTAL;**19**;JAN 26, 1989
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
+2 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
+3 ;need 2 b updated, since part of the key 2 both of those
+4 ;xrefs is the station.division field.
+5 NEW DATE,PROV,REL
+6 SET DATE=$PIECE($PIECE($GET(^DENT(226,DA,0)),U,1),".",1)
+7 ; provider #
SET PROV=$PIECE($GET(^DENT(226,DA,0)),U,3)
+8 ; released by
SET REL=$PIECE($GET(^DENT(226,DA,.1)),U,1)
+9 IF DATE'=""
Begin DoDot:1
+10 SET ^DENT(226,"A1",STAT,DATE,DA)=""
+11 ; A xref is set if the data has NOT been released
+12 if $SELECT('$DATA(^DENT(226,DA,.1))
SET ^DENT(226,"A",STAT,DATE,DA)=""
End DoDot:1
+13 IF (DATE'="")&(PROV'="")
SET ^DENT(226,"AC",STAT,DATE,PROV,DA)=""
+14 KILL STAT
+15 QUIT
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
+2 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
+3 ;need 2 b updated, since part of the key 2 both of those xrefs is
+4 ;the station.division field.
+5 NEW DATE,PROV,REL
+6 SET DATE=$PIECE($PIECE($GET(^DENT(226,DA,0)),U,1),".",1)
+7 SET PROV=$PIECE($GET(^DENT(226,DA,0)),U,3)
+8 SET REL=$PIECE($GET(^DENT(226,DA,.1)),U,1)
+9 IF DATE'=""
Begin DoDot:1
+10 KILL ^DENT(226,"A1",STAT,DATE,DA)
+11 ;data has been released xref
KILL ^DENT(226,"A",STAT,DATE,DA)
End DoDot:1
+12 IF (DATE'="")&(PROV'="")
KILL ^DENT(226,"AC",STAT,DATE,PROV,DA)
+13 KILL STAT
+14 QUIT
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
+2 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
+3 ;need 2 b updated, since part of the key 2 both of those
+4 ;xrefs is the station.division field.
+5 ;X holds station.division
+6 NEW DATE,PROV,REL
+7 SET DATE=$PIECE($PIECE($GET(^DENT(221,DA,0)),U,1),".",1)
+8 ; provider #
SET PROV=$PIECE($GET(^DENT(221,DA,0)),U,10)
+9 ; released by
SET REL=$PIECE($GET(^DENT(221,DA,.1)),U,1)
+10 ; released date
SET RELDT=$PIECE($GET(^DENT(221,DA,.1)),U,2)
+11 ;
+12 IF DATE'=""
Begin DoDot:1
+13 ;update xref on station field
+14 SET ^DENT(221,"A1",STAT,DATE,DA)=""
+15 ;data NOT released
if $SELECT(REL=""
SET ^DENT(221,"A",STAT,DATE,DA)=""
End DoDot:1
+16 ;
+17 IF (DATE'="")&(PROV'="")
Begin DoDot:1
+18 ;update xref on provider # field
+19 SET ^DENT(221,"AC1",STAT,DATE,PROV,DA)=""
+20 if $SELECT(REL=""
SET ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
End DoDot:1
+21 ;
+22 ;update xref on Date Released field
+23 IF RELDT'=""
SET ^DENT(221,"AG",STAT,RELDT,DA)=""
+24 KILL STAT
+25 QUIT
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
+2 ;fields 60 (released by) and .4 (provider #) (A and AC xrefs),
+3 ;need 2 b updated, since part of the key 2 both of those xrefs is
+4 ;the station.division field.
+5 NEW DATE,PROV,REL
+6 SET DATE=$PIECE($PIECE($GET(^DENT(221,DA,0)),U,1),".",1)
+7 ; provider #
SET PROV=$PIECE($GET(^DENT(221,DA,0)),U,10)
+8 ; released by
SET REL=$PIECE($GET(^DENT(221,DA,.1)),U,1)
+9 ; released date
SET RELDT=$PIECE($GET(^DENT(221,DA,.1)),U,2)
+10 IF DATE'=""
Begin DoDot:1
+11 ;update xref on station field
+12 KILL ^DENT(221,"A1",STAT,DATE,DA)
+13 KILL ^DENT(221,"A",STAT,DATE,DA)
End DoDot:1
+14 ;
+15 IF (DATE'="")&(PROV'="")
Begin DoDot:1
+16 ;update xref on provider # field and released by field
+17 KILL ^DENT(221,"AC1",STAT,DATE,PROV,DA)
+18 KILL ^DENT(221,"AC",STAT,DATE,PROV,DA)
+19 ;update xref on released by field
+20 ;S ^DENT(221,"AC",STAT,DATE,PROV,DA)=""
End DoDot:1
+21 ;update xref on Date Released field
+22 IF RELDT'=""
KILL ^DENT(221,"AG",STAT,RELDT,DA)
+23 KILL STAT
+24 QUIT
ASET ;Code to set "A" cross ref in file 221
+1 KILL ^DENT(221,"A",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),DA)
if $PIECE(^DENT(221,DA,0),"^",10)]""
KILL ^DENT(221,"AC",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),$PIECE(^DENT(221,DA,0),"^",10),DA)
+2 QUIT
AKILL ;Code called by kill "A" cross reference of file 221
+1 SET ^DENT(221,"A",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),DA)=""
if $PIECE(^DENT(221,DA,0),"^",10)]""
SET ^DENT(221,"AC",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),$PIECE(^DENT(221,DA,0),"^",10),DA)=""
+2 QUIT
AC1SET ;AC1 x-ref for field .4 in 221
+1 IF $PIECE(^DENT(221,DA,0),"^",1)'=""
Begin DoDot:1
+2 SET ^DENT(221,"AC1",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),X,DA)=""
if $SELECT('$DATA(^DENT(221,DA,.1))
SET ^DENT(221,"AC",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),X,DA)=""
End DoDot:1
+3 QUIT
AC1KILL ;AC1 x-ref for field .4 in 221
+1 IF $PIECE(^DENT(221,DA,0),"^",1)'=""
Begin DoDot:1
+2 KILL ^DENT(221,"AC1",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),X,DA)
if $SELECT('$DATA(^DENT(221,DA,.1))
KILL ^DENT(221,"AC",$PIECE(^DENT(221,DA,0),"^",40),$PIECE($PIECE(^DENT(221,DA,0),"^"),"."),X,DA)
End DoDot:1
+3 QUIT
