SRHLVU ;B'HAM ISC/DLR - Surgery HL7 Utility routine ; [ 05/06/98 7:14 AM ]
;;3.0; Surgery ;**41**;24 Jun 93
; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
DNAME(NAME) ;identifies an incoming CN data type to a record in file 200
N X,CNT
I '$D(NAME)!(($P(NAME,HLCOMP)="")&($P(NAME,HLCOMP,2="")!$P(NAME,HLCOMP,3=""))) Q ""
I NAME="" Q ""
I $P(NAME,HLCOMP)'="" S NAME=$O(^VA(200,"SSN",$P(NAME,HLCOMP),0)) I NAME'="" S NAME=$P(^VA(200,NAME,0),U)
E S X="",CNT=0 S NAME=$$FMNAME^HLFNC($P(NAME,HLCOMP,2,3)) F S X=$O(^VA(200,"B",NAME,X)) Q:'X S CNT=CNT+1 S NAME=$S(CNT=1:X,CNT>1:"")
Q NAME
HNAME(IEN) ;converts an file 200 internal entry number into an HL7 CN data type
I IEN="" Q ""
I '$D(^VA(200,IEN,0)) W !,"Not a valid entry in file 200." Q ""
Q $P(^VA(200,IEN,1),U,9)_HLCOMP_$P($P(^VA(200,IEN,0),U),",")_HLCOMP_$P($P(^VA(200,IEN,0),U),",",2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVU 889 printed Dec 13, 2024@02:39:32 Page 2
SRHLVU ;B'HAM ISC/DLR - Surgery HL7 Utility routine ; [ 05/06/98 7:14 AM ]
+1 ;;3.0; Surgery ;**41**;24 Jun 93
+2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
DNAME(NAME) ;identifies an incoming CN data type to a record in file 200
+1 NEW X,CNT
+2 IF '$DATA(NAME)!(($PIECE(NAME,HLCOMP)="")&($PIECE(NAME,HLCOMP,2="")!$PIECE(NAME,HLCOMP,3="")))
QUIT ""
+3 IF NAME=""
QUIT ""
+4 IF $PIECE(NAME,HLCOMP)'=""
SET NAME=$ORDER(^VA(200,"SSN",$PIECE(NAME,HLCOMP),0))
IF NAME'=""
SET NAME=$PIECE(^VA(200,NAME,0),U)
+5 IF '$TEST
SET X=""
SET CNT=0
SET NAME=$$FMNAME^HLFNC($PIECE(NAME,HLCOMP,2,3))
FOR
SET X=$ORDER(^VA(200,"B",NAME,X))
if 'X
QUIT
SET CNT=CNT+1
SET NAME=$SELECT(CNT=1:X,CNT>1:"")
+6 QUIT NAME
HNAME(IEN) ;converts an file 200 internal entry number into an HL7 CN data type
+1 IF IEN=""
QUIT ""
+2 IF '$DATA(^VA(200,IEN,0))
WRITE !,"Not a valid entry in file 200."
QUIT ""
+3 QUIT $PIECE(^VA(200,IEN,1),U,9)_HLCOMP_$PIECE($PIECE(^VA(200,IEN,0),U),",")_HLCOMP_$PIECE($PIECE(^VA(200,IEN,0),U),",",2)
