- 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 Feb 18, 2025@23:35:06 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