MAGTP003 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:38 PM
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q ;
;
;***** SET/UNSET A LOGICAL LOCK ON A RECORD FOR CASE RESERVATION
; RPC: MAGTP RESERVE CASE
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; LFLAG Flag that controls whether to lock or unlock
; (0:Unlocked, 1:Locked)
;
; LRSS AP Section
;
; YEAR Accession Year (Two figures)
;
; LRAN Accession Number
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is < 0, then an error
; occurred during execution of the procedure: <code>^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 0
; ^02: 0 if case record is unlocked, 1 if case record is locked
; ^03: "Reservation ended" if case record is unlocked
; "Case reserved" if case record is locked
;
LOCKR(MAGRY,LFLAG,LRSS,YEAR,LRAN) ; RPC [MAGTP RESERVE CASE]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGUTERR"
D Q:$G(MAGRY(0)) ; validate inputs
. I $G(LRSS)="" S MAGRY(0)="-2^^ERROR: AP subsection not specified" Q
. I $G(YEAR)="" S MAGRY(0)="-3^^ERROR: Year not specified" Q
. I $G(LRAN)="" S MAGRY(0)="-4^^ERROR: Accession index not specified" Q
. Q
N INPUT
D Q:$G(MAGRY(0)) ; validate context
. N OUT
. S INPUT=$$CONTEXT^MAGTP006(.OUT,LRSS,YEAR,LRAN)
. D:'$G(OUT(0)) ; context not OK
. . S MAGRY(0)="-5^^ERROR: Invalid context - "
. . S MAGRY(0)=MAGRY(0)_$P(OUT(0),"^",3)
. . Q
. Q
N MAGFDA,MAGERR
N LRSF,IEN,LRAC,REC,ISLOCK
N LDT,LDUZ,LUSER,TEXT,LRAA,YR
S LRSF=$P(INPUT,","),IEN=$P(INPUT,",",2,4)
S LRAC=$$GET1^DIQ(LRSF,IEN,.06) ; Accession code
D:LRAC="" ;try new style (LEDI)
. S LRAA=$O(^LRO(68,"B",LRSS,0)) ;new style cases
. S YR=$S($L(YEAR)=2:300+YEAR*10000,1:YEAR) ;try 2000
. I +$P($G(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1) S LRAC=$G(^LRO(68,LRAA,1,YR,1,LRAN,.2)) Q:LRAC]""
. S YR=$S($L(YEAR)=2:200+YEAR*10000,1:YEAR) ;try 1900
. I +$P($G(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1) S LRAC=$G(^LRO(68,LRAA,1,YR,1,LRAN,.2))
. Q
I LRAC="" S MAGRY(0)="-6^^ERROR: No Accession Code for this case " Q
S REC=$O(^MAG(2005.42,"B",LRAC,""))_"," ; Record number
;
; Update lock record with present user's data (or clear lock)
;
S MAGFDA(2005.42,REC,1)=LFLAG
S MAGFDA(2005.42,REC,1.1)=$S(LFLAG:$$NOW^XLFDT,1:"")
S MAGFDA(2005.42,REC,1.2)=$S(LFLAG:DUZ,1:"")
D UPDATE^DIE("","MAGFDA","","MAGERR") ; Update lock record
I $D(MAGERR) S MAGRY(0)="-7^^ERROR: Update error - "_MAGERR("DIERR",1,"TEXT",1) Q
;
S TEXT=$S(LFLAG:"1^Case reserved",1:"0^Reservation ended")
S MAGRY(0)="0^"_TEXT
Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP003 3874 printed Apr 09, 2024@21:07:02 Page 2
MAGTP003 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:38 PM
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
QUIT
+18 ;
+19 ;***** SET/UNSET A LOGICAL LOCK ON A RECORD FOR CASE RESERVATION
+20 ; RPC: MAGTP RESERVE CASE
+21 ;
+22 ; .MAGRY Reference to a local variable where the results
+23 ; are returned to.
+24 ;
+25 ; LFLAG Flag that controls whether to lock or unlock
+26 ; (0:Unlocked, 1:Locked)
+27 ;
+28 ; LRSS AP Section
+29 ;
+30 ; YEAR Accession Year (Two figures)
+31 ;
+32 ; LRAN Accession Number
+33 ;
+34 ; Return Values
+35 ; =============
+36 ;
+37 ; If MAGRY(0) 1st '^'-piece is < 0, then an error
+38 ; occurred during execution of the procedure: <code>^0^ ERROR explanation
+39 ;
+40 ; Otherwise, the output array is as follows:
+41 ;
+42 ; MAGRY(0) Description
+43 ; ^01: 0
+44 ; ^02: 0 if case record is unlocked, 1 if case record is locked
+45 ; ^03: "Reservation ended" if case record is unlocked
+46 ; "Case reserved" if case record is locked
+47 ;
LOCKR(MAGRY,LFLAG,LRSS,YEAR,LRAN) ; RPC [MAGTP RESERVE CASE]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGUTERR"
+3 ; validate inputs
Begin DoDot:1
+4 IF $GET(LRSS)=""
SET MAGRY(0)="-2^^ERROR: AP subsection not specified"
QUIT
+5 IF $GET(YEAR)=""
SET MAGRY(0)="-3^^ERROR: Year not specified"
QUIT
+6 IF $GET(LRAN)=""
SET MAGRY(0)="-4^^ERROR: Accession index not specified"
QUIT
+7 QUIT
End DoDot:1
if $GET(MAGRY(0))
QUIT
+8 NEW INPUT
+9 ; validate context
Begin DoDot:1
+10 NEW OUT
+11 SET INPUT=$$CONTEXT^MAGTP006(.OUT,LRSS,YEAR,LRAN)
+12 ; context not OK
if '$GET(OUT(0))
Begin DoDot:2
+13 SET MAGRY(0)="-5^^ERROR: Invalid context - "
+14 SET MAGRY(0)=MAGRY(0)_$PIECE(OUT(0),"^",3)
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
if $GET(MAGRY(0))
QUIT
+17 NEW MAGFDA,MAGERR
+18 NEW LRSF,IEN,LRAC,REC,ISLOCK
+19 NEW LDT,LDUZ,LUSER,TEXT,LRAA,YR
+20 SET LRSF=$PIECE(INPUT,",")
SET IEN=$PIECE(INPUT,",",2,4)
+21 ; Accession code
SET LRAC=$$GET1^DIQ(LRSF,IEN,.06)
+22 ;try new style (LEDI)
if LRAC=""
Begin DoDot:1
+23 ;new style cases
SET LRAA=$ORDER(^LRO(68,"B",LRSS,0))
+24 ;try 2000
SET YR=$SELECT($LENGTH(YEAR)=2:300+YEAR*10000,1:YEAR)
+25 IF +$PIECE($GET(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1)
SET LRAC=$GET(^LRO(68,LRAA,1,YR,1,LRAN,.2))
if LRAC]""
QUIT
+26 ;try 1900
SET YR=$SELECT($LENGTH(YEAR)=2:200+YEAR*10000,1:YEAR)
+27 IF +$PIECE($GET(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1)
SET LRAC=$GET(^LRO(68,LRAA,1,YR,1,LRAN,.2))
+28 QUIT
End DoDot:1
+29 IF LRAC=""
SET MAGRY(0)="-6^^ERROR: No Accession Code for this case "
QUIT
+30 ; Record number
SET REC=$ORDER(^MAG(2005.42,"B",LRAC,""))_","
+31 ;
+32 ; Update lock record with present user's data (or clear lock)
+33 ;
+34 SET MAGFDA(2005.42,REC,1)=LFLAG
+35 SET MAGFDA(2005.42,REC,1.1)=$SELECT(LFLAG:$$NOW^XLFDT,1:"")
+36 SET MAGFDA(2005.42,REC,1.2)=$SELECT(LFLAG:DUZ,1:"")
+37 ; Update lock record
DO UPDATE^DIE("","MAGFDA","","MAGERR")
+38 IF $DATA(MAGERR)
SET MAGRY(0)="-7^^ERROR: Update error - "_MAGERR("DIERR",1,"TEXT",1)
QUIT
+39 ;
+40 SET TEXT=$SELECT(LFLAG:"1^Case reserved",1:"0^Reservation ended")
+41 SET MAGRY(0)="0^"_TEXT
+42 ;
QUIT
