XUA4A73 ;BP-OAK/BDT - Person Class Input Transform;2/13/07
;;8.0;KERNEL;**450**;Jul 10, 1995;Build 4
Q
ENT(DA,X) ;
N XUA,XUIEN,XUEFFDT
S XUA=$G(^VA(200,DA(1),"USC1",DA,0)) ;get information
S XUIEN=$P(XUA,"^"),XUEFFDT=$P(XUA,"^",2)
N XUB,XUSTAT,XUDATE
S XUB=$$PSC(XUIEN) ;get status from Person Class file.
S XUSTAT=$P(XUB,"^"),XUDATE=$P(XUB,"^",2)
I XUEFFDT>X Q ""
I XUSTAT="i",X>XUDATE Q ""
Q 1
;
PSC(XUIEN) ; Get Status and Expiration Date for Person Class XUIEN
I +XUIEN'=XUIEN Q "^"
I +XUIEN'>0 Q "^"
N XUDATA
S XUDATA=$G(^USC(8932.1,XUIEN,0))
Q $P(XUDATA,"^",4,5)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUA4A73 607 printed Nov 22, 2024@17:19:06 Page 2
XUA4A73 ;BP-OAK/BDT - Person Class Input Transform;2/13/07
+1 ;;8.0;KERNEL;**450**;Jul 10, 1995;Build 4
+2 QUIT
ENT(DA,X) ;
+1 NEW XUA,XUIEN,XUEFFDT
+2 ;get information
SET XUA=$GET(^VA(200,DA(1),"USC1",DA,0))
+3 SET XUIEN=$PIECE(XUA,"^")
SET XUEFFDT=$PIECE(XUA,"^",2)
+4 NEW XUB,XUSTAT,XUDATE
+5 ;get status from Person Class file.
SET XUB=$$PSC(XUIEN)
+6 SET XUSTAT=$PIECE(XUB,"^")
SET XUDATE=$PIECE(XUB,"^",2)
+7 IF XUEFFDT>X
QUIT ""
+8 IF XUSTAT="i"
IF X>XUDATE
QUIT ""
+9 QUIT 1
+10 ;
PSC(XUIEN) ; Get Status and Expiration Date for Person Class XUIEN
+1 IF +XUIEN'=XUIEN
QUIT "^"
+2 IF +XUIEN'>0
QUIT "^"
+3 NEW XUDATA
+4 SET XUDATA=$GET(^USC(8932.1,XUIEN,0))
+5 QUIT $PIECE(XUDATA,"^",4,5)
