Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORRP021

RORRP021.m

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