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

RORRP025.m

Go to the documentation of this file. 
  1. RORRP025 ;HCIOFO/SG - RPC: RORICR CDC LOAD ;2/3/04 8:11am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #10060        Read access to the NEW PERSON file (#200)
  1.  ;
  1.  ;--------------------------------------------------------------------
  1.  ; Registry: [VA HIV]
  1.  ;--------------------------------------------------------------------
  1.  Q
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*14   APR  2011   A SAUNDERS   CS: quit if not 'yes'
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;
  1.  ;***** DEMOGRAPHIC INFORMATION (III)
  1. CDM(IENS) ;
  1.  N BUF,RC,RORBUF,TMP
  1.  S BUF="CDM"
  1.  S RC=$$LOAD^RORRP026(IENS,"CDM^RORRP026",.BUF,.RORBUF)  Q:RC<0 RC
  1.  ;--- Age at diagnosis
  1.  S TMP=+$G(RORBUF(799.4,IENS,9.02,"I"))
  1.  S:TMP=1 $P(BUF,U,4)=$G(RORBUF(799.4,IENS,9.03,"I"))
  1.  S:TMP=2 $P(BUF,U,4)=$G(RORBUF(799.4,IENS,9.04,"I"))
  1.  ;--- Country of birth
  1.  S TMP=+$G(RORBUF(799.4,IENS,9.07,"I"))
  1.  S:TMP=7 $P(BUF,U,8)=$G(RORBUF(799.4,IENS,9.08,"I"))
  1.  S:TMP=8 $P(BUF,U,8)=$G(RORBUF(799.4,IENS,9.09,"I"))
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** COMMENTS (X)
  1. CMT(IENS) ;
  1.  N BUF,I,RC,RORBUF,RORMSG,TMP
  1.  S TMP=$$GET1^DIQ(799.4,IENS,25,,"RORBUF","RORMSG")
  1.  I $G(DIERR)  D  Q RC
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,799.4,IENS)
  1.  ;--- Store the data into the result buffer
  1.  S I=0
  1.  F  S I=$O(RORBUF(I))  Q:I'>0  D
  1.  . S RORPTR=RORPTR+1,RORDST(RORPTR)="CMT"_U_I_U_RORBUF(I)
  1.  Q 0
  1.  ;
  1.  ;***** CLINICAL STATUS (VIII)
  1. CS(IENS) ;
  1.  N BUF,I,IENS1,RC,RORBUF,RORMSG,TMP
  1.  S BUF="CS"
  1.  S RC=$$LOAD^RORRP026(IENS,"CS^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  ;--- Load the AIDS Indicator diseases
  1.  S IENS1=","_IENS,TMP="@;.01I;.02I;.03I"
  1.  D LIST^DIC(799.41,IENS1,TMP,,,,,"B",,,"RORBUF","RORMSG")
  1.  I $G(DIERR)  D  Q RC
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,799.41,IENS1)
  1.  ;--- Process the list
  1.  S I=0
  1.  F  S I=$O(RORBUF("DILIST","ID",I))  Q:I'>0  D
  1.  . S BUF="AID"_U_$G(RORBUF("DILIST","ID",I,.01))
  1.  . S TMP=$G(RORBUF("DILIST","ID",I,.02))  Q:TMP'=1
  1.  . S $P(BUF,U,3)=TMP
  1.  . S $P(BUF,U,4)=$$DATE^RORRP026($G(RORBUF("DILIST","ID",I,.03)))
  1.  . ;--- Store the data into the result buffer
  1.  . S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
  1. ERROR(RESULTS,RC) ;
  1.  D RPCSTK^RORERR(.RESULTS,RC)
  1.  D UNLOCK^RORLOCK(.RORLOCK)
  1.  Q
  1.  ;
  1.  ;***** FACILITY OF DIAGNOSIS (IV)
  1. FD(IENS) ;
  1.  N BUF,RC,RORBUF,TMP
  1.  S BUF="FD"
  1.  S RC=$$LOAD^RORRP026(IENS,"FD^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** FORM HEADERS
  1. HDR(IENS) ;
  1.  N BUF,IENS200,RC,RORBUF,RORMSG,TMP
  1.  S BUF="HDR"
  1.  S RC=$$LOAD^RORRP026(IENS,"HDR^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Date when the CDC form was completed
  1.  S:$P(BUF,U,3)="" $P(BUF,U,3)=$$DT^XLFDT
  1.  ;--- Person who is completing the form
  1.  S IENS200=DUZ_","
  1.  D GETS^DIQ(200,IENS200,".01;.132",,"RORBUF","RORMSG")
  1.  Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,200,IENS200)
  1.  S $P(BUF,U,4)=DUZ
  1.  S $P(BUF,U,5)=$G(RORBUF(200,IENS200,.01))
  1.  S $P(BUF,U,6)=$G(RORBUF(200,IENS200,.132))
  1.  ;--- Medical record number (it is the SSN now)
  1.  S $P(BUF,U,7)=$P($G(RORDST(1)),U,6)
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** LABORATORY DATA (VI)
  1. LD(IENS) ;
  1.  N BUF,FLD,RC,RORBUF,TMP
  1.  S BUF="LD1"
  1.  S RC=$$LOAD^RORRP026(IENS,"LD1^RORRP026",.BUF,.RORBUF)  Q:RC<0 RC
  1.  ;--- Positive HIV detection test
  1.  S FLD=$$PHIVFLD^RORRP026($P(BUF,U,12))
  1.  S:FLD $P(BUF,U,13)=$$DATE^RORRP026($G(RORBUF(799.4,IENS,FLD,"I")))
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  ;--- The second segment
  1.  S BUF="LD2"
  1.  S RC=$$LOAD^RORRP026(IENS,"LD2^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** LOADS THE ICR CDC DATA
  1.  ; RPC: [RORICR CDC LOAD]
  1.  ;
  1.  ; .RORDST       Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; PATIEN        IEN of the registry patient (DFN)
  1.  ;
  1.  ; [LOCK]        Lock the ICR record before loading the data and
  1.  ;               leave it locked.
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the RORDST(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; If locking was requested (see the LOCK parameter) and the record
  1.  ; could not be locked then the first "^"-piece of the RORDST(0)
  1.  ; would be greater than 0. The RORDST(0) would contain the lock
  1.  ; descriptor and subsequent nodes of the global array would contain
  1.  ; the data (see below). The lock descriptor contains information
  1.  ; about the propcess, which owns the most recent lock of the record.
  1.  ;
  1.  ; RORDST(0)             Lock Descriptor
  1.  ;                         ^01: Date/Time (FileMan)
  1.  ;                         ^02: User/Process name
  1.  ;                         ^03: User IEN (DUZ)
  1.  ;                         ^04: $JOB
  1.  ;                         ^05: Task number
  1.  ;
  1.  ; THE DATA ARE LOADED ONLY FOR VIEWING PURPOSES (READ-ONLY)!
  1.  ;
  1.  ; Otherwise, zero is returned in the RORDST(0) and the subsequent
  1.  ; nodes of the array contain the data.
  1.  ; 
  1.  ; RORDST(0)             0
  1.  ;
  1.  ; RORDST(i)             Data Item
  1.  ;                         ^01: Type
  1.  ;                         ^02: Sequential Number or Item Code
  1.  ;                         ^03: Value
  1.  ;                         ^04: ...
  1.  ;
  1.  ;                       Item Types:
  1.  ;                         DEM  Demographic Information
  1.  ;                         ADR  Patient's Address
  1.  ;                         RCE  Race Information
  1.  ;                         ETN  Ethnicity Information
  1.  ;                         HDR  Headers
  1.  ;                         CDM  CDC Demographics
  1.  ;                         FD   Facility of Diagnosis
  1.  ;                         PH   Patient History
  1.  ;                         LD1  Laboratory Data
  1.  ;                         LD2  Laboratory Data
  1.  ;                         CS   Clinical Status
  1.  ;                         AID  AIDS Indicator Disease
  1.  ;                         TS1  Treatment/Services
  1.  ;                         TS2  Treatment/Services
  1.  ;                         CMT  Comments
  1.  ;
  1.  ; See the CDC FIELD TABLE section (CDCFLDS^RORRP026) and the
  1.  ; description of the RORICR CDC LOAD remote procedure for details.
  1.  ;
  1. LOADCDC(RORDST,REGIEN,PATIEN,LOCK) ;
  1.  N BUF,IEN,RC,RDONLY,RORERRDL,RORLOCK,RORPTR
  1.  D CLEAR^RORERR("LOADCDC^RORRP025",1)
  1.  K RORDST  S (RDONLY,RORDST(0))=0
  1.  ;--- Check the parameters
  1.  S RC=0  D  I RC<0  D ERROR(.RORDST,RC)  Q
  1.  . ;--- Registry IEN
  1.  . I $G(REGIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1.  . S REGIEN=+REGIEN
  1.  . ;--- Patient IEN
  1.  . I $G(PATIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"PATIEN",$G(PATIEN))
  1.  . S PATIEN=+PATIEN
  1.  ;
  1.  ;--- Load the patient's demographic data
  1.  D GETPTDAT^RORRP021(.RORDST,PATIEN,"AER")
  1.  Q:$G(RORDST(0))<0
  1.  S RORPTR=+$O(RORDST(""),-1)
  1.  ;
  1.  ;--- Get the IEN of the registry record
  1.  S IEN=$$PRRIEN^RORUTL01(PATIEN,REGIEN)  Q:IEN'>0
  1.  S IENS=IEN_","
  1.  ;
  1.  ;--- Lock the record
  1.  I $G(LOCK)  D  I RDONLY<0  D ERROR(.RORDST,+RDONLY)  Q
  1.  . S RORLOCK(799.4,IENS)=""
  1.  . S RDONLY=$$LOCK^RORLOCK(799.4,IENS)
  1.  ;
  1.  ;--- Create the data segments
  1.  S RC=0  D  I RC<0  D ERROR(.RORDST,RC)  Q
  1.  . S RC=$$HDR(IENS)  Q:RC<0
  1.  . S RC=$$CDM(IENS)  Q:RC<0
  1.  . S RC=$$FD(IENS)   Q:RC<0
  1.  . S RC=$$PH(IENS)   Q:RC<0
  1.  . S RC=$$LD(IENS)   Q:RC<0
  1.  . S RC=$$CS(IENS)   Q:RC<0
  1.  . S RC=$$TS(IENS)   Q:RC<0
  1.  . S RC=$$CMT(IENS)  Q:RC<0
  1.  ;---
  1.  S RORDST(0)=RDONLY
  1.  Q
  1.  ;
  1.  ;***** PATIENT HISTORY (V)
  1. PH(IENS) ;
  1.  N BUF,RC,RORBUF,TMP
  1.  S BUF="PH"
  1.  S RC=$$LOAD^RORRP026(IENS,"PH^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0
  1.  ;
  1.  ;***** TREATMENT/SERVICES REFERRALS (IX)
  1. TS(IENS) ;
  1.  N BUF,RC,RORBUF,TMP
  1.  S BUF="TS1"
  1.  S RC=$$LOAD^RORRP026(IENS,"TS1^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  ;--- The second segment
  1.  S BUF="TS2"
  1.  S RC=$$LOAD^RORRP026(IENS,"TS2^RORRP026",.BUF)  Q:RC<0 RC
  1.  ;--- Store the data into the result buffer
  1.  S RORPTR=RORPTR+1,RORDST(RORPTR)=BUF
  1.  Q 0