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

RORRP034.m

Go to the documentation of this file. 
  1. 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
  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.  ;******************************************************************************
  1.  ;                       --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*14   APR  2011   A SAUNDERS   SAVE1: Added AIDS DX - FIRST DIAGNOSED
  1.  ;                                      (#12.08) to the data that gets saved in
  1.  ;                                      file 799.4.  Modified logic for the
  1.  ;                                      CLINICAL AIDS DATE (#.03) to correctly
  1.  ;                                      handle additional values (null/0/1/9).
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;
  1.  ;***** UPDATES THE PATIENT'S REGISTRY DATA
  1.  ; RPC: [RORICR 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 RORICR
  1.  ;               PATIENT LOAD remote procedure. Only PH, ICR, and
  1.  ;               LFV segments are processed; the others are ignored.
  1.  ;
  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^RORRP034",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),LOCK(799.4,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),LOCK(799.4,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. 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.  . ;--- Risk factors
  1.  . I SEG="PH"  D  Q
  1.  . . S RC=$$CDCFDA^RORRP026(IENS798,"PH^RORRP026",DATA(RDI),.RORFDA)
  1.  . ;--- Registry data
  1.  . I SEG="ICR"  D  Q
  1.  . . S TMP=$P(DATA(RDI),U,3)
  1.  . . S RORFDA(799.4,IENS798,.02)=$G(TMP) ;clinical AIDS
  1.  . . ;S RORFDA(799.4,IENS798,.03)=$S(TMP:$P(DATA(RDI),U,4),1:"")
  1.  . . S RORFDA(799.4,IENS798,.03)=$S($G(TMP)=1:$P(DATA(RDI),U,4),1:"") ;clinical AIDS date
  1.  . . S RORFDA(799.4,IENS798,12.08)=$P(DATA(RDI),U,6) ;first VA site to diagnose HIV
  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.  ;=== Update the COMMENTS field
  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.  . ; UPDATE LOCAL REGISTRY DATA
  1.  . K RORMSG D FILE^DIE(,"RORFDA","RORMSG")
  1.  . ;S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
  1.  . S:$G(RORMSG("DIERR")) RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,"798&799.4",IENS798)
  1.  ;
  1.  ;=== Success
  1.  Q 0