221 lines
7.8 KiB
Mathematica
221 lines
7.8 KiB
Mathematica
RORRP021 ;HCIOFO/SG - RPC: PATIENT DATA ; 8/19/05 10:28am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
Q
|
|
;
|
|
;***** LOADS THE PATIENT DATA
|
|
; RPC: [ROR PATIENT GET DATA]
|
|
;
|
|
; .RESULTS Reference to a local variable where the results
|
|
; are returned to.
|
|
;
|
|
; PTIEN IEN of the patient (DFN)
|
|
;
|
|
; [FLAGS] Flags that control the execution (can be combined):
|
|
; A Load the patient's address
|
|
; E Load the ethnicity information
|
|
; L Load values of patient's active local fields
|
|
; R Load the race information
|
|
; S Load the selection rules
|
|
;
|
|
; The "L" and "S" flags require the REGIEN parameter.
|
|
; Otherwise, they are ignored.
|
|
;
|
|
; [REGIEN] Registry IEN.
|
|
; If value of this parameter is greater than 0
|
|
; then the "PRD" segment with the basic patient's
|
|
; registry data will be returned. If the patient
|
|
; is not in the registry then an empty "PRD" segment
|
|
; will be returned anyway.
|
|
;
|
|
; Return Values:
|
|
;
|
|
; A negative value of the first "^"-piece of the RESULTS(0)
|
|
; indicates an error (see the RPCSTK^RORERR procedure for more
|
|
; details).
|
|
;
|
|
; Otherwise, zero is returned in the RESULTS(0) and the subsequent
|
|
; nodes of the array contain the patient's data.
|
|
;
|
|
; RESULTS(0) 0
|
|
;
|
|
; RESULTS(i) Demographic Information
|
|
; ^01: "DEM"
|
|
; ^02: ""
|
|
; ... See the $$LOAD2^RORRP020 (RORDEM)
|
|
;
|
|
; RESULTS(i) Patient's Address
|
|
; ^01: "ADR"
|
|
; ^02: ""
|
|
; ... See the $$LOAD2^RORRP020 (RORADR)
|
|
;
|
|
; RESULTS(i) Race Information
|
|
; ^01: "RCE"
|
|
; ^02: Race IEN
|
|
; ^03: Race HL7 Value
|
|
; ^04: Race
|
|
; ^05: Collection Method HL7 Value
|
|
; ^06: Collection Method
|
|
;
|
|
; Race HL7 Values
|
|
; 1002-5 American Indian or Alaska Native
|
|
; 2028-9 Asian
|
|
; 2054-5 Black or African American
|
|
; 0000-0 Declined to Answer
|
|
; 2076-8 Native Hawaiian or Pacific Islander
|
|
; 9999-4 Unknown by Patient
|
|
; 2106-3 White
|
|
;
|
|
; Collection Method HL7 Values
|
|
; OBS Observer
|
|
; PRX Proxy
|
|
; SLF Self Identification
|
|
; UNK Unknown
|
|
;
|
|
; RESULTS(i) Ethnicity Information
|
|
; ^01: "ETN"
|
|
; ^02: Ethnicity IEN
|
|
; ^03: Ethnicity HL7 Value
|
|
; ^04: Ethnicity
|
|
; ^05: Collection Method HL7 value
|
|
; ^06: Collection Method
|
|
;
|
|
; Ethnicity HL7 Values
|
|
; 0000-0 Declined to Answer
|
|
; 2135-2 Hispanic or Latino
|
|
; 2186-5 Not Hispanic or Latino
|
|
; 9999-4 Unknown by Patient
|
|
;
|
|
; RESULTS(i) Patient's Registry Data
|
|
; ^01: "PRD"
|
|
; ^02: ""
|
|
; ... See the $$LOAD798^RORRP020
|
|
;
|
|
; RESULTS(i) Local field data
|
|
; ^O1: "LFV"
|
|
; ^02: IEN in the LOCAL FIELD multiple
|
|
; of the ROR REGISTRY RECORD file
|
|
; ^03: Field Definition IEN
|
|
; (in the ROR LOCAL FIELD file)
|
|
; ^04: Field Name
|
|
; ^05: Date (FileMan)
|
|
; ^06: Comment
|
|
;
|
|
; RESULTS(i) Selection Rule
|
|
; ^01: "PSR"
|
|
; ^02: IEN in the SELECTION RULE multiple
|
|
; of the ROR REGISTRY RECORD file
|
|
; ^03: Rule Definition IEN
|
|
; (in the ROR SELECTION RULE file)
|
|
; ^04: Name of the Rule
|
|
; ^05: Date (FileMan)
|
|
; ^06: Location IEN (Institution IEN)
|
|
; ^07: Location Name (Institution Name)
|
|
; ^08: Short Description
|
|
;
|
|
GETPTDAT(RESULTS,PTIEN,FLAGS,REGIEN) ;
|
|
N BUF,BUF1,DOD,IEN,RC,RESPTR,RORERRDL,VADM
|
|
D CLEAR^RORERR("GETPTDAT^RORRP021",1)
|
|
K RESULTS S (RESULTS(0),RESPTR)=0
|
|
;=== Check the parameters
|
|
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|
. ;--- Patient IEN
|
|
. I $G(PTIEN)'>0 D Q
|
|
. . S RC=$$ERROR^RORERR(-88,,,,"PTIEN",$G(PTIEN))
|
|
. S PTIEN=+PTIEN
|
|
. ;--- Flags
|
|
. S FLAGS=$$UP^XLFSTR($G(FLAGS))
|
|
;=== Load the data from the PATIENT file
|
|
S RC=$$LOAD2^RORRP020(PTIEN,.BUF,.BUF1,.VADM)
|
|
I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|
S DOD=$P(BUF,U,5)
|
|
;
|
|
;=== Demographic information and address
|
|
S RESPTR=RESPTR+1,RESULTS(RESPTR)="DEM^^"_BUF
|
|
S:FLAGS["A" RESPTR=RESPTR+1,RESULTS(RESPTR)="ADR^^"_BUF1
|
|
;
|
|
;=== Race information
|
|
I FLAGS["R" D:$G(VADM(12))>0
|
|
. N I,METHOD,RACE
|
|
. S I=""
|
|
. F S I=$O(VADM(12,I)) Q:I="" D
|
|
. . S RACE=$G(VADM(12,I)) Q:RACE'>0
|
|
. . S METHOD=$G(VADM(12,I,1))
|
|
. . S BUF="RCE"_U_(+RACE)
|
|
. . ;---
|
|
. . S $P(BUF,U,3)=$$PTR2CODE^DGUTL4(+RACE,1,2)
|
|
. . S $P(BUF,U,4)=$P(RACE,U,2)
|
|
. . S $P(BUF,U,5)=$$PTR2CODE^DGUTL4(+METHOD,3,2)
|
|
. . S $P(BUF,U,6)=$P(METHOD,U,2)
|
|
. . ;---
|
|
. . S RESPTR=RESPTR+1,RESULTS(RESPTR)=BUF
|
|
;
|
|
;=== Ethnicity information
|
|
I FLAGS["E" D:$G(VADM(11))>0
|
|
. N ETHN,I,METHOD
|
|
. S I=""
|
|
. F S I=$O(VADM(11,I)) Q:I="" D
|
|
. . S ETHN=$G(VADM(11,I)) Q:ETHN'>0
|
|
. . S METHOD=$G(VADM(11,I,1))
|
|
. . S BUF="ETN"_U_(+ETHN)
|
|
. . ;---
|
|
. . S $P(BUF,U,3)=$$PTR2CODE^DGUTL4(+ETHN,2,2)
|
|
. . S $P(BUF,U,4)=$P(ETHN,U,2)
|
|
. . S $P(BUF,U,5)=$$PTR2CODE^DGUTL4(+METHOD,3,2)
|
|
. . S $P(BUF,U,6)=$P(METHOD,U,2)
|
|
. . ;---
|
|
. . S RESPTR=RESPTR+1,RESULTS(RESPTR)=BUF
|
|
;
|
|
;=== Patient's registry data
|
|
I $G(REGIEN)>0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|
. S RESPTR=RESPTR+1
|
|
. ;--- Get the IEN of the registry record
|
|
. S IEN=$$PRRIEN^RORUTL01(PTIEN,REGIEN)
|
|
. I IEN'>0 S RESULTS(RESPTR)="PRD" Q
|
|
. ;--- Load the data from the patient's registry record
|
|
. S RC=$$LOAD798^RORRP020(IEN,.BUF,DOD) Q:RC<0
|
|
. S RESULTS(RESPTR)="PRD^^"_BUF
|
|
. ;--- Local field values
|
|
. I FLAGS["L" D Q:RC<0
|
|
. . S RC=$$LFV(IEN,.RESULTS,.RESPTR)
|
|
. ;--- Selection rules
|
|
. I FLAGS["S" D Q:RC<0
|
|
. . S RC=$$PSR(IEN,.RESULTS,.RESPTR)
|
|
;===
|
|
Q
|
|
;
|
|
;***** GET THE LOCAL FIELD VALUES
|
|
LFV(IEN798,RESULTS,RESPTR) ;
|
|
N I,IEN,IENS,RORBUF,SCR,RORMSG
|
|
S DT=$$DT^XLFDT
|
|
;--- Load the data
|
|
S SCR="I $$LFACTIVE^RORDD01(+$G(^(0)))"
|
|
S IENS=","_IEN798_",",I="@;.01I;.01E;.02I;1"
|
|
D LIST^DIC(798.02,IENS,I,"P",,,,"B",SCR,,"RORBUF","RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.02,IENS)
|
|
;--- Add the data to the output array
|
|
S I=0
|
|
F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
|
|
. S RESPTR=RESPTR+1
|
|
. S RESULTS(RESPTR)="LFV^"_RORBUF("DILIST",I,0)
|
|
;--- Success
|
|
Q 0
|
|
;
|
|
;***** GET THE SELECTION RULES
|
|
PSR(IEN798,RESULTS,RESPTR) ;
|
|
N BUF,I,IEN,IENS,RORBUF,RORMSG,TMP
|
|
;--- Load the data
|
|
S IENS=","_IEN798_",",TMP="@;.01I;.01E;1I;2I;2E"
|
|
D LIST^DIC(798.01,IENS,TMP,"P",,,,"AD",,,"RORBUF","RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.01,IENS)
|
|
;--- Add the data to the output array
|
|
S I=0
|
|
F S I=$O(RORBUF("DILIST",I)) Q:I'>0 D
|
|
. S BUF=RORBUF("DILIST",I,0),IEN=+$P(BUF,U,2) Q:IEN'>0
|
|
. S TMP=$$GET1^DIQ(798.2,IEN_",",4,,,"RORMSG")
|
|
. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,798.2,IEN_",")
|
|
. S $P(BUF,U,7)=$S(TMP'="":TMP,1:$P(BUF,U,3))
|
|
. S RESPTR=RESPTR+1,RESULTS(RESPTR)="PSR^"_BUF
|
|
;--- Success
|
|
Q 0
|