[613] | 1 | RORHL01 ;HOIFO/CRT - HL7 PATIENT DATA: PID,ZSP,ZRD ; 6/19/06 2:08pm
|
---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
---|
| 3 | ;
|
---|
| 4 | ; This routine uses the following IAs:
|
---|
| 5 | ;
|
---|
| 6 | ; #263 $$EN^VAFHLPID (controlled)
|
---|
| 7 | ; #3630 BLDPID^VAFCQRY (controlled)
|
---|
| 8 | ; #4535 EN^VAFHLZRD (private)
|
---|
| 9 | ; #4536 $$EN^VAFHLZSP (private)
|
---|
| 10 | ; #10035 Read access to the PATIENT file (supported)
|
---|
| 11 | ;
|
---|
| 12 | Q
|
---|
| 13 | ;
|
---|
| 14 | ;***** PID SEGMENT BUILDER
|
---|
| 15 | ;
|
---|
| 16 | ; RORDFN DFN of Patient Record in File #2
|
---|
| 17 | ;
|
---|
| 18 | ; Return Values:
|
---|
| 19 | ; <0 Error Code
|
---|
| 20 | ; 0 Ok
|
---|
| 21 | ; >0 Non-fatal error(s)
|
---|
| 22 | ;
|
---|
| 23 | PID(RORDFN) ;
|
---|
| 24 | N CS,ERRCNT,I,PTID,RC,RORBUF,RORMSG,RPS,SCS,SEG,TMP
|
---|
| 25 | S (ERRCNT,RC)=0
|
---|
| 26 | D ECH^RORHL7(.CS,.SCS,.RPS)
|
---|
| 27 | ;
|
---|
| 28 | ;--- Check if the patient exists
|
---|
| 29 | S RORDFN=+$G(RORDFN)
|
---|
| 30 | I '$D(^DPT(RORDFN,0)) D Q RC
|
---|
| 31 | . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
|
---|
| 32 | ;
|
---|
| 33 | ;--- Call Standard PID Segment builder
|
---|
| 34 | S TMP="3,5,7,8,10,11,19,22,29"
|
---|
| 35 | D BLDPID^VAFCQRY(RORDFN,"",TMP,.RORBUF,.RORHL,.RORMSG)
|
---|
| 36 | ;---
|
---|
| 37 | D LOADSEG^RORHL7A(.SEG,"RORBUF")
|
---|
| 38 | ;
|
---|
| 39 | ;--- PID-3 Patient Identifiers
|
---|
| 40 | S PTID=""
|
---|
| 41 | F I=1:1 S TMP=$P(SEG(3),RPS,I) Q:TMP="" D
|
---|
| 42 | . S:"NI,PI"[$P(TMP,CS,5) PTID=PTID_RPS_TMP
|
---|
| 43 | S SEG(3)=$P(PTID,RPS,2,99)
|
---|
| 44 | ;
|
---|
| 45 | ;--- PID-5 Remove the Patient Name
|
---|
| 46 | S SEG(5)=""
|
---|
| 47 | ;
|
---|
| 48 | ;--- PID-10 Send the old race if the new format is not available
|
---|
| 49 | I $G(SEG(10))?."""" D
|
---|
| 50 | . N VAFPID
|
---|
| 51 | . S TMP=$$EN^VAFHLPID(RORDFN,"10")
|
---|
| 52 | . S:$G(VAFPID(1))'="" RORSEG=RORSEG_VAFPID(1)
|
---|
| 53 | . S SEG(10)=$P(TMP,HLFS,11)
|
---|
| 54 | ;
|
---|
| 55 | ;--- PID-11 Remove Address (leave ZIP only)
|
---|
| 56 | S SEG(11)=CS_CS_CS_CS_$P($G(SEG(11)),CS,5)
|
---|
| 57 | ;
|
---|
| 58 | ;--- PID-19 Encrypt SSN
|
---|
| 59 | S SEG(19)=$$XOR^RORUTL03($G(SEG(19)))
|
---|
| 60 | ;
|
---|
| 61 | ;--- Store the segment
|
---|
| 62 | D ADDSEG^RORHL7(.SEG)
|
---|
| 63 | Q ERRCNT
|
---|
| 64 | ;
|
---|
| 65 | ;***** ZSP SEGMENT BUILDER
|
---|
| 66 | ;
|
---|
| 67 | ; RORDFN DFN of Patient Record in File #2
|
---|
| 68 | ;
|
---|
| 69 | ; Return Values:
|
---|
| 70 | ; <0 Error Code
|
---|
| 71 | ; 0 Ok
|
---|
| 72 | ; >0 Non-fatal error(s)
|
---|
| 73 | ;
|
---|
| 74 | ZSP(RORDFN) ;
|
---|
| 75 | N RC,RORFLDS,RORSEG
|
---|
| 76 | S RC=0
|
---|
| 77 | ;
|
---|
| 78 | ;--- Check if the patient exists
|
---|
| 79 | S RORDFN=+$G(RORDFN)
|
---|
| 80 | I '$D(^DPT(RORDFN,0)) D Q RC
|
---|
| 81 | . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
|
---|
| 82 | ;
|
---|
| 83 | S RORFLDS="1,2,3,4" ; Default HL7 fields
|
---|
| 84 | ;
|
---|
| 85 | ;--- Call Standard ZSP Segment Builder
|
---|
| 86 | S RORSEG=$$EN^VAFHLZSP(RORDFN)
|
---|
| 87 | ;
|
---|
| 88 | ;--- Store the segment
|
---|
| 89 | D ADDSEG^RORHL7(.RORSEG,"C")
|
---|
| 90 | Q $S(RC<0:RC,1:0)
|
---|
| 91 | ;
|
---|
| 92 | ;***** ZRD SEGMENT BUILDER
|
---|
| 93 | ;
|
---|
| 94 | ; RORDFN DFN of Patient Record in File #2
|
---|
| 95 | ;
|
---|
| 96 | ; Return Values:
|
---|
| 97 | ; <0 Error Code
|
---|
| 98 | ; 0 Ok
|
---|
| 99 | ; >0 Non-fatal error(s)
|
---|
| 100 | ;
|
---|
| 101 | ZRD(RORDFN) ;
|
---|
| 102 | N I,RC,RORFLDS,RORSEG
|
---|
| 103 | S RC=0
|
---|
| 104 | ;
|
---|
| 105 | ;--- Check if the patient exists
|
---|
| 106 | S RORDFN=+$G(RORDFN)
|
---|
| 107 | I '$D(^DPT(RORDFN,0)) D Q RC
|
---|
| 108 | . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
|
---|
| 109 | ;
|
---|
| 110 | S RORFLDS="1,2,3,4" ; Default HL7 fields
|
---|
| 111 | ;
|
---|
| 112 | ;--- Call Standard ZRD Segment Builder
|
---|
| 113 | D EN^VAFHLZRD(RORDFN,RORFLDS,,HLFS,"RORSEG")
|
---|
| 114 | ;
|
---|
| 115 | ;--- Store the segment(s)
|
---|
| 116 | S I=""
|
---|
| 117 | F S I=$O(RORSEG(I)) Q:I="" Q:$P($G(RORSEG(I,0)),HLFS,3)="" D
|
---|
| 118 | . D ADDSEG^RORHL7(RORSEG(I,0),"C")
|
---|
| 119 | Q $S(RC<0:RC,1:0)
|
---|