- 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 Feb 19, 2025@00:06:03 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)