XUA4A73.m

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 ---XUA4A73   607     printed  Apr 09, 2024@21:11:24                                                                                                                                                                                                      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)