RORRP025 ;HCIOFO/SG - RPC: RORICR CDC LOAD ;2/3/04 8:11am
;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #10060 Read access to the NEW PERSON file (#200)
;
;--------------------------------------------------------------------
; Registry: [VA HIV]
;--------------------------------------------------------------------
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS CS: quit if not 'yes'
;******************************************************************************
;******************************************************************************
;
;***** DEMOGRAPHIC INFORMATION (III)
CDM(IENS) ;
N BUF,RC,RORBUF,TMP
S BUF="CDM"
S RC=$$LOAD^RORRP026(IENS,"CDM^RORRP026",.BUF,.RORBUF) Q:RC<0 RC
;--- Age at diagnosis
S TMP=+$G(RORBUF(799.4,IENS,9.02,"I"))
S:TMP=1 $P(BUF,U,4)=$G(RORBUF(799.4,IENS,9.03,"I"))
S:TMP=2 $P(BUF,U,4)=$G(RORBUF(799.4,IENS,9.04,"I"))
;--- Country of birth
S TMP=+$G(RORBUF(799.4,IENS,9.07,"I"))
S:TMP=7 $P(BUF,U,8)=$G(RORBUF(799.4,IENS,9.08,"I"))
S:TMP=8 $P(BUF,U,8)=$G(RORBUF(799.4,IENS,9.09,"I"))
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** COMMENTS (X)
CMT(IENS) ;
N BUF,I,RC,RORBUF,RORMSG,TMP
S TMP=$$GET1^DIQ(799.4,IENS,25,,"RORBUF","RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
;--- Store the data into the result buffer
S I=0
F S I=$O(RORBUF(I)) Q:I'>0 D
. S RORPTR=RORPTR+1,RORDST(RORPTR)="CMT"_U_I_U_RORBUF(I)
Q 0
;
;***** CLINICAL STATUS (VIII)
CS(IENS) ;
N BUF,I,IENS1,RC,RORBUF,RORMSG,TMP
S BUF="CS"
S RC=$$LOAD^RORRP026(IENS,"CS^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
;--- Load the AIDS Indicator diseases
S IENS1=","_IENS,TMP="@;.01I;.02I;.03I"
D LIST^DIC(799.41,IENS1,TMP,,,,,"B",,,"RORBUF","RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,799.41,IENS1)
;--- Process the list
S I=0
F S I=$O(RORBUF("DILIST","ID",I)) Q:I'>0 D
. S BUF="AID"_U_$G(RORBUF("DILIST","ID",I,.01))
. S TMP=$G(RORBUF("DILIST","ID",I,.02)) Q:TMP'=1
. S $P(BUF,U,3)=TMP
. S $P(BUF,U,4)=$$DATE^RORRP026($G(RORBUF("DILIST","ID",I,.03)))
. ;--- Store the data into the result buffer
. S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
ERROR(RESULTS,RC) ;
D RPCSTK^RORERR(.RESULTS,RC)
D UNLOCK^RORLOCK(.RORLOCK)
Q
;
;***** FACILITY OF DIAGNOSIS (IV)
FD(IENS) ;
N BUF,RC,RORBUF,TMP
S BUF="FD"
S RC=$$LOAD^RORRP026(IENS,"FD^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** FORM HEADERS
HDR(IENS) ;
N BUF,IENS200,RC,RORBUF,RORMSG,TMP
S BUF="HDR"
S RC=$$LOAD^RORRP026(IENS,"HDR^RORRP026",.BUF) Q:RC<0 RC
;--- Date when the CDC form was completed
S:$P(BUF,U,3)="" $P(BUF,U,3)=$$DT^XLFDT
;--- Person who is completing the form
S IENS200=DUZ_","
D GETS^DIQ(200,IENS200,".01;.132",,"RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,200,IENS200)
S $P(BUF,U,4)=DUZ
S $P(BUF,U,5)=$G(RORBUF(200,IENS200,.01))
S $P(BUF,U,6)=$G(RORBUF(200,IENS200,.132))
;--- Medical record number (it is the SSN now)
S $P(BUF,U,7)=$P($G(RORDST(1)),U,6)
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** LABORATORY DATA (VI)
LD(IENS) ;
N BUF,FLD,RC,RORBUF,TMP
S BUF="LD1"
S RC=$$LOAD^RORRP026(IENS,"LD1^RORRP026",.BUF,.RORBUF) Q:RC<0 RC
;--- Positive HIV detection test
S FLD=$$PHIVFLD^RORRP026($P(BUF,U,12))
S:FLD $P(BUF,U,13)=$$DATE^RORRP026($G(RORBUF(799.4,IENS,FLD,"I")))
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
;--- The second segment
S BUF="LD2"
S RC=$$LOAD^RORRP026(IENS,"LD2^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** LOADS THE ICR CDC DATA
; RPC: [RORICR CDC LOAD]
;
; .RORDST Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PATIEN IEN of the registry patient (DFN)
;
; [LOCK] Lock the ICR record before loading the data and
; leave it locked.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RORDST(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; If locking was requested (see the LOCK parameter) and the record
; could not be locked then the first "^"-piece of the RORDST(0)
; would be greater than 0. The RORDST(0) would contain the lock
; descriptor and subsequent nodes of the global array would contain
; the data (see below). The lock descriptor contains information
; about the propcess, which owns the most recent lock of the record.
;
; RORDST(0) Lock Descriptor
; ^01: Date/Time (FileMan)
; ^02: User/Process name
; ^03: User IEN (DUZ)
; ^04: $JOB
; ^05: Task number
;
; THE DATA ARE LOADED ONLY FOR VIEWING PURPOSES (READ-ONLY)!
;
; Otherwise, zero is returned in the RORDST(0) and the subsequent
; nodes of the array contain the data.
;
; RORDST(0) 0
;
; RORDST(i) Data Item
; ^01: Type
; ^02: Sequential Number or Item Code
; ^03: Value
; ^04: ...
;
; Item Types:
; DEM Demographic Information
; ADR Patient's Address
; RCE Race Information
; ETN Ethnicity Information
; HDR Headers
; CDM CDC Demographics
; FD Facility of Diagnosis
; PH Patient History
; LD1 Laboratory Data
; LD2 Laboratory Data
; CS Clinical Status
; AID AIDS Indicator Disease
; TS1 Treatment/Services
; TS2 Treatment/Services
; CMT Comments
;
; See the CDC FIELD TABLE section (CDCFLDS^RORRP026) and the
; description of the RORICR CDC LOAD remote procedure for details.
;
LOADCDC(RORDST,REGIEN,PATIEN,LOCK) ;
N BUF,IEN,RC,RDONLY,RORERRDL,RORLOCK,RORPTR
D CLEAR^RORERR("LOADCDC^RORRP025",1)
K RORDST S (RDONLY,RORDST(0))=0
;--- Check the parameters
S RC=0 D I RC<0 D ERROR(.RORDST,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Patient IEN
. I $G(PATIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
. S PATIEN=+PATIEN
;
;--- Load the patient's demographic data
D GETPTDAT^RORRP021(.RORDST,PATIEN,"AER")
Q:$G(RORDST(0))<0
S RORPTR=+$O(RORDST(""),-1)
;
;--- Get the IEN of the registry record
S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN) Q:IEN'>0
S IENS=IEN_","
;
;--- Lock the record
I $G(LOCK) D I RDONLY<0 D ERROR(.RORDST,+RDONLY) Q
. S RORLOCK(799.4,IENS)=""
. S RDONLY=$$LOCK^RORLOCK(799.4,IENS)
;
;--- Create the data segments
S RC=0 D I RC<0 D ERROR(.RORDST,RC) Q
. S RC=$$HDR(IENS) Q:RC<0
. S RC=$$CDM(IENS) Q:RC<0
. S RC=$$FD(IENS) Q:RC<0
. S RC=$$PH(IENS) Q:RC<0
. S RC=$$LD(IENS) Q:RC<0
. S RC=$$CS(IENS) Q:RC<0
. S RC=$$TS(IENS) Q:RC<0
. S RC=$$CMT(IENS) Q:RC<0
;---
S RORDST(0)=RDONLY
Q
;
;***** PATIENT HISTORY (V)
PH(IENS) ;
N BUF,RC,RORBUF,TMP
S BUF="PH"
S RC=$$LOAD^RORRP026(IENS,"PH^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
;
;***** TREATMENT/SERVICES REFERRALS (IX)
TS(IENS) ;
N BUF,RC,RORBUF,TMP
S BUF="TS1"
S RC=$$LOAD^RORRP026(IENS,"TS1^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
;--- The second segment
S BUF="TS2"
S RC=$$LOAD^RORRP026(IENS,"TS2^RORRP026",.BUF) Q:RC<0 RC
;--- Store the data into the result buffer
S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP025 8892 printed Sep 23, 2025@19:19:07 Page 2
RORRP025 ;HCIOFO/SG - RPC: RORICR CDC LOAD ;2/3/04 8:11am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10060 Read access to the NEW PERSON file (#200)
+6 ;
+7 ;--------------------------------------------------------------------
+8 ; Registry: [VA HIV]
+9 ;--------------------------------------------------------------------
+10 QUIT
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ; --- ROUTINE MODIFICATION LOG ---
+14 ;
+15 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+16 ;----------- ---------- ----------- ----------------------------------------
+17 ;ROR*1.5*14 APR 2011 A SAUNDERS CS: quit if not 'yes'
+18 ;******************************************************************************
+19 ;******************************************************************************
+20 ;
+21 ;***** DEMOGRAPHIC INFORMATION (III)
CDM(IENS) ;
+1 NEW BUF,RC,RORBUF,TMP
+2 SET BUF="CDM"
+3 SET RC=$$LOAD^RORRP026(IENS,"CDM^RORRP026",.BUF,.RORBUF)
if RC<0
QUIT RC
+4 ;--- Age at diagnosis
+5 SET TMP=+$GET(RORBUF(799.4,IENS,9.02,"I"))
+6 if TMP=1
SET $PIECE(BUF,U,4)=$GET(RORBUF(799.4,IENS,9.03,"I"))
+7 if TMP=2
SET $PIECE(BUF,U,4)=$GET(RORBUF(799.4,IENS,9.04,"I"))
+8 ;--- Country of birth
+9 SET TMP=+$GET(RORBUF(799.4,IENS,9.07,"I"))
+10 if TMP=7
SET $PIECE(BUF,U,8)=$GET(RORBUF(799.4,IENS,9.08,"I"))
+11 if TMP=8
SET $PIECE(BUF,U,8)=$GET(RORBUF(799.4,IENS,9.09,"I"))
+12 ;--- Store the data into the result buffer
+13 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+14 QUIT 0
+15 ;
+16 ;***** COMMENTS (X)
CMT(IENS) ;
+1 NEW BUF,I,RC,RORBUF,RORMSG,TMP
+2 SET TMP=$$GET1^DIQ(799.4,IENS,25,,"RORBUF","RORMSG")
+3 IF $GET(DIERR)
Begin DoDot:1
+4 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
End DoDot:1
QUIT RC
+5 ;--- Store the data into the result buffer
+6 SET I=0
+7 FOR
SET I=$ORDER(RORBUF(I))
if I'>0
QUIT
Begin DoDot:1
+8 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)="CMT"_U_I_U_RORBUF(I)
End DoDot:1
+9 QUIT 0
+10 ;
+11 ;***** CLINICAL STATUS (VIII)
CS(IENS) ;
+1 NEW BUF,I,IENS1,RC,RORBUF,RORMSG,TMP
+2 SET BUF="CS"
+3 SET RC=$$LOAD^RORRP026(IENS,"CS^RORRP026",.BUF)
if RC<0
QUIT RC
+4 ;--- Store the data into the result buffer
+5 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+6 ;--- Load the AIDS Indicator diseases
+7 SET IENS1=","_IENS
SET TMP="@;.01I;.02I;.03I"
+8 DO LIST^DIC(799.41,IENS1,TMP,,,,,"B",,,"RORBUF","RORMSG")
+9 IF $GET(DIERR)
Begin DoDot:1
+10 SET RC=$$DBS^RORERR("RORMSG",-9,,,799.41,IENS1)
End DoDot:1
QUIT RC
+11 ;--- Process the list
+12 SET I=0
+13 FOR
SET I=$ORDER(RORBUF("DILIST","ID",I))
if I'>0
QUIT
Begin DoDot:1
+14 SET BUF="AID"_U_$GET(RORBUF("DILIST","ID",I,.01))
+15 SET TMP=$GET(RORBUF("DILIST","ID",I,.02))
if TMP'=1
QUIT
+16 SET $PIECE(BUF,U,3)=TMP
+17 SET $PIECE(BUF,U,4)=$$DATE^RORRP026($GET(RORBUF("DILIST","ID",I,.03)))
+18 ;--- Store the data into the result buffer
+19 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
End DoDot:1
+20 QUIT 0
+21 ;
+22 ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
ERROR(RESULTS,RC) ;
+1 DO RPCSTK^RORERR(.RESULTS,RC)
+2 DO UNLOCK^RORLOCK(.RORLOCK)
+3 QUIT
+4 ;
+5 ;***** FACILITY OF DIAGNOSIS (IV)
FD(IENS) ;
+1 NEW BUF,RC,RORBUF,TMP
+2 SET BUF="FD"
+3 SET RC=$$LOAD^RORRP026(IENS,"FD^RORRP026",.BUF)
if RC<0
QUIT RC
+4 ;--- Store the data into the result buffer
+5 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+6 QUIT 0
+7 ;
+8 ;***** FORM HEADERS
HDR(IENS) ;
+1 NEW BUF,IENS200,RC,RORBUF,RORMSG,TMP
+2 SET BUF="HDR"
+3 SET RC=$$LOAD^RORRP026(IENS,"HDR^RORRP026",.BUF)
if RC<0
QUIT RC
+4 ;--- Date when the CDC form was completed
+5 if $PIECE(BUF,U,3)=""
SET $PIECE(BUF,U,3)=$$DT^XLFDT
+6 ;--- Person who is completing the form
+7 SET IENS200=DUZ_","
+8 DO GETS^DIQ(200,IENS200,".01;.132",,"RORBUF","RORMSG")
+9 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,200,IENS200)
+10 SET $PIECE(BUF,U,4)=DUZ
+11 SET $PIECE(BUF,U,5)=$GET(RORBUF(200,IENS200,.01))
+12 SET $PIECE(BUF,U,6)=$GET(RORBUF(200,IENS200,.132))
+13 ;--- Medical record number (it is the SSN now)
+14 SET $PIECE(BUF,U,7)=$PIECE($GET(RORDST(1)),U,6)
+15 ;--- Store the data into the result buffer
+16 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+17 QUIT 0
+18 ;
+19 ;***** LABORATORY DATA (VI)
LD(IENS) ;
+1 NEW BUF,FLD,RC,RORBUF,TMP
+2 SET BUF="LD1"
+3 SET RC=$$LOAD^RORRP026(IENS,"LD1^RORRP026",.BUF,.RORBUF)
if RC<0
QUIT RC
+4 ;--- Positive HIV detection test
+5 SET FLD=$$PHIVFLD^RORRP026($PIECE(BUF,U,12))
+6 if FLD
SET $PIECE(BUF,U,13)=$$DATE^RORRP026($GET(RORBUF(799.4,IENS,FLD,"I")))
+7 ;--- Store the data into the result buffer
+8 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+9 ;--- The second segment
+10 SET BUF="LD2"
+11 SET RC=$$LOAD^RORRP026(IENS,"LD2^RORRP026",.BUF)
if RC<0
QUIT RC
+12 ;--- Store the data into the result buffer
+13 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+14 QUIT 0
+15 ;
+16 ;***** LOADS THE ICR CDC DATA
+17 ; RPC: [RORICR CDC LOAD]
+18 ;
+19 ; .RORDST Reference to a local variable where the results
+20 ; are returned to.
+21 ;
+22 ; REGIEN Registry IEN
+23 ;
+24 ; PATIEN IEN of the registry patient (DFN)
+25 ;
+26 ; [LOCK] Lock the ICR record before loading the data and
+27 ; leave it locked.
+28 ;
+29 ; Return Values:
+30 ;
+31 ; A negative value of the first "^"-piece of the RORDST(0)
+32 ; indicates an error (see the RPCSTK^RORERR procedure for more
+33 ; details).
+34 ;
+35 ; If locking was requested (see the LOCK parameter) and the record
+36 ; could not be locked then the first "^"-piece of the RORDST(0)
+37 ; would be greater than 0. The RORDST(0) would contain the lock
+38 ; descriptor and subsequent nodes of the global array would contain
+39 ; the data (see below). The lock descriptor contains information
+40 ; about the propcess, which owns the most recent lock of the record.
+41 ;
+42 ; RORDST(0) Lock Descriptor
+43 ; ^01: Date/Time (FileMan)
+44 ; ^02: User/Process name
+45 ; ^03: User IEN (DUZ)
+46 ; ^04: $JOB
+47 ; ^05: Task number
+48 ;
+49 ; THE DATA ARE LOADED ONLY FOR VIEWING PURPOSES (READ-ONLY)!
+50 ;
+51 ; Otherwise, zero is returned in the RORDST(0) and the subsequent
+52 ; nodes of the array contain the data.
+53 ;
+54 ; RORDST(0) 0
+55 ;
+56 ; RORDST(i) Data Item
+57 ; ^01: Type
+58 ; ^02: Sequential Number or Item Code
+59 ; ^03: Value
+60 ; ^04: ...
+61 ;
+62 ; Item Types:
+63 ; DEM Demographic Information
+64 ; ADR Patient's Address
+65 ; RCE Race Information
+66 ; ETN Ethnicity Information
+67 ; HDR Headers
+68 ; CDM CDC Demographics
+69 ; FD Facility of Diagnosis
+70 ; PH Patient History
+71 ; LD1 Laboratory Data
+72 ; LD2 Laboratory Data
+73 ; CS Clinical Status
+74 ; AID AIDS Indicator Disease
+75 ; TS1 Treatment/Services
+76 ; TS2 Treatment/Services
+77 ; CMT Comments
+78 ;
+79 ; See the CDC FIELD TABLE section (CDCFLDS^RORRP026) and the
+80 ; description of the RORICR CDC LOAD remote procedure for details.
+81 ;
LOADCDC(RORDST,REGIEN,PATIEN,LOCK) ;
+1 NEW BUF,IEN,RC,RDONLY,RORERRDL,RORLOCK,RORPTR
+2 DO CLEAR^RORERR("LOADCDC^RORRP025",1)
+3 KILL RORDST
SET (RDONLY,RORDST(0))=0
+4 ;--- Check the parameters
+5 SET RC=0
Begin DoDot:1
+6 ;--- Registry IEN
+7 IF $GET(REGIEN)'>0
Begin DoDot:2
+8 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+9 SET REGIEN=+REGIEN
+10 ;--- Patient IEN
+11 IF $GET(PATIEN)'>0
Begin DoDot:2
+12 SET RC=$$ERROR^RORERR(-88,,,,"PATIEN",$GET(PATIEN))
End DoDot:2
QUIT
+13 SET PATIEN=+PATIEN
End DoDot:1
IF RC<0
DO ERROR(.RORDST,RC)
QUIT
+14 ;
+15 ;--- Load the patient's demographic data
+16 DO GETPTDAT^RORRP021(.RORDST,PATIEN,"AER")
+17 if $GET(RORDST(0))<0
QUIT
+18 SET RORPTR=+$ORDER(RORDST(""),-1)
+19 ;
+20 ;--- Get the IEN of the registry record
+21 SET IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)
if IEN'>0
QUIT
+22 SET IENS=IEN_","
+23 ;
+24 ;--- Lock the record
+25 IF $GET(LOCK)
Begin DoDot:1
+26 SET RORLOCK(799.4,IENS)=""
+27 SET RDONLY=$$LOCK^RORLOCK(799.4,IENS)
End DoDot:1
IF RDONLY<0
DO ERROR(.RORDST,+RDONLY)
QUIT
+28 ;
+29 ;--- Create the data segments
+30 SET RC=0
Begin DoDot:1
+31 SET RC=$$HDR(IENS)
if RC<0
QUIT
+32 SET RC=$$CDM(IENS)
if RC<0
QUIT
+33 SET RC=$$FD(IENS)
if RC<0
QUIT
+34 SET RC=$$PH(IENS)
if RC<0
QUIT
+35 SET RC=$$LD(IENS)
if RC<0
QUIT
+36 SET RC=$$CS(IENS)
if RC<0
QUIT
+37 SET RC=$$TS(IENS)
if RC<0
QUIT
+38 SET RC=$$CMT(IENS)
if RC<0
QUIT
End DoDot:1
IF RC<0
DO ERROR(.RORDST,RC)
QUIT
+39 ;---
+40 SET RORDST(0)=RDONLY
+41 QUIT
+42 ;
+43 ;***** PATIENT HISTORY (V)
PH(IENS) ;
+1 NEW BUF,RC,RORBUF,TMP
+2 SET BUF="PH"
+3 SET RC=$$LOAD^RORRP026(IENS,"PH^RORRP026",.BUF)
if RC<0
QUIT RC
+4 ;--- Store the data into the result buffer
+5 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+6 QUIT 0
+7 ;
+8 ;***** TREATMENT/SERVICES REFERRALS (IX)
TS(IENS) ;
+1 NEW BUF,RC,RORBUF,TMP
+2 SET BUF="TS1"
+3 SET RC=$$LOAD^RORRP026(IENS,"TS1^RORRP026",.BUF)
if RC<0
QUIT RC
+4 ;--- Store the data into the result buffer
+5 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+6 ;--- The second segment
+7 SET BUF="TS2"
+8 SET RC=$$LOAD^RORRP026(IENS,"TS2^RORRP026",.BUF)
if RC<0
QUIT RC
+9 ;--- Store the data into the result buffer
+10 SET RORPTR=RORPTR+1
SET RORDST(RORPTR)=BUF
+11 QUIT 0
