MAGTP014 ;WOIFO/FG - TELEPATHOLOGY RPCS ; 03/28/2012 2:50pm
;;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 ;
;
;***** GET THE TEXT OF A NOTE ATTACHED TO A SPECIFIED CASE
; RPC: MAGTP GET NOTE
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; LRAC Accession Code for the case
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: Total Number of Lines
;
; MAGRY(i) Description
; ^01: Note Line of Text
;
GETNOTE(MAGRY,LRAC) ; RPC [MAGTP GET NOTE]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I LRAC="" S MAGRY(0)="0^0^No Accession Code" Q
N MAGREC,MAGOUT,MAGERR,CT,I
S MAGREC=$O(^MAG(2005.42,"B",LRAC,""))
I MAGREC="" S MAGRY(0)="0^0^Invalid Accession Code" Q
D GET1^DIQ(2005.42,MAGREC_",",3,"","MAGOUT","MAGERR")
I $D(MAGERR) D Q
. S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
S (CT,I)=0
F S I=$O(MAGOUT(I)) Q:I="" D
. S CT=CT+1
. S MAGRY(CT)=MAGOUT(I)
. Q
S MAGRY(0)="1^"_CT
Q ;
;
;***** RECORD THE TEXT OF A NOTE ATTACHED TO A SPECIFIED CASE
; RPC: MAGTP PUT NOTE
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; .ENT Input array. One line of note text must be
; on each line of the array
;
; LRAC Accession Code for the case
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: 0
; ^03: "<LRAC> Note Updated"
;
PUTNOTE(MAGRY,ENT,LRAC) ; RPC [MAGTP PUT NOTE]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I LRAC="" S MAGRY(0)="0^0^No Accession Code" Q
N MAGREC,I,LINE,MAGFDA,MAGERR,MAGROOT,NOW,USER
S MAGREC=$O(^MAG(2005.42,"B",LRAC,""))
I MAGREC="" S MAGRY(0)="0^0^Invalid Accession Code" Q
;Only append no delete(WPR)
D ; enter new text, or clear old text?
. ;I $D(ENT)<10 S MAGROOT="@" Q ; clear old text
. ; enter (override) new text
. S MAGROOT="MAGFDA",(I,LINE)=""
. F S LINE=$O(ENT(LINE)) Q:LINE="" D
. . S I=I+1
. . S MAGFDA(I)=ENT(LINE) ; FDA arrays cannot start from 0
. . Q
. D GETS^DIQ(200,+DUZ,.01,"E","USER") S MAGFDA(I+1)="Added by: "_USER(200,+DUZ_",",.01,"E")
. S NOW=$$NOW^XLFDT(),MAGFDA(I+2)=" On: "_$$FMTE^XLFDT(NOW) ;DT/TM
. S MAGFDA(I+3)=" " F LINE=1:1:32 S MAGFDA(I+4)="- "_$G(MAGFDA(I+4))
. S MAGFDA(I+5)=" "
. Q
D WP^DIE(2005.42,MAGREC_",",3,"A",MAGROOT,"MAGERR") ; Whole text killed for WP
I $D(MAGERR) D Q
. S MAGRY(0)="0^0^Updating Error: "_MAGERR("DIERR",1,"TEXT",1)
S MAGRY(0)="1^0^"_LRAC_" Note "_$S(MAGROOT="MAGFDA":"Updated",MAGROOT="@":"Deleted",1:"Disposition Unknown")
Q ;
;
;***** GET THE RETENTION DAYS OF A UNREAD WORKLIST FROM SITE
; RPC: MAGTP GET RETENTION DAYS
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; SITE Site number (e.g.: 660)
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: Total Number of Lines
; MAGRY(1) Description
; ^01: Retention Days
;
GETRTDAY(MAGRY,SITE) ; RPC [MAGTP GET RETENTION DAYS]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I $G(SITE)="" S SITE=$G(DUZ(2)) I SITE<1 S MAGRY(0)="0^0^No SITE Info" Q
N MAGPLACE
S MAGPLACE=+$O(^MAG(2006.1,"B",SITE,""))
I MAGPLACE<1 S MAGRY(0)="0^0^No SITE Info ("_SITE_") in #2006.1" Q
S MAGRY(1)=+$G(^MAG(2006.1,MAGPLACE,"TELEPATH")),MAGRY(0)="1^1"
Q ;
;
;***** SET THE RETENTION DAYS OF A UNREAD WORKLIST FOR SITE
; RPC: MAGTP SET RETENTION DAYS
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; DAYS Read list retention days (0-90)
;
; SITE Site number (e.g.: 660)
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1 SUCCESS
;
;
SETRTDAY(MAGRY,DAYS,SITE) ; RPC [MAGTP SET RETENTION DAYS]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I $G(SITE)="" S SITE=$G(DUZ(2)) I SITE<1 S MAGRY(0)="0^0^No SITE INFO" Q
I +$G(DAYS)<0 S MAGRY(0)="0^0^Invalide Retention Days ("_$G(DAYS)_")" Q
N MAGPLACE
S MAGPLACE=+$O(^MAG(2006.1,"B",SITE,""))
I MAGPLACE<1 S MAGRY(0)="0^0^No SITE Info ("_SITE_") in #2006.1" Q
s $P(^MAG(2006.1,MAGPLACE,"TELEPATH"),"^")=DAYS
S MAGRY(0)="1"
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP014 6296 printed Dec 13, 2024@02:08:46 Page 2
MAGTP014 ;WOIFO/FG - TELEPATHOLOGY RPCS ; 03/28/2012 2:50pm
+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 ;***** GET THE TEXT OF A NOTE ATTACHED TO A SPECIFIED CASE
+20 ; RPC: MAGTP GET NOTE
+21 ;
+22 ; .MAGRY Reference to a local variable where the results
+23 ; are returned to.
+24 ;
+25 ; LRAC Accession Code for the case
+26 ;
+27 ; Return Values
+28 ; =============
+29 ;
+30 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+31 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+32 ;
+33 ; Otherwise, the output array is as follows:
+34 ;
+35 ; MAGRY(0) Description
+36 ; ^01: 1
+37 ; ^02: Total Number of Lines
+38 ;
+39 ; MAGRY(i) Description
+40 ; ^01: Note Line of Text
+41 ;
GETNOTE(MAGRY,LRAC) ; RPC [MAGTP GET NOTE]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF LRAC=""
SET MAGRY(0)="0^0^No Accession Code"
QUIT
+4 NEW MAGREC,MAGOUT,MAGERR,CT,I
+5 SET MAGREC=$ORDER(^MAG(2005.42,"B",LRAC,""))
+6 IF MAGREC=""
SET MAGRY(0)="0^0^Invalid Accession Code"
QUIT
+7 DO GET1^DIQ(2005.42,MAGREC_",",3,"","MAGOUT","MAGERR")
+8 IF $DATA(MAGERR)
Begin DoDot:1
+9 SET MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:1
QUIT
+10 SET (CT,I)=0
+11 FOR
SET I=$ORDER(MAGOUT(I))
if I=""
QUIT
Begin DoDot:1
+12 SET CT=CT+1
+13 SET MAGRY(CT)=MAGOUT(I)
+14 QUIT
End DoDot:1
+15 SET MAGRY(0)="1^"_CT
+16 ;
QUIT
+17 ;
+18 ;***** RECORD THE TEXT OF A NOTE ATTACHED TO A SPECIFIED CASE
+19 ; RPC: MAGTP PUT NOTE
+20 ;
+21 ; .MAGRY Reference to a local variable where the results
+22 ; are returned to.
+23 ;
+24 ; .ENT Input array. One line of note text must be
+25 ; on each line of the array
+26 ;
+27 ; LRAC Accession Code for the case
+28 ;
+29 ; Return Values
+30 ; =============
+31 ;
+32 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+33 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+34 ;
+35 ; Otherwise, the output array is as follows:
+36 ;
+37 ; MAGRY(0) Description
+38 ; ^01: 1
+39 ; ^02: 0
+40 ; ^03: "<LRAC> Note Updated"
+41 ;
PUTNOTE(MAGRY,ENT,LRAC) ; RPC [MAGTP PUT NOTE]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF LRAC=""
SET MAGRY(0)="0^0^No Accession Code"
QUIT
+4 NEW MAGREC,I,LINE,MAGFDA,MAGERR,MAGROOT,NOW,USER
+5 SET MAGREC=$ORDER(^MAG(2005.42,"B",LRAC,""))
+6 IF MAGREC=""
SET MAGRY(0)="0^0^Invalid Accession Code"
QUIT
+7 ;Only append no delete(WPR)
+8 ; enter new text, or clear old text?
Begin DoDot:1
+9 ;I $D(ENT)<10 S MAGROOT="@" Q ; clear old text
+10 ; enter (override) new text
+11 SET MAGROOT="MAGFDA"
SET (I,LINE)=""
+12 FOR
SET LINE=$ORDER(ENT(LINE))
if LINE=""
QUIT
Begin DoDot:2
+13 SET I=I+1
+14 ; FDA arrays cannot start from 0
SET MAGFDA(I)=ENT(LINE)
+15 QUIT
End DoDot:2
+16 DO GETS^DIQ(200,+DUZ,.01,"E","USER")
SET MAGFDA(I+1)="Added by: "_USER(200,+DUZ_",",.01,"E")
+17 ;DT/TM
SET NOW=$$NOW^XLFDT()
SET MAGFDA(I+2)=" On: "_$$FMTE^XLFDT(NOW)
+18 SET MAGFDA(I+3)=" "
FOR LINE=1:1:32
SET MAGFDA(I+4)="- "_$GET(MAGFDA(I+4))
+19 SET MAGFDA(I+5)=" "
+20 QUIT
End DoDot:1
+21 ; Whole text killed for WP
DO WP^DIE(2005.42,MAGREC_",",3,"A",MAGROOT,"MAGERR")
+22 IF $DATA(MAGERR)
Begin DoDot:1
+23 SET MAGRY(0)="0^0^Updating Error: "_MAGERR("DIERR",1,"TEXT",1)
End DoDot:1
QUIT
+24 SET MAGRY(0)="1^0^"_LRAC_" Note "_$SELECT(MAGROOT="MAGFDA":"Updated",MAGROOT="@":"Deleted",1:"Disposition Unknown")
+25 ;
QUIT
+26 ;
+27 ;***** GET THE RETENTION DAYS OF A UNREAD WORKLIST FROM SITE
+28 ; RPC: MAGTP GET RETENTION DAYS
+29 ;
+30 ; .MAGRY Reference to a local variable where the results
+31 ; are returned to.
+32 ;
+33 ; SITE Site number (e.g.: 660)
+34 ;
+35 ; Return Values
+36 ; =============
+37 ;
+38 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+39 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+40 ;
+41 ; Otherwise, the output array is as follows:
+42 ;
+43 ; MAGRY(0) Description
+44 ; ^01: 1
+45 ; ^02: Total Number of Lines
+46 ; MAGRY(1) Description
+47 ; ^01: Retention Days
+48 ;
GETRTDAY(MAGRY,SITE) ; RPC [MAGTP GET RETENTION DAYS]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF $GET(SITE)=""
SET SITE=$GET(DUZ(2))
IF SITE<1
SET MAGRY(0)="0^0^No SITE Info"
QUIT
+4 NEW MAGPLACE
+5 SET MAGPLACE=+$ORDER(^MAG(2006.1,"B",SITE,""))
+6 IF MAGPLACE<1
SET MAGRY(0)="0^0^No SITE Info ("_SITE_") in #2006.1"
QUIT
+7 SET MAGRY(1)=+$GET(^MAG(2006.1,MAGPLACE,"TELEPATH"))
SET MAGRY(0)="1^1"
+8 ;
QUIT
+9 ;
+10 ;***** SET THE RETENTION DAYS OF A UNREAD WORKLIST FOR SITE
+11 ; RPC: MAGTP SET RETENTION DAYS
+12 ;
+13 ; .MAGRY Reference to a local variable where the results
+14 ; are returned to.
+15 ;
+16 ; DAYS Read list retention days (0-90)
+17 ;
+18 ; SITE Site number (e.g.: 660)
+19 ;
+20 ; Return Values
+21 ; =============
+22 ;
+23 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+24 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+25 ;
+26 ; Otherwise, the output array is as follows:
+27 ;
+28 ; MAGRY(0) Description
+29 ; ^01: 1 SUCCESS
+30 ;
+31 ;
SETRTDAY(MAGRY,DAYS,SITE) ; RPC [MAGTP SET RETENTION DAYS]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF $GET(SITE)=""
SET SITE=$GET(DUZ(2))
IF SITE<1
SET MAGRY(0)="0^0^No SITE INFO"
QUIT
+4 IF +$GET(DAYS)<0
SET MAGRY(0)="0^0^Invalide Retention Days ("_$GET(DAYS)_")"
QUIT
+5 NEW MAGPLACE
+6 SET MAGPLACE=+$ORDER(^MAG(2006.1,"B",SITE,""))
+7 IF MAGPLACE<1
SET MAGRY(0)="0^0^No SITE Info ("_SITE_") in #2006.1"
QUIT
+8 SET $PIECE(^MAG(2006.1,MAGPLACE,"TELEPATH"),"^")=DAYS
+9 SET MAGRY(0)="1"
+10 ;
QUIT
+11 ;
