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