RORRP033 ;HCIOFO/SG - RPC: HIV PATIENT LOAD ;10/27/05 2:12pm
;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
;
Q
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS LOAD: Added AIDS DX - FIRST DIAGNOSED
; (#12.08) from file 799.4 to the ICR
; segment in the returned array
;******************************************************************************
;******************************************************************************
;***** PROCESSES THE ERROR(S) AND UNLOCKS THE RECORDS
ERROR(RESULTS,RC) ;
D RPCSTK^RORERR(.RESULTS,RC)
D UNLOCK^RORLOCK(.RORLOCK)
Q
;
;***** LOADS THE PATIENT'S DATA FOR EDITING
; RPC: [RORICR PATIENT LOAD]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PATIEN IEN of the registry patient (DFN)
;
; [LOCK] Lock the registry record before loading the data and
; leave it locked.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(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 @RESULTS@(0)
; would be greater than 0. The @RESULTS@(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 process, which owns the most recent lock of the record.
; The "O" flag (read-only) would also be added to the 15th field
; of the "PRD" segment.
;
; @RESULTS@(0) Lock Descriptor
; ^01: Date/Time (FileMan)
; ^02: User/Process name
; ^03: User IEN (DUZ)
; ^04: $JOB
; ^05: Task number
;
; THE DATA IS LOADED ONLY FOR VIEWING PURPOSES (READ-ONLY)!
;
; Otherwise, zero is returned in the @RESULTS@(0) and the
; subsequent nodes of the global array contain the patient's data.
;
; @RESULTS@(0) 0
;
; @RESULTS@(i) Demographic data
; ^01: "DEM"
; ^02: ""
; ... See description of the ROR PATIENT
; GET DATA remote procedure
;
; @RESULTS@(i) Basic registry data
; ^01: "PRD"
; ^02: ""
; ... See description of the ROR PATIENT
; GET DATA remote procedure
;
; RESULTS(i) Local field data
; ^O1: "LFV"
; ... See description of the ROR PATIENT
; GET DATA remote procedure
;
; RESULTS(i) Selection Rule
; ^01: "PSR"
; ... See description of the ROR PATIENT
; GET DATA remote procedure
;
; @RESULTS@(i) Patient's history (risk factors)
; ^01: "PH"
; ^02: ""
; ... See description of the RORICR
; CDC LOAD remote procedure
;
; @RESULTS@(i) Registry data
; ^01: "ICR"
; ^02: ""
; ^03: Clinical AIDS (null/0/1/9)
; ^04: Date of Clinical AIDS (FileMan)
; ^05: reserved
; ^06: HIV first DX at this facility (null,0/1/9)
;
LOAD(RESULTS,REGIEN,PATIEN,LOCK) ;
N I,ICRBUF,IENS,LOCKRC,RC,RESPTR,RORBUF,RORERRDL,RORLOCK,RORMSG,TMP
D CLEAR^RORERR("LOAD^RORRP033",1)
K RESULTS S RESULTS=$$ALLOC^RORTMP()
S ICRBUF="ICR",LOCKRC=0
;=== Check the parameters
S RC=0 D I RC<0 D ERROR(.RESULTS,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
;
;=== Get the IENS of the registry record
S IENS=$$PRRIEN^RORUTL01(PATIEN,REGIEN)_","
;
;=== Lock the records
I $G(LOCK),IENS>0 D I LOCKRC<0 D ERROR(.RESULTS,+LOCKRC) Q
. S RORLOCK(798,IENS)=""
. S RORLOCK(799.4,IENS)=""
. S LOCKRC=$$LOCK^RORLOCK(.RORLOCK)
;
;=== Get the patient's data
D GETPTDAT^RORRP021(.RORBUF,PATIEN,"LS",REGIEN)
I $G(RORBUF(0))<0 D ERROR(.RESULTS,+RORBUF(0)) Q
;---
S I=""
F S I=$O(RORBUF(I)) Q:I="" Q:$P(RORBUF(I),U)="PRD"
D:I'=""
. S TMP=$P(RORBUF(I),U,15)
. I TMP'["O" S:LOCKRC $P(RORBUF(I),U,15)=TMP_"O" ; Read Only
. E D UNLOCK^RORLOCK(.RORLOCK) S LOCKRC=0
;---
M @RESULTS=RORBUF S RESPTR=$O(RORBUF(""),-1)
K RORBUF
;
;=== Load the ICR data
I IENS>0 S RC=0 D I RC<0 D ERROR(.RESULTS,RC) Q
. Q:$D(^RORDATA(799.4,+IENS))<10
. ;--- Patient's history (risk factors)
. S RORBUF="PH"
. S RC=$$LOAD^RORRP026(IENS,"PH^RORRP026",.RORBUF) Q:RC<0
. S RESPTR=RESPTR+1,@RESULTS@(RESPTR)=RORBUF
. ;--- Other registry data
. D GETS^DIQ(799.4,IENS,".02;.03;12.08","I","RORBUF","RORMSG")
. I $G(DIERR) D Q
. . S RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
. S $P(ICRBUF,U,3)=$G(RORBUF(799.4,IENS,.02,"I")) ;send actual value
. S $P(ICRBUF,U,4)=$G(RORBUF(799.4,IENS,.03,"I"))
. S $P(ICRBUF,U,6)=$G(RORBUF(799.4,IENS,12.08,"I")) ;HIV first Diagnosed at this Facility?
;
;===
S RESPTR=RESPTR+1,@RESULTS@(RESPTR)=ICRBUF
S @RESULTS@(0)=LOCKRC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP033 6151 printed Dec 13, 2024@01:43:14 Page 2
RORRP033 ;HCIOFO/SG - RPC: HIV PATIENT LOAD ;10/27/05 2:12pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**14**;Feb 17, 2006;Build 24
+2 ;
+3 QUIT
+4 ;
+5 ;******************************************************************************
+6 ;******************************************************************************
+7 ; --- ROUTINE MODIFICATION LOG ---
+8 ;
+9 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+10 ;----------- ---------- ----------- ----------------------------------------
+11 ;ROR*1.5*14 APR 2011 A SAUNDERS LOAD: Added AIDS DX - FIRST DIAGNOSED
+12 ; (#12.08) from file 799.4 to the ICR
+13 ; segment in the returned array
+14 ;******************************************************************************
+15 ;******************************************************************************
+16 ;***** 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 ;***** LOADS THE PATIENT'S DATA FOR EDITING
+6 ; RPC: [RORICR PATIENT LOAD]
+7 ;
+8 ; .RESULTS Reference to a local variable where the results
+9 ; are returned to.
+10 ;
+11 ; REGIEN Registry IEN
+12 ;
+13 ; PATIEN IEN of the registry patient (DFN)
+14 ;
+15 ; [LOCK] Lock the registry record before loading the data and
+16 ; leave it locked.
+17 ;
+18 ; Return Values:
+19 ;
+20 ; A negative value of the first "^"-piece of the RESULTS(0)
+21 ; indicates an error (see the RPCSTK^RORERR procedure for more
+22 ; details).
+23 ;
+24 ; If locking was requested (see the LOCK parameter) and the record
+25 ; could not be locked then the first "^"-piece of the @RESULTS@(0)
+26 ; would be greater than 0. The @RESULTS@(0) would contain the lock
+27 ; descriptor and subsequent nodes of the global array would contain
+28 ; the data (see below). The lock descriptor contains information
+29 ; about the process, which owns the most recent lock of the record.
+30 ; The "O" flag (read-only) would also be added to the 15th field
+31 ; of the "PRD" segment.
+32 ;
+33 ; @RESULTS@(0) Lock Descriptor
+34 ; ^01: Date/Time (FileMan)
+35 ; ^02: User/Process name
+36 ; ^03: User IEN (DUZ)
+37 ; ^04: $JOB
+38 ; ^05: Task number
+39 ;
+40 ; THE DATA IS LOADED ONLY FOR VIEWING PURPOSES (READ-ONLY)!
+41 ;
+42 ; Otherwise, zero is returned in the @RESULTS@(0) and the
+43 ; subsequent nodes of the global array contain the patient's data.
+44 ;
+45 ; @RESULTS@(0) 0
+46 ;
+47 ; @RESULTS@(i) Demographic data
+48 ; ^01: "DEM"
+49 ; ^02: ""
+50 ; ... See description of the ROR PATIENT
+51 ; GET DATA remote procedure
+52 ;
+53 ; @RESULTS@(i) Basic registry data
+54 ; ^01: "PRD"
+55 ; ^02: ""
+56 ; ... See description of the ROR PATIENT
+57 ; GET DATA remote procedure
+58 ;
+59 ; RESULTS(i) Local field data
+60 ; ^O1: "LFV"
+61 ; ... See description of the ROR PATIENT
+62 ; GET DATA remote procedure
+63 ;
+64 ; RESULTS(i) Selection Rule
+65 ; ^01: "PSR"
+66 ; ... See description of the ROR PATIENT
+67 ; GET DATA remote procedure
+68 ;
+69 ; @RESULTS@(i) Patient's history (risk factors)
+70 ; ^01: "PH"
+71 ; ^02: ""
+72 ; ... See description of the RORICR
+73 ; CDC LOAD remote procedure
+74 ;
+75 ; @RESULTS@(i) Registry data
+76 ; ^01: "ICR"
+77 ; ^02: ""
+78 ; ^03: Clinical AIDS (null/0/1/9)
+79 ; ^04: Date of Clinical AIDS (FileMan)
+80 ; ^05: reserved
+81 ; ^06: HIV first DX at this facility (null,0/1/9)
+82 ;
LOAD(RESULTS,REGIEN,PATIEN,LOCK) ;
+1 NEW I,ICRBUF,IENS,LOCKRC,RC,RESPTR,RORBUF,RORERRDL,RORLOCK,RORMSG,TMP
+2 DO CLEAR^RORERR("LOAD^RORRP033",1)
+3 KILL RESULTS
SET RESULTS=$$ALLOC^RORTMP()
+4 SET ICRBUF="ICR"
SET LOCKRC=0
+5 ;=== Check the parameters
+6 SET RC=0
Begin DoDot:1
+7 ;--- Registry IEN
+8 IF $GET(REGIEN)'>0
Begin DoDot:2
+9 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+10 SET REGIEN=+REGIEN
+11 ;--- Patient IEN
+12 IF $GET(PATIEN)'>0
Begin DoDot:2
+13 SET RC=$$ERROR^RORERR(-88,,,,"PATIEN",$GET(PATIEN))
End DoDot:2
QUIT
+14 SET PATIEN=+PATIEN
End DoDot:1
IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+15 ;
+16 ;=== Get the IENS of the registry record
+17 SET IENS=$$PRRIEN^RORUTL01(PATIEN,REGIEN)_","
+18 ;
+19 ;=== Lock the records
+20 IF $GET(LOCK)
IF IENS>0
Begin DoDot:1
+21 SET RORLOCK(798,IENS)=""
+22 SET RORLOCK(799.4,IENS)=""
+23 SET LOCKRC=$$LOCK^RORLOCK(.RORLOCK)
End DoDot:1
IF LOCKRC<0
DO ERROR(.RESULTS,+LOCKRC)
QUIT
+24 ;
+25 ;=== Get the patient's data
+26 DO GETPTDAT^RORRP021(.RORBUF,PATIEN,"LS",REGIEN)
+27 IF $GET(RORBUF(0))<0
DO ERROR(.RESULTS,+RORBUF(0))
QUIT
+28 ;---
+29 SET I=""
+30 FOR
SET I=$ORDER(RORBUF(I))
if I=""
QUIT
if $PIECE(RORBUF(I),U)="PRD"
QUIT
+31 if I'=""
Begin DoDot:1
+32 SET TMP=$PIECE(RORBUF(I),U,15)
+33 ; Read Only
IF TMP'["O"
if LOCKRC
SET $PIECE(RORBUF(I),U,15)=TMP_"O"
+34 IF '$TEST
DO UNLOCK^RORLOCK(.RORLOCK)
SET LOCKRC=0
End DoDot:1
+35 ;---
+36 MERGE @RESULTS=RORBUF
SET RESPTR=$ORDER(RORBUF(""),-1)
+37 KILL RORBUF
+38 ;
+39 ;=== Load the ICR data
+40 IF IENS>0
SET RC=0
Begin DoDot:1
+41 if $DATA(^RORDATA(799.4,+IENS))<10
QUIT
+42 ;--- Patient's history (risk factors)
+43 SET RORBUF="PH"
+44 SET RC=$$LOAD^RORRP026(IENS,"PH^RORRP026",.RORBUF)
if RC<0
QUIT
+45 SET RESPTR=RESPTR+1
SET @RESULTS@(RESPTR)=RORBUF
+46 ;--- Other registry data
+47 DO GETS^DIQ(799.4,IENS,".02;.03;12.08","I","RORBUF","RORMSG")
+48 IF $GET(DIERR)
Begin DoDot:2
+49 SET RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,799.4,IENS)
End DoDot:2
QUIT
+50 ;send actual value
SET $PIECE(ICRBUF,U,3)=$GET(RORBUF(799.4,IENS,.02,"I"))
+51 SET $PIECE(ICRBUF,U,4)=$GET(RORBUF(799.4,IENS,.03,"I"))
+52 ;HIV first Diagnosed at this Facility?
SET $PIECE(ICRBUF,U,6)=$GET(RORBUF(799.4,IENS,12.08,"I"))
End DoDot:1
IF RC<0
DO ERROR(.RESULTS,RC)
QUIT
+53 ;
+54 ;===
+55 SET RESPTR=RESPTR+1
SET @RESULTS@(RESPTR)=ICRBUF
+56 SET @RESULTS@(0)=LOCKRC
+57 QUIT
