VAFHLNK1.m

VAFHLNK1 ;ALB/GRR - HL7 NK1 SEGMENT BUILDER ;06/08/99

 ;;5.3;Registration;**190**;Aug 13, 1993

 ;

 ;This routine will build an HL7 NK1 segment for an inpatient.

 ;

EN(DFN,VAFHMIEN,VAFSTR) ;Entry point of routine

 ;DFN - Patient Internal Entry Number

 ;VAFHMIEN - Patient Movement Internal Entry Number

 ;VAFHSTR - Sequence numbers to be included

 ;

 N VAFHLREC,VAFHA,VAFHSUB,VAFHADD,VAFHLOC,VAFHREL,VAFHNAME S VAFHSUB=""

 Q:$$GET1^DIQ(2,DFN,".211","I")="" ""

 S $P(VAFHLREC,HL("FS"))="NK1"

 S $P(VAFHLREC,HL("FS"),2)=1 ;THE SET ID FOR NK1

 I VAFSTR[",2," S VAFHNAME=$$HLNAME^DGRUUTL($$GET1^DIQ(2,DFN,".211","E")),$P(VAFHLREC,HL("FS"),3)=$TR(VAFHNAME,"^",$E(HL("ECH"))) ;NEXT OF KIN NAME IN HL7 FORMAT

 I VAFSTR[",3," S VAFHREL=$$RELATE^DGRUUTL($$GET1^DIQ(2,DFN,".212","E")),$P(VAFHLREC,HL("FS"),4)=$P(VAFHREL,"^")_$E(HL("ECH"))_$P(VAFHREL,"^",2) ;NEXT OF KIN RELATIONSHIP

 I VAFSTR[",4," D

 .S VAFHADD=$$GET1^DIQ(2,DFN,".213","E")_"^"_$$GET1^DIQ(2,DFN,".214","E")_"^"_$$GET1^DIQ(2,DFN,".215","E") ;NEXT OF KIN STREET ADDRESS'S

 .S VAFHLOC=$$GET1^DIQ(2,DFN,".216","E")_"^"_$$GET1^DIQ(2,DFN,".217","I")_"^"_$$GET1^DIQ(2,DFN,".218","E") ;NEXT OF KIN CITY, STATE, AND ZIP

 .S $P(VAFHLREC,HL("FS"),5)=$$HLADDR^HLFNC(VAFHADD,VAFHLOC) ;CONVERT TO HL7 FORMAT

 I VAFSTR[",5," S $P(VAFHLREC,HL("FS"),6)=$$HLPHONE^HLFNC($$GET1^DIQ(2,DFN,".219","E")) ;NEXT OF KIN HOME PHONE IN HL7 FORMAT

QUITNK1 Q VAFHLREC

VAFHLNK1  ;ALB/GRR - HL7 NK1 SEGMENT BUILDER ;06/08/99

 +1       ;;5.3;Registration;**190**;Aug 13, 1993

 +2       ;

 +3       ;This routine will build an HL7 NK1 segment for an inpatient.

 +4       ;

EN(DFN,VAFHMIEN,VAFSTR) ;Entry point of routine

 +1       ;DFN - Patient Internal Entry Number

 +2       ;VAFHMIEN - Patient Movement Internal Entry Number

 +3       ;VAFHSTR - Sequence numbers to be included

 +4       ;

 +5        NEW VAFHLREC,VAFHA,VAFHSUB,VAFHADD,VAFHLOC,VAFHREL,VAFHNAME

           SET VAFHSUB=""

 +6        IF $$GET1^DIQ(2,DFN,".211","I")=""

               QUIT ""

 +7        SET $PIECE(VAFHLREC,HL("FS"))="NK1"

 +8       ;THE SET ID FOR NK1

           SET $PIECE(VAFHLREC,HL("FS"),2)=1

 +9       ;NEXT OF KIN NAME IN HL7 FORMAT

           IF VAFSTR[",2,"

               SET VAFHNAME=$$HLNAME^DGRUUTL($$GET1^DIQ(2,DFN,".211","E"))

               SET $PIECE(VAFHLREC,HL("FS"),3)=$TRANSLATE(VAFHNAME,"^",$EXTRACT(HL("ECH")))

 +10      ;NEXT OF KIN RELATIONSHIP

           IF VAFSTR[",3,"

               SET VAFHREL=$$RELATE^DGRUUTL($$GET1^DIQ(2,DFN,".212","E"))

               SET $PIECE(VAFHLREC,HL("FS"),4)=$PIECE(VAFHREL,"^")_$EXTRACT(HL("ECH"))_$PIECE(VAFHREL,"^",2)

 +11       IF VAFSTR[",4,"

               Begin DoDot:1

 +12      ;NEXT OF KIN STREET ADDRESS'S

                   SET VAFHADD=$$GET1^DIQ(2,DFN,".213","E")_"^"_$$GET1^DIQ(2,DFN,".214","E")_"^"_$$GET1^DIQ(2,DFN,".215","E")

 +13      ;NEXT OF KIN CITY, STATE, AND ZIP

                   SET VAFHLOC=$$GET1^DIQ(2,DFN,".216","E")_"^"_$$GET1^DIQ(2,DFN,".217","I")_"^"_$$GET1^DIQ(2,DFN,".218","E")

 +14      ;CONVERT TO HL7 FORMAT

                   SET $PIECE(VAFHLREC,HL("FS"),5)=$$HLADDR^HLFNC(VAFHADD,VAFHLOC)

               End DoDot:1

 +15      ;NEXT OF KIN HOME PHONE IN HL7 FORMAT

           IF VAFSTR[",5,"

               SET $PIECE(VAFHLREC,HL("FS"),6)=$$HLPHONE^HLFNC($$GET1^DIQ(2,DFN,".219","E"))

QUITNK1    QUIT VAFHLREC