RORRP034 ;HIOFO/SG,VC - RPC: HIV PATIENT SAVE/CANCEL ;1/29/09 9:46am
;;1.5;CLINICAL CASE REGISTRIES;**2,8,14**;Feb 17, 2006;Build 24
;Per VHA Directive 10-92-142, this routine should not be modified.
;
; This routine uses the following IAs:
;
; #2053 FILE^DIC (supported)
Q
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*14 APR 2011 A SAUNDERS SAVE1: Added AIDS DX - FIRST DIAGNOSED
; (#12.08) to the data that gets saved in
; file 799.4. Modified logic for the
; CLINICAL AIDS DATE (#.03) to correctly
; handle additional values (null/0/1/9).
;******************************************************************************
;******************************************************************************
;
;***** UPDATES THE PATIENT'S REGISTRY DATA
; RPC: [RORICR PATIENT SAVE]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; PTIEN IEN of the registry patient (DFN)
;
; [CANCEL] Cancel the update and unlock the registry data
;
; .DATA Reference to a local array that contains the data
; in the same format as the output of the RORICR
; PATIENT LOAD remote procedure. Only PH, ICR, and
; LFV segments are processed; the others are ignored.
;
; Revision for Patch 1.5*8 to add Comments
; In DATA array there will be a 3 piece record, formated as follows
; PC^STAT^COMMENT If STAT is P then the COMMENT will be added. If
; STAT is C then the COMMENT will be a blank.
;
; 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).
;
SAVE(RESULTS,REGIEN,PTIEN,CANCEL,DATA) ;
N IENS,LOCK,RC,RORERRDL,STAT,COMMENT
D CLEAR^RORERR("SAVE^RORRP034",1)
K RESULTS S (RESULTS(0),RC)=0
D
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
. ;--- Patient IEN
. I $G(PTIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"PTIEN",$G(PTIEN))
. S PTIEN=+PTIEN
. ;--- Get the IENS of the registry record
. S IENS=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
. S:IENS>0 (LOCK(798,IENS),LOCK(799.4,IENS))=""
. Q:$G(CANCEL)=1
. ;--- Save the data
. S RC=$$SAVE1(.IENS)
. I '$D(LOCK) S:IENS>0 (LOCK(798,IENS),LOCK(799.4,IENS))=""
. S:RC>0 RESULTS(0)=RC
;
;--- Do not unlock the records if there are errors in the data
; (positive value is returned by the $$SAVE1), since the user
;--- will have another chance to correct the data and save it.
D:RC'>0 UNLOCK^RORLOCK(.LOCK)
D:RC<0 RPCSTK^RORERR(.RESULTS,RC)
Q
;
;***** INTERNAL ENTRY POINT THAT UPDATES THE REGISTRY DATA
SAVE1(IENS798) ;
N IENS,LFIEN,LFV,RC,RDI,REGNAME,RORFDA,RORMSG,SEG,TMP
;
;=== Add the patient to the registry if necessary
I IENS798'>0 S RC=0 D Q:RC<0 RC
. S REGNAME=$P($$REGNAME^RORUTL01(REGIEN),U)
. ;--- Add the patient to the registry
. S RC=$$ADDPAT^RORUPD06(PTIEN,REGNAME) Q:RC<0
. ;--- Get the IENS of the registry record
. S IENS798=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
. S:IENS798'>0 RC=$$ERROR^RORERR(-97,,,PTIEN,REGNAME)
;
;=== Prepare the data
N LFCNT ;added 'new' statement
S (LFCNT,RDI,RC)=0
F S RDI=$O(DATA(RDI)) Q:RDI'>0 D Q:RC
. S SEG=$P(DATA(RDI),U)
. ;--- Risk factors
. I SEG="PH" D Q
. . S RC=$$CDCFDA^RORRP026(IENS798,"PH^RORRP026",DATA(RDI),.RORFDA)
. ;--- Registry data
. I SEG="ICR" D Q
. . S TMP=$P(DATA(RDI),U,3)
. . S RORFDA(799.4,IENS798,.02)=$G(TMP) ;clinical AIDS
. . ;S RORFDA(799.4,IENS798,.03)=$S(TMP:$P(DATA(RDI),U,4),1:"")
. . S RORFDA(799.4,IENS798,.03)=$S($G(TMP)=1:$P(DATA(RDI),U,4),1:"") ;clinical AIDS date
. . S RORFDA(799.4,IENS798,12.08)=$P(DATA(RDI),U,6) ;first VA site to diagnose HIV
. ;--- Local field values
. I SEG="LFV" D Q
. . S LFIEN=+$P(DATA(RDI),U,3)
. . S:LFIEN>0 LFV(LFIEN)=DATA(RDI)
. ;--- If there is a comment for a Pending Patient
. I SEG="PC" D Q
. . S STAT=$P(DATA(RDI),U,2)
. . S COMMENT=$P(DATA(RDI),U,3)
Q:RC RC
;
;=== Confirm the pending patient
;D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
I CANCEL=0 D
. ;--- Do not clear the DON'T SEND flag for 'test' patients
. S:'$$TESTPAT^RORUTL01(PTIEN) RORFDA(798,IENS798,11)="@"
. ;--- Change the STATUS from 'Pending' to 'Active'
. S RORFDA(798,IENS798,3)=0
. ;--- Delete any comment fields
. S RORFDA(798,IENS798,12)=" "
;
;=== Update local fields
;S RC=$$UPDLFV^RORUTL19(IENS798,.LFV) Q:RC<0 RC
S RC=$$UPDLFV^RORUTL19(IENS798,.LFV)
S:RC RORFDA(798,IENS798,5)=1 ; UPDATE LOCAL REGISTRY DATA
;=== Update the COMMENTS field
I STAT="P" S RORFDA(798,IENS798,12)=$G(COMMENT)
;
;=== Update the record(s)
I $D(RORFDA)>1 D Q:RC<0 RC
. ; UPDATE LOCAL REGISTRY DATA
. K RORMSG D FILE^DIE(,"RORFDA","RORMSG")
. ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
. S:$G(RORMSG("DIERR")) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
;
;=== Success
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP034 5684 printed Sep 23, 2025@19:19:15 Page 2
RORRP034 ;HIOFO/SG,VC - RPC: HIV PATIENT SAVE/CANCEL ;1/29/09 9:46am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**2,8,14**;Feb 17, 2006;Build 24
+2 ;Per VHA Directive 10-92-142, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ;
+6 ; #2053 FILE^DIC (supported)
+7 QUIT
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*14 APR 2011 A SAUNDERS SAVE1: Added AIDS DX - FIRST DIAGNOSED
+15 ; (#12.08) to the data that gets saved in
+16 ; file 799.4. Modified logic for the
+17 ; CLINICAL AIDS DATE (#.03) to correctly
+18 ; handle additional values (null/0/1/9).
+19 ;******************************************************************************
+20 ;******************************************************************************
+21 ;
+22 ;***** UPDATES THE PATIENT'S REGISTRY DATA
+23 ; RPC: [RORICR PATIENT SAVE]
+24 ;
+25 ; .RESULTS Reference to a local variable where the results
+26 ; are returned to.
+27 ;
+28 ; REGIEN Registry IEN
+29 ;
+30 ; PTIEN IEN of the registry patient (DFN)
+31 ;
+32 ; [CANCEL] Cancel the update and unlock the registry data
+33 ;
+34 ; .DATA Reference to a local array that contains the data
+35 ; in the same format as the output of the RORICR
+36 ; PATIENT LOAD remote procedure. Only PH, ICR, and
+37 ; LFV segments are processed; the others are ignored.
+38 ;
+39 ; Revision for Patch 1.5*8 to add Comments
+40 ; In DATA array there will be a 3 piece record, formated as follows
+41 ; PC^STAT^COMMENT If STAT is P then the COMMENT will be added. If
+42 ; STAT is C then the COMMENT will be a blank.
+43 ;
+44 ; Return Values:
+45 ;
+46 ; A negative value of the first "^"-piece of the RESULTS(0)
+47 ; indicates an error (see the RPCSTK^RORERR procedure for more
+48 ; details).
+49 ;
+50 ; Otherwise, zero is returned in the RESULTS(0).
+51 ;
SAVE(RESULTS,REGIEN,PTIEN,CANCEL,DATA) ;
+1 NEW IENS,LOCK,RC,RORERRDL,STAT,COMMENT
+2 DO CLEAR^RORERR("SAVE^RORRP034",1)
+3 KILL RESULTS
SET (RESULTS(0),RC)=0
+4 Begin DoDot:1
+5 ;--- Registry IEN
+6 IF $GET(REGIEN)'>0
Begin DoDot:2
+7 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+8 SET REGIEN=+REGIEN
+9 ;--- Patient IEN
+10 IF $GET(PTIEN)'>0
Begin DoDot:2
+11 SET RC=$$ERROR^RORERR(-88,,,,"PTIEN",$GET(PTIEN))
End DoDot:2
QUIT
+12 SET PTIEN=+PTIEN
+13 ;--- Get the IENS of the registry record
+14 SET IENS=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
+15 if IENS>0
SET (LOCK(798,IENS),LOCK(799.4,IENS))=""
+16 if $GET(CANCEL)=1
QUIT
+17 ;--- Save the data
+18 SET RC=$$SAVE1(.IENS)
+19 IF '$DATA(LOCK)
if IENS>0
SET (LOCK(798,IENS),LOCK(799.4,IENS))=""
+20 if RC>0
SET RESULTS(0)=RC
End DoDot:1
+21 ;
+22 ;--- Do not unlock the records if there are errors in the data
+23 ; (positive value is returned by the $$SAVE1), since the user
+24 ;--- will have another chance to correct the data and save it.
+25 if RC'>0
DO UNLOCK^RORLOCK(.LOCK)
+26 if RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
+27 QUIT
+28 ;
+29 ;***** INTERNAL ENTRY POINT THAT UPDATES THE REGISTRY DATA
SAVE1(IENS798) ;
+1 NEW IENS,LFIEN,LFV,RC,RDI,REGNAME,RORFDA,RORMSG,SEG,TMP
+2 ;
+3 ;=== Add the patient to the registry if necessary
+4 IF IENS798'>0
SET RC=0
Begin DoDot:1
+5 SET REGNAME=$PIECE($$REGNAME^RORUTL01(REGIEN),U)
+6 ;--- Add the patient to the registry
+7 SET RC=$$ADDPAT^RORUPD06(PTIEN,REGNAME)
if RC<0
QUIT
+8 ;--- Get the IENS of the registry record
+9 SET IENS798=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
+10 if IENS798'>0
SET RC=$$ERROR^RORERR(-97,,,PTIEN,REGNAME)
End DoDot:1
if RC<0
QUIT RC
+11 ;
+12 ;=== Prepare the data
+13 ;added 'new' statement
NEW LFCNT
+14 SET (LFCNT,RDI,RC)=0
+15 FOR
SET RDI=$ORDER(DATA(RDI))
if RDI'>0
QUIT
Begin DoDot:1
+16 SET SEG=$PIECE(DATA(RDI),U)
+17 ;--- Risk factors
+18 IF SEG="PH"
Begin DoDot:2
+19 SET RC=$$CDCFDA^RORRP026(IENS798,"PH^RORRP026",DATA(RDI),.RORFDA)
End DoDot:2
QUIT
+20 ;--- Registry data
+21 IF SEG="ICR"
Begin DoDot:2
+22 SET TMP=$PIECE(DATA(RDI),U,3)
+23 ;clinical AIDS
SET RORFDA(799.4,IENS798,.02)=$GET(TMP)
+24 ;S RORFDA(799.4,IENS798,.03)=$S(TMP:$P(DATA(RDI),U,4),1:"")
+25 ;clinical AIDS date
SET RORFDA(799.4,IENS798,.03)=$SELECT($GET(TMP)=1:$PIECE(DATA(RDI),U,4),1:"")
+26 ;first VA site to diagnose HIV
SET RORFDA(799.4,IENS798,12.08)=$PIECE(DATA(RDI),U,6)
End DoDot:2
QUIT
+27 ;--- Local field values
+28 IF SEG="LFV"
Begin DoDot:2
+29 SET LFIEN=+$PIECE(DATA(RDI),U,3)
+30 if LFIEN>0
SET LFV(LFIEN)=DATA(RDI)
End DoDot:2
QUIT
+31 ;--- If there is a comment for a Pending Patient
+32 IF SEG="PC"
Begin DoDot:2
+33 SET STAT=$PIECE(DATA(RDI),U,2)
+34 SET COMMENT=$PIECE(DATA(RDI),U,3)
End DoDot:2
QUIT
End DoDot:1
if RC
QUIT
+35 if RC
QUIT RC
+36 ;
+37 ;=== Confirm the pending patient
+38 ;D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
+39 IF CANCEL=0
Begin DoDot:1
+40 ;--- Do not clear the DON'T SEND flag for 'test' patients
+41 if '$$TESTPAT^RORUTL01(PTIEN)
SET RORFDA(798,IENS798,11)="@"
+42 ;--- Change the STATUS from 'Pending' to 'Active'
+43 SET RORFDA(798,IENS798,3)=0
+44 ;--- Delete any comment fields
+45 SET RORFDA(798,IENS798,12)=" "
End DoDot:1
+46 ;
+47 ;=== Update local fields
+48 ;S RC=$$UPDLFV^RORUTL19(IENS798,.LFV) Q:RC<0 RC
+49 SET RC=$$UPDLFV^RORUTL19(IENS798,.LFV)
+50 ; UPDATE LOCAL REGISTRY DATA
if RC
SET RORFDA(798,IENS798,5)=1
+51 ;=== Update the COMMENTS field
+52 IF STAT="P"
SET RORFDA(798,IENS798,12)=$GET(COMMENT)
+53 ;
+54 ;=== Update the record(s)
+55 IF $DATA(RORFDA)>1
Begin DoDot:1
+56 ; UPDATE LOCAL REGISTRY DATA
+57 KILL RORMSG
DO FILE^DIE(,"RORFDA","RORMSG")
+58 ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
+59 if $GET(RORMSG("DIERR"))
SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
End DoDot:1
if RC<0
QUIT RC
+60 ;
+61 ;=== Success
+62 QUIT 0
