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

PRSD450.m

Go to the documentation of this file.
PRSD450 ;HISC/GWB-UPDATE 450 POINTER ON SSN CHANGE ;4/25/95  09:47
 ;;4.0;PAID;;Sep 21, 1995
SET450 ;Set PAID EMPLOYEE NEW PERSON field and NEW PERSON PAID EMPLOYEE field
 ;when NEW PERSON SSN field is set
 I $D(^PRSPC("SSN",X)) S IEN450=$O(^PRSPC("SSN",X,0)),$P(^PRSPC(IEN450,200),"^",1)=DA,$P(^VA(200,DA,450),"^",1)=IEN450 K IEN450
 Q
KILL450 ;Kill PAID EMPLOYEE NEW PERSON field and NEW PERSON PAID EMPLOYEE field
 ;when NEW PERSON SSN field is killed
 I $D(^PRSPC("SSN",X)) S IEN450=$O(^PRSPC("SSN",X,0)),$P(^PRSPC(IEN450,200),"^",1)="",$P(^VA(200,DA,450),"^",1)="" K IEN450
 Q
SET200 ;Set PAID EMPLOYEE NEW PERSON field and NEW PERSON PAID EMPLOYEE field
 ;when PAID EMPLOYEE SSN field is set
 I $D(^VA(200,"SSN",X)) S IEN200=$O(^VA(200,"SSN",X,0)),$P(^VA(200,IEN200,450),"^",1)=DA,$P(^PRSPC(DA,200),"^",1)=IEN200 K IEN200
 Q
KILL200 ;Kill PAID EMPLOYEE NEW PERSON field and NEW PERSON PAID EMPLOYEE field
 ;when PAID EMPLOYEE SSN field is killed
 I $D(^VA(200,"SSN",X)) S IEN200=$O(^VA(200,"SSN",X,0)),$P(^VA(200,IEN200,450),"^",1)="",$P(^PRSPC(DA,200),"^",1)="" K IEN200
 Q