VPSMRARU ;WOIFO/BT - UPDATE LAST MRAR TIU IEN;1/15/15 11:26
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
QUIT
;
UPDATE(VPSRSLT,VPSNUM,VPSTYP,VPSTIEN) ; RPC: VPS UPDATE LAST MRAR TIU IEN
; This RPC will be called by Vetlink after successfully create TIU NOTE.
;
; INPUT
; VPSNUM : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSTYP : Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSTIEN : TIU Note IEN
;
; OUTPUT
; VPSRSLT : Result of operation (by reference)
; 1 - success, 0^exception - failed
;
S VPSNUM=$G(VPSNUM)
S VPSTYP=$G(VPSTYP)
S VPSTIEN=$G(VPSTIEN)
;
; -- validate input parameters
N VPSDFN S VPSDFN=$$VALIDATE^VPSRPC1(VPSTYP,VPSNUM)
I VPSDFN<1 S VPSRSLT="0^"_$P(VPSDFN,U,2) QUIT
I VPSTIEN'?1.N S VPSRSLT="0^Invalid TIU NOTE IEN" QUIT
I $$GET1^DIQ(8925,VPSTIEN_",",.02,"I")'=VPSDFN S VPSRSLT="0^DFN does not match DFN associated with TIU note" QUIT
;
; -- get last transaction for this patient
S VPSRSLT=$$GETLMRAR(VPSDFN)
QUIT:'VPSRSLT
;
; -- update MRAR TIU NOTE IEN
N LMRARDT S LMRARDT=VPSRSLT
L +^VPS(853.5,VPSDFN):2 E S VPSRSLT="0^There is another process updating File #853.5" Q
S VPSRSLT=$$UPDMRAR(VPSDFN,LMRARDT,VPSTIEN)
L -^VPS(853.5,VPSDFN)
;
QUIT VPSRSLT
;
GETLMRAR(VPSDFN) ;get last MRAR date for this patient (VPSDFN)
N LTRXNDT S LTRXNDT=$O(^VPS(853.5,VPSDFN,"MRAR","B",""),-1)
I LTRXNDT="" QUIT "0^This patient doesn't have any MRAR transaction"
QUIT LTRXNDT
;
UPDMRAR(VPSDFN,TRXNDT,VPSTIEN) ;update MRAR TIU NOTE ien
; INPUT
; VPSDFN : PATIENT DFN
; TRXNDT : Last MRAR Transaction Date for this patient
; VPSTIEN : TIU Note IEN
; RETURN
; 1 : successful update
; 0^exception : update failure
;
N RESULT S RESULT=1
N VPSFDA,VPSERR
S VPSFDA(853.51,TRXNDT_","_VPSDFN_",",105)=VPSTIEN
D FILE^DIE(,"VPSFDA","VPSERR")
I $D(VPSERR) D
. N ERRNUM S ERRNUM=0
. S ERRNUM=$O(VPSERR("DIERR",ERRNUM))
. S RESULT=0_U_VPSERR("DIERR",ERRNUM,"TEXT",1)
QUIT RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSMRARU 2163 printed Nov 22, 2024@17:53:05 Page 2
VPSMRARU ;WOIFO/BT - UPDATE LAST MRAR TIU IEN;1/15/15 11:26
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 15, 2015;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
UPDATE(VPSRSLT,VPSNUM,VPSTYP,VPSTIEN) ; RPC: VPS UPDATE LAST MRAR TIU IEN
+1 ; This RPC will be called by Vetlink after successfully create TIU NOTE.
+2 ;
+3 ; INPUT
+4 ; VPSNUM : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+5 ; VPSTYP : Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+6 ; VPSTIEN : TIU Note IEN
+7 ;
+8 ; OUTPUT
+9 ; VPSRSLT : Result of operation (by reference)
+10 ; 1 - success, 0^exception - failed
+11 ;
+12 SET VPSNUM=$GET(VPSNUM)
+13 SET VPSTYP=$GET(VPSTYP)
+14 SET VPSTIEN=$GET(VPSTIEN)
+15 ;
+16 ; -- validate input parameters
+17 NEW VPSDFN
SET VPSDFN=$$VALIDATE^VPSRPC1(VPSTYP,VPSNUM)
+18 IF VPSDFN<1
SET VPSRSLT="0^"_$PIECE(VPSDFN,U,2)
QUIT
+19 IF VPSTIEN'?1.N
SET VPSRSLT="0^Invalid TIU NOTE IEN"
QUIT
+20 IF $$GET1^DIQ(8925,VPSTIEN_",",.02,"I")'=VPSDFN
SET VPSRSLT="0^DFN does not match DFN associated with TIU note"
QUIT
+21 ;
+22 ; -- get last transaction for this patient
+23 SET VPSRSLT=$$GETLMRAR(VPSDFN)
+24 if 'VPSRSLT
QUIT
+25 ;
+26 ; -- update MRAR TIU NOTE IEN
+27 NEW LMRARDT
SET LMRARDT=VPSRSLT
+28 LOCK +^VPS(853.5,VPSDFN):2
IF '$TEST
SET VPSRSLT="0^There is another process updating File #853.5"
QUIT
+29 SET VPSRSLT=$$UPDMRAR(VPSDFN,LMRARDT,VPSTIEN)
+30 LOCK -^VPS(853.5,VPSDFN)
+31 ;
+32 QUIT VPSRSLT
+33 ;
GETLMRAR(VPSDFN) ;get last MRAR date for this patient (VPSDFN)
+1 NEW LTRXNDT
SET LTRXNDT=$ORDER(^VPS(853.5,VPSDFN,"MRAR","B",""),-1)
+2 IF LTRXNDT=""
QUIT "0^This patient doesn't have any MRAR transaction"
+3 QUIT LTRXNDT
+4 ;
UPDMRAR(VPSDFN,TRXNDT,VPSTIEN) ;update MRAR TIU NOTE ien
+1 ; INPUT
+2 ; VPSDFN : PATIENT DFN
+3 ; TRXNDT : Last MRAR Transaction Date for this patient
+4 ; VPSTIEN : TIU Note IEN
+5 ; RETURN
+6 ; 1 : successful update
+7 ; 0^exception : update failure
+8 ;
+9 NEW RESULT
SET RESULT=1
+10 NEW VPSFDA,VPSERR
+11 SET VPSFDA(853.51,TRXNDT_","_VPSDFN_",",105)=VPSTIEN
+12 DO FILE^DIE(,"VPSFDA","VPSERR")
+13 IF $DATA(VPSERR)
Begin DoDot:1
+14 NEW ERRNUM
SET ERRNUM=0
+15 SET ERRNUM=$ORDER(VPSERR("DIERR",ERRNUM))
+16 SET RESULT=0_U_VPSERR("DIERR",ERRNUM,"TEXT",1)
End DoDot:1
+17 QUIT RESULT
