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

ECDUTL.m

Go to the documentation of this file.
ECDUTL ;BIR/MAM,JPW-DSS M Cross References ;30 Apr 96
 ;;2.0; EVENT CAPTURE ;**4,5**;8 May 96
ADT ; set 'ADT' x-ref on PROCEDURE DATE/TIME field in file 721
 S ECULOC=+$P(^ECH(DA,0),"^",4),ECDFN0=+$P(^(0),"^",2),ECUUNIT=+$P(^(0),"^",7)
 I 'ECULOC!('ECDFN0)!('ECUUNIT) K ECULOC,ECDFN0,ECUUNIT Q
 S ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,X,DA)=""
 ;S ^ECH("APAT",ECDFN0,X,DA)=""
 K ECULOC,ECUUNIT,ECDFN0
 Q
KILLADT ; kill 'ADT' x-ref on PROCEDURE DATE/TIME field in file 721
 S ECULOC=+$P(^ECH(DA,0),"^",4),ECDFN0=+$P(^(0),"^",2),ECUUNIT=+$P(^(0),"^",7)
 I 'ECULOC!('ECDFN0)!('ECUUNIT) K ECULOC,ECDFN0,ECUUNIT Q
 K ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,X,DA)
 ;K ^ECH("APAT",ECDFN0,X,DA),ECULOC,ECUUNIT,ECDFN0
 K ECULOC,ECUUNIT,ECDFN0
 Q
ADTL ; set "ADT" x-ref on LOCATION field in File 721
 S ECDFN0=+$P(^ECH(DA,0),"^",2),ECUDATE=+$P(^(0),"^",3),ECUUNIT=+$P(^(0),"^",7)
 I 'ECDFN0!('ECUDATE)!('ECUUNIT) K ECDFN0,ECUDATE,ECUUNIT Q
 S ^ECH("ADT",X,ECDFN0,ECUUNIT,ECUDATE,DA)=""
 K ECDFN0,ECUDATE,ECUUNIT
 Q
KADTL ; kill "ADT" x-ref on LOCATION field in File 721
 S ECDFN0=+$P(^ECH(DA,0),"^",2),ECUDATE=+$P(^(0),"^",3),ECUUNIT=+$P(^(0),"^",7)
 I 'ECDFN0!('ECUDATE)!('ECUUNIT) K ECDFN0,ECUDATE,ECUUNIT Q
 K ^ECH("ADT",X,ECDFN0,ECUUNIT,ECUDATE,DA),ECDFN0,ECUDATE,ECUUNIT
 Q
ADTP ;set "ADT" x-ref on PATIENT field in File 721
 S ECUDATE=+$P(^ECH(DA,0),"^",3),ECULOC=+$P(^(0),"^",4),ECUUNIT=+$P(^(0),"^",7)
 I 'ECUDATE!('ECULOC)!('ECUUNIT) K ECUDATE,ECUUNIT,ECULOC Q
 S ^ECH("ADT",ECULOC,X,ECUUNIT,ECUDATE,DA)=""
 K ECULOC,ECUDATE,ECUUNIT
 Q
KADTP ; kill "ADT" x-ref on PATIENT field in File 721
 S ECUDATE=+$P(^ECH(DA,0),"^",3),ECULOC=+$P(^(0),"^",4),ECUUNIT=+$P(^(0),"^",7)
 K ^ECH("ADT",ECULOC,X,ECUUNIT,ECUDATE,DA),ECULOC,ECUDATE,ECUUNIT
 Q
ADTU ; sets "ADT" x-ref on DSS UNIT field in File 721
 S ECULOC=+$P(^ECH(DA,0),"^",4),ECUDATE=+$P(^(0),"^",3),ECDFN0=+$P(^(0),"^",2)
 I 'ECULOC!('ECUDATE)!('ECDFN0) K ECULOC,ECUDATE,ECDFN0 Q
 S ^ECH("ADT",ECULOC,ECDFN0,X,ECUDATE,DA)=""
 K ECULOC,ECDFN0,ECUDATE
 Q
KADTU ; kills "ADT" x-ref on DSS UNIT field in File 721
 S ECULOC=+$P(^ECH(DA,0),"^",4),ECUDATE=+$P(^(0),"^",3),ECDFN0=+$P(^(0),"^",2)
 I 'ECULOC!('ECUDATE)!('ECDFN0) K ECULOC,ECUDATE,ECDFN0 Q
 K ^ECH("ADT",ECULOC,ECDFN0,X,ECUDATE,DA),ECULOC,ECDFN0,ECUDATE
 Q
APAT ; set "APAT" x-ref on PATIENT field in File 721
 S ECUDATE=+$P(^ECH(DA,0),"^",3)
 I 'ECUDATE K ECUDATE Q
 S ^ECH("APAT",X,ECUDATE,DA)="" K ECUDATE
 Q
KAPAT ; kill "APAT" x-ref on PATIENT field in File 721
 S ECUDATE=+$P(^ECH(DA,0),"^",3)
 I 'ECUDATE K ECUDATE Q
 K ^ECH("APAT",X,ECUDATE,DA),ECUDATE
 Q
APAT1 ; set "APAT" x-ref on the PROCEDURE DATE/TIME field in File 721
 S ECDFN0=+$P(^ECH(DA,0),"^",2)
 I 'ECDFN0 K ECDFN0 Q
 S ^ECH("APAT",ECDFN0,X,DA)="" K ECDFN0
 Q
KAPAT1 ; kill "APAT" x-ref on the PROCEDURE DATE/TIME field in File 721
 S ECDFN0=+$P(^ECH(DA,0),"^",2)
 I 'ECDFN0 K ECDFN0 Q
 K ^ECH("APAT",ECDFN0,X,DA),ECDFN0
 Q
KADT ; kill 'ADT' x-ref from .01 field in file 721
 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)
 I 'ECDFN0!('ECULOC)!('ECUDATE)!('ECUUNIT) K ECDFN0,ECULOC,ECUDATE,ECUUNIT Q
 K ^ECH("ADT",ECULOC,ECDFN0,ECUUNIT,ECUDATE,DA),ECULOC,ECDFN0,ECUUNIT,ECUDATE,ECH
 Q
KLOC ; kill 'LOC' x-ref
 Q
 ;
SAC ;ALB/ESD - Set logic for .01 field of file #720.5
 I '$G(ECSPTR) K ECSPTR Q
 S ^ECL("AC",+X,+$G(ECSPTR),DA)=""
 Q
 ;
KAC ;ALB/ESD - Kill logic for .01 field of file #720.5
 I '$G(ECSPTR) K ECSPTR Q
 K ^ECL("AC",+X,+$G(ECSPTR),DA)
 Q