RORHL01 ;HOIFO/CRT - HL7 PATIENT DATA: PID,ZSP,ZRD ; 6/19/06 2:08pm
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #263 $$EN^VAFHLPID (controlled)
; #3630 BLDPID^VAFCQRY (controlled)
; #4535 EN^VAFHLZRD (private)
; #4536 $$EN^VAFHLZSP (private)
; #10035 Read access to the PATIENT file (supported)
;
Q
;
;***** PID SEGMENT BUILDER
;
; RORDFN DFN of Patient Record in File #2
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
PID(RORDFN) ;
N CS,ERRCNT,I,PTID,RC,RORBUF,RORMSG,RPS,SCS,SEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS,.SCS,.RPS)
;
;--- Check if the patient exists
S RORDFN=+$G(RORDFN)
I '$D(^DPT(RORDFN,0)) D Q RC
. S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
;
;--- Call Standard PID Segment builder
S TMP="3,5,7,8,10,11,19,22,29"
D BLDPID^VAFCQRY(RORDFN,"",TMP,.RORBUF,.RORHL,.RORMSG)
;---
D LOADSEG^RORHL7A(.SEG,"RORBUF")
;
;--- PID-3 Patient Identifiers
S PTID=""
F I=1:1 S TMP=$P(SEG(3),RPS,I) Q:TMP="" D
. S:"NI,PI"[$P(TMP,CS,5) PTID=PTID_RPS_TMP
S SEG(3)=$P(PTID,RPS,2,99)
;
;--- PID-5 Remove the Patient Name
S SEG(5)=""
;
;--- PID-10 Send the old race if the new format is not available
I $G(SEG(10))?."""" D
. N VAFPID
. S TMP=$$EN^VAFHLPID(RORDFN,"10")
. S:$G(VAFPID(1))'="" RORSEG=RORSEG_VAFPID(1)
. S SEG(10)=$P(TMP,HLFS,11)
;
;--- PID-11 Remove Address (leave ZIP only)
S SEG(11)=CS_CS_CS_CS_$P($G(SEG(11)),CS,5)
;
;--- PID-19 Encrypt SSN
S SEG(19)=$$XOR^RORUTL03($G(SEG(19)))
;
;--- Store the segment
D ADDSEG^RORHL7(.SEG)
Q ERRCNT
;
;***** ZSP SEGMENT BUILDER
;
; RORDFN DFN of Patient Record in File #2
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
ZSP(RORDFN) ;
N RC,RORFLDS,RORSEG
S RC=0
;
;--- Check if the patient exists
S RORDFN=+$G(RORDFN)
I '$D(^DPT(RORDFN,0)) D Q RC
. S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
;
S RORFLDS="1,2,3,4" ; Default HL7 fields
;
;--- Call Standard ZSP Segment Builder
S RORSEG=$$EN^VAFHLZSP(RORDFN)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG,"C")
Q $S(RC<0:RC,1:0)
;
;***** ZRD SEGMENT BUILDER
;
; RORDFN DFN of Patient Record in File #2
;
; Return Values:
; <0 Error Code
; 0 Ok
; >0 Non-fatal error(s)
;
ZRD(RORDFN) ;
N I,RC,RORFLDS,RORSEG
S RC=0
;
;--- Check if the patient exists
S RORDFN=+$G(RORDFN)
I '$D(^DPT(RORDFN,0)) D Q RC
. S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
;
S RORFLDS="1,2,3,4" ; Default HL7 fields
;
;--- Call Standard ZRD Segment Builder
D EN^VAFHLZRD(RORDFN,RORFLDS,,HLFS,"RORSEG")
;
;--- Store the segment(s)
S I=""
F S I=$O(RORSEG(I)) Q:I="" Q:$P($G(RORSEG(I,0)),HLFS,3)="" D
. D ADDSEG^RORHL7(RORSEG(I,0),"C")
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL01 2972 printed Sep 23, 2025@19:17:43 Page 2
RORHL01 ;HOIFO/CRT - HL7 PATIENT DATA: PID,ZSP,ZRD ; 6/19/06 2:08pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #263 $$EN^VAFHLPID (controlled)
+6 ; #3630 BLDPID^VAFCQRY (controlled)
+7 ; #4535 EN^VAFHLZRD (private)
+8 ; #4536 $$EN^VAFHLZSP (private)
+9 ; #10035 Read access to the PATIENT file (supported)
+10 ;
+11 QUIT
+12 ;
+13 ;***** PID SEGMENT BUILDER
+14 ;
+15 ; RORDFN DFN of Patient Record in File #2
+16 ;
+17 ; Return Values:
+18 ; <0 Error Code
+19 ; 0 Ok
+20 ; >0 Non-fatal error(s)
+21 ;
PID(RORDFN) ;
+1 NEW CS,ERRCNT,I,PTID,RC,RORBUF,RORMSG,RPS,SCS,SEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS,.SCS,.RPS)
+4 ;
+5 ;--- Check if the patient exists
+6 SET RORDFN=+$GET(RORDFN)
+7 IF '$DATA(^DPT(RORDFN,0))
Begin DoDot:1
+8 SET RC=$$ERROR^RORERR(-36,,,RORDFN,2)
End DoDot:1
QUIT RC
+9 ;
+10 ;--- Call Standard PID Segment builder
+11 SET TMP="3,5,7,8,10,11,19,22,29"
+12 DO BLDPID^VAFCQRY(RORDFN,"",TMP,.RORBUF,.RORHL,.RORMSG)
+13 ;---
+14 DO LOADSEG^RORHL7A(.SEG,"RORBUF")
+15 ;
+16 ;--- PID-3 Patient Identifiers
+17 SET PTID=""
+18 FOR I=1:1
SET TMP=$PIECE(SEG(3),RPS,I)
if TMP=""
QUIT
Begin DoDot:1
+19 if "NI,PI"[$PIECE(TMP,CS,5)
SET PTID=PTID_RPS_TMP
End DoDot:1
+20 SET SEG(3)=$PIECE(PTID,RPS,2,99)
+21 ;
+22 ;--- PID-5 Remove the Patient Name
+23 SET SEG(5)=""
+24 ;
+25 ;--- PID-10 Send the old race if the new format is not available
+26 IF $GET(SEG(10))?.""""
Begin DoDot:1
+27 NEW VAFPID
+28 SET TMP=$$EN^VAFHLPID(RORDFN,"10")
+29 if $GET(VAFPID(1))'=""
SET RORSEG=RORSEG_VAFPID(1)
+30 SET SEG(10)=$PIECE(TMP,HLFS,11)
End DoDot:1
+31 ;
+32 ;--- PID-11 Remove Address (leave ZIP only)
+33 SET SEG(11)=CS_CS_CS_CS_$PIECE($GET(SEG(11)),CS,5)
+34 ;
+35 ;--- PID-19 Encrypt SSN
+36 SET SEG(19)=$$XOR^RORUTL03($GET(SEG(19)))
+37 ;
+38 ;--- Store the segment
+39 DO ADDSEG^RORHL7(.SEG)
+40 QUIT ERRCNT
+41 ;
+42 ;***** ZSP SEGMENT BUILDER
+43 ;
+44 ; RORDFN DFN of Patient Record in File #2
+45 ;
+46 ; Return Values:
+47 ; <0 Error Code
+48 ; 0 Ok
+49 ; >0 Non-fatal error(s)
+50 ;
ZSP(RORDFN) ;
+1 NEW RC,RORFLDS,RORSEG
+2 SET RC=0
+3 ;
+4 ;--- Check if the patient exists
+5 SET RORDFN=+$GET(RORDFN)
+6 IF '$DATA(^DPT(RORDFN,0))
Begin DoDot:1
+7 SET RC=$$ERROR^RORERR(-36,,,RORDFN,2)
End DoDot:1
QUIT RC
+8 ;
+9 ; Default HL7 fields
SET RORFLDS="1,2,3,4"
+10 ;
+11 ;--- Call Standard ZSP Segment Builder
+12 SET RORSEG=$$EN^VAFHLZSP(RORDFN)
+13 ;
+14 ;--- Store the segment
+15 DO ADDSEG^RORHL7(.RORSEG,"C")
+16 QUIT $SELECT(RC<0:RC,1:0)
+17 ;
+18 ;***** ZRD SEGMENT BUILDER
+19 ;
+20 ; RORDFN DFN of Patient Record in File #2
+21 ;
+22 ; Return Values:
+23 ; <0 Error Code
+24 ; 0 Ok
+25 ; >0 Non-fatal error(s)
+26 ;
ZRD(RORDFN) ;
+1 NEW I,RC,RORFLDS,RORSEG
+2 SET RC=0
+3 ;
+4 ;--- Check if the patient exists
+5 SET RORDFN=+$GET(RORDFN)
+6 IF '$DATA(^DPT(RORDFN,0))
Begin DoDot:1
+7 SET RC=$$ERROR^RORERR(-36,,,RORDFN,2)
End DoDot:1
QUIT RC
+8 ;
+9 ; Default HL7 fields
SET RORFLDS="1,2,3,4"
+10 ;
+11 ;--- Call Standard ZRD Segment Builder
+12 DO EN^VAFHLZRD(RORDFN,RORFLDS,,HLFS,"RORSEG")
+13 ;
+14 ;--- Store the segment(s)
+15 SET I=""
+16 FOR
SET I=$ORDER(RORSEG(I))
if I=""
QUIT
if $PIECE($GET(RORSEG(I,0)),HLFS,3)=""
QUIT
Begin DoDot:1
+17 DO ADDSEG^RORHL7(RORSEG(I,0),"C")
End DoDot:1
+18 QUIT $SELECT(RC<0:RC,1:0)
