RORRP037 ;HIOFO/SG,VC - RPC: HEPC PATIENT SAVE/CANCEL ;1/29/09 9:53am
;;1.5;CLINICAL CASE REGISTRIES;**2,8**;Feb 17, 2006;Build 8
;Per VHA Directive 10-92-142, this routine should not be modified.
;
; This routine uses the following IAs:
;
; #2053 FILE^DIC (supported)
Q
;
;***** UPDATES THE PATIENT'S REGISTRY DATA
; RPC: [RORHEPC 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 RORHEPC
; PATIENT LOAD remote procedure. Only HEPC 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^RORRP037",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)=""
. Q:$G(CANCEL)=1
. ;--- Save the data
. S RC=$$SAVE1(.IENS)
. I '$D(LOCK) S:IENS>0 LOCK(798,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
;
; IENS798 IENS of the registry record in the file #798
;
; Return Values:
; <0 Error code
; 0 Ok
;
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)
. ;--- Registry data
. I SEG="HEPC" D Q
. . ; Insert code here if/when necessary
. ;--- 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
;=== Add the COMMENT field to file 798 for pending patients
I STAT="P" S RORFDA(798,IENS798,12)=$G(COMMENT)
;
;=== Update the record(s)
I $D(RORFDA)>1 D Q:RC<0 RC
. K RORMSG D FILE^DIE(,"RORFDA","RORMSG")
. ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
. S:$G(RORMSG("DIERR")) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
;
;=== Success
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP037 4420 printed Oct 16, 2024@17:44:09 Page 2
RORRP037 ;HIOFO/SG,VC - RPC: HEPC PATIENT SAVE/CANCEL ;1/29/09 9:53am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**2,8**;Feb 17, 2006;Build 8
+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 ;***** UPDATES THE PATIENT'S REGISTRY DATA
+10 ; RPC: [RORHEPC PATIENT SAVE]
+11 ;
+12 ; .RESULTS Reference to a local variable where the results
+13 ; are returned to.
+14 ;
+15 ; REGIEN Registry IEN
+16 ;
+17 ; PTIEN IEN of the registry patient (DFN)
+18 ;
+19 ; [CANCEL] Cancel the update and unlock the registry data
+20 ;
+21 ; .DATA Reference to a local array that contains the data
+22 ; in the same format as the output of the RORHEPC
+23 ; PATIENT LOAD remote procedure. Only HEPC and LFV
+24 ; segments are processed; the others are ignored.
+25 ; Revision for Patch 1.5*8 to add comments
+26 ; In DATA array there will be a 3 piece record, formated as follows
+27 ; PC^STAT^COMMENT If STAT is P then the COMMENT will be added. If
+28 ; STAT is C then the COMMENT will be a blank.
+29 ;
+30 ; Return Values:
+31 ;
+32 ; A negative value of the first "^"-piece of the RESULTS(0)
+33 ; indicates an error (see the RPCSTK^RORERR procedure for more
+34 ; details).
+35 ;
+36 ; Otherwise, zero is returned in the RESULTS(0).
+37 ;
SAVE(RESULTS,REGIEN,PTIEN,CANCEL,DATA) ;
+1 NEW IENS,LOCK,RC,RORERRDL,STAT,COMMENT
+2 DO CLEAR^RORERR("SAVE^RORRP037",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)=""
+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)=""
+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
+30 ;
+31 ; IENS798 IENS of the registry record in the file #798
+32 ;
+33 ; Return Values:
+34 ; <0 Error code
+35 ; 0 Ok
+36 ;
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 ;--- Registry data
+18 IF SEG="HEPC"
Begin DoDot:2
+19 ; Insert code here if/when necessary
End DoDot:2
QUIT
+20 ;--- Local field values
+21 IF SEG="LFV"
Begin DoDot:2
+22 SET LFIEN=+$PIECE(DATA(RDI),U,3)
+23 if LFIEN>0
SET LFV(LFIEN)=DATA(RDI)
End DoDot:2
QUIT
+24 ;--- If there is a comment for a Pending Patient
+25 IF SEG="PC"
Begin DoDot:2
+26 SET STAT=$PIECE(DATA(RDI),U,2)
+27 SET COMMENT=$PIECE(DATA(RDI),U,3)
End DoDot:2
QUIT
End DoDot:1
if RC
QUIT
+28 if RC
QUIT RC
+29 ;
+30 ;=== Confirm the pending patient
+31 ;D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
+32 IF CANCEL=0
Begin DoDot:1
+33 ;--- Do not clear the DON'T SEND flag for 'test' patients
+34 if '$$TESTPAT^RORUTL01(PTIEN)
SET RORFDA(798,IENS798,11)="@"
+35 ;--- Change the STATUS from 'Pending' to 'Active'
+36 SET RORFDA(798,IENS798,3)=0
+37 ;--- Delete any comment fields
+38 SET RORFDA(798,IENS798,12)=" "
End DoDot:1
+39 ;
+40 ;=== Update local fields
+41 ;S RC=$$UPDLFV^RORUTL19(IENS798,.LFV) Q:RC<0 RC
+42 SET RC=$$UPDLFV^RORUTL19(IENS798,.LFV)
+43 ; UPDATE LOCAL REGISTRY DATA
if RC
SET RORFDA(798,IENS798,5)=1
+44 ;=== Add the COMMENT field to file 798 for pending patients
+45 IF STAT="P"
SET RORFDA(798,IENS798,12)=$GET(COMMENT)
+46 ;
+47 ;=== Update the record(s)
+48 IF $DATA(RORFDA)>1
Begin DoDot:1
+49 KILL RORMSG
DO FILE^DIE(,"RORFDA","RORMSG")
+50 ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
+51 if $GET(RORMSG("DIERR"))
SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
End DoDot:1
if RC<0
QUIT RC
+52 ;
+53 ;=== Success
+54 QUIT 0
