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

RORRP037.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 10-92-142, this routine should not be modified.
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #2053         FILE^DIC (supported)
  1.  Q
  1.  ;
  1.  ;***** UPDATES THE PATIENT'S REGISTRY DATA
  1.  ; RPC: [RORHEPC PATIENT SAVE]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; PTIEN         IEN of the registry patient (DFN)
  1.  ;
  1.  ; [CANCEL]      Cancel the update and unlock the registry data
  1.  ;
  1.  ; .DATA         Reference to a local array that contains the data
  1.  ;               in the same format as the output of the RORHEPC
  1.  ;               PATIENT LOAD remote procedure. Only HEPC and LFV
  1.  ;               segments are processed; the others are ignored.
  1.  ; Revision for Patch 1.5*8 to add comments
  1.  ;   In DATA array there will be a 3 piece record, formated as follows
  1.  ; PC^STAT^COMMENT  If STAT is P then the COMMENT will be added. If
  1.  ;                  STAT is C then the COMMENT will be a blank.
  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).
  1.  ;
  1. SAVE(RESULTS,REGIEN,PTIEN,CANCEL,DATA) ;
  1.  N IENS,LOCK,RC,RORERRDL,STAT,COMMENT
  1.  D CLEAR^RORERR("SAVE^RORRP037",1)
  1.  K RESULTS  S (RESULTS(0),RC)=0
  1.  D
  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(PTIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"PTIEN",$G(PTIEN))
  1.  . S PTIEN=+PTIEN
  1.  . ;--- Get the IENS of the registry record
  1.  . S IENS=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
  1.  . S:IENS>0 LOCK(798,IENS)=""
  1.  . Q:$G(CANCEL)=1
  1.  . ;--- Save the data
  1.  . S RC=$$SAVE1(.IENS)
  1.  . I '$D(LOCK)  S:IENS>0 LOCK(798,IENS)=""
  1.  . S:RC>0 RESULTS(0)=RC
  1.  ;
  1.  ;--- Do not unlock the records if there are errors in the data
  1.  ;    (positive value is returned by the $$SAVE1), since the user
  1.  ;--- will have another chance to correct the data and save it.
  1.  D:RC'>0 UNLOCK^RORLOCK(.LOCK)
  1.  D:RC<0 RPCSTK^RORERR(.RESULTS,RC)
  1.  Q
  1.  ;
  1.  ;***** INTERNAL ENTRY POINT THAT UPDATES THE REGISTRY DATA
  1.  ;
  1.  ; IENS798       IENS of the registry record in the file #798
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. SAVE1(IENS798) ;
  1.  N IENS,LFIEN,LFV,RC,RDI,REGNAME,RORFDA,RORMSG,SEG,TMP
  1.  ;
  1.  ;=== Add the patient to the registry if necessary
  1.  I IENS798'>0  S RC=0  D  Q:RC<0 RC
  1.  . S REGNAME=$P($$REGNAME^RORUTL01(REGIEN),U)
  1.  . ;--- Add the patient to the registry
  1.  . S RC=$$ADDPAT^RORUPD06(PTIEN,REGNAME)  Q:RC<0
  1.  . ;--- Get the IENS of the registry record
  1.  . S IENS798=$$PRRIEN^RORUTL01(PTIEN,REGIEN)_","
  1.  . S:IENS798'>0 RC=$$ERROR^RORERR(-97,,,PTIEN,REGNAME)
  1.  ;
  1.  ;=== Prepare the data
  1.  N LFCNT ;added 'new' statement
  1.  S (LFCNT,RDI,RC)=0
  1.  F  S RDI=$O(DATA(RDI))  Q:RDI'>0  D  Q:RC
  1.  . S SEG=$P(DATA(RDI),U)
  1.  . ;--- Registry data
  1.  . I SEG="HEPC"  D  Q
  1.  . . ; Insert code here if/when necessary
  1.  . ;--- Local field values
  1.  . I SEG="LFV"  D  Q
  1.  . . S LFIEN=+$P(DATA(RDI),U,3)
  1.  . . S:LFIEN>0 LFV(LFIEN)=DATA(RDI)
  1.  . ;--- If there is a comment for a Pending Patient
  1.  . I SEG="PC" D  Q
  1.  . . S STAT=$P(DATA(RDI),U,2)
  1.  . . S COMMENT=$P(DATA(RDI),U,3)
  1.  Q:RC RC
  1.  ;
  1.  ;=== Confirm the pending patient
  1.  ;D:$$GET1^DIQ(798,IENS798,3,"I",,"RORMSG")=4
  1.  I CANCEL=0 D
  1.  . ;--- Do not clear the DON'T SEND flag for 'test' patients
  1.  . S:'$$TESTPAT^RORUTL01(PTIEN) RORFDA(798,IENS798,11)="@"
  1.  . ;--- Change the STATUS from 'Pending' to 'Active'
  1.  . S RORFDA(798,IENS798,3)=0
  1.  . ;--- Delete any comment fields
  1.  . S RORFDA(798,IENS798,12)=" "
  1.  ;
  1.  ;=== Update local fields
  1.  ;S RC=$$UPDLFV^RORUTL19(IENS798,.LFV)  Q:RC<0 RC
  1.  S RC=$$UPDLFV^RORUTL19(IENS798,.LFV)
  1.  S:RC RORFDA(798,IENS798,5)=1  ; UPDATE LOCAL REGISTRY DATA
  1.  ;=== Add the COMMENT field to file 798 for pending patients
  1.  I STAT="P" S RORFDA(798,IENS798,12)=$G(COMMENT)
  1.  ;
  1.  ;=== Update the record(s)
  1.  I $D(RORFDA)>1  D  Q:RC<0 RC
  1.  . K RORMSG D FILE^DIE(,"RORFDA","RORMSG")
  1.  . ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
  1.  . S:$G(RORMSG("DIERR")) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS798)
  1.  ;
  1.  ;=== Success
  1.  Q 0