XUPSPRA.m

XUPSPRA ;ALB/CMC - Build PRA segment;Aug 6, 2010

 ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 5

EN(XUPSIEN,XUPSSTR,HL) ;

 ;XUPSIEN - New Person Internal Entry Number

 ;XUPSSTR - sequence numbers which should be used, only field 6 for DEA# at this point used

 ;HL - hl7 array variables

 ;RETURN:  PRA segment returned or -1^error message

 ;

 N XUPSREC,NUM

 I XUPSIEN=""!(XUPSSTR="")!('$D(HL)) S XUPSREC="-1^Missing Parameters" G QUIT ;missing parameter

 S $P(XUPSREC,HL("FS"),1)="PRA" ;sequence 1 set to segment type

 ;DEA# FIELD 6

 S NUM=$P($G(^VA(200,XUPSIEN,"PS")),"^",2)

 I NUM="" S NUM=HL("Q")

 S $P(XUPSREC,HL("FS"),7)=NUM

QUIT Q XUPSREC

XUPSPRA   ;ALB/CMC - Build PRA segment;Aug 6, 2010

 +1       ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 5

EN(XUPSIEN,XUPSSTR,HL) ;

 +1       ;XUPSIEN - New Person Internal Entry Number

 +2       ;XUPSSTR - sequence numbers which should be used, only field 6 for DEA# at this point used

 +3       ;HL - hl7 array variables

 +4       ;RETURN:  PRA segment returned or -1^error message

 +5       ;

 +6        NEW XUPSREC,NUM

 +7       ;missing parameter

           IF XUPSIEN=""!(XUPSSTR="")!('$DATA(HL))

               SET XUPSREC="-1^Missing Parameters"

               GOTO QUIT

 +8       ;sequence 1 set to segment type

           SET $PIECE(XUPSREC,HL("FS"),1)="PRA"

 +9       ;DEA# FIELD 6

 +10       SET NUM=$PIECE($GET(^VA(200,XUPSIEN,"PS")),"^",2)

 +11       IF NUM=""

               SET NUM=HL("Q")

 +12       SET $PIECE(XUPSREC,HL("FS"),7)=NUM

QUIT       QUIT XUPSREC