- MAGGTSYS ;WOIFO/GEK/NST - Calls from Imaging windows for System Manager ; 22 Dec 2010 10:51 AM
- ;;3.0;IMAGING;**59,93,117,185,188**;Mar 19, 2002;Build 61;Mar 18, 2018
- ;; 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
- ; GETS
- ; Called from Image Information Advanced in Clinical Display
- ; NODE: integer or "" or integer^integer or "N"_integer
- ; if Integer - this is IMAGE IEN, we display IMAGE entry for IEN
- ; if "" - we defalut to Last entry in IMAGE File.
- ; if int^int - this is FILE^IEN, we display FM Files for FILE IEN
- ; if "N"_int - this is Patch 185 Call.
- ;
- GETS(MAGRY,NODE,FLAGS) ; USE GETS^DIQ TO GET FIELD VALUES.
- N MAGWIN,I,CT,Y,NC,MAGOUT,MAGERR,TNC,ZZ,MAGIEN,MAGFILE
- N N0
- S MAGRY=$NA(^TMP("MAGNODE",$J))
- K @MAGRY
- I $L(NODE,"^")>1 D OTH Q ;
- I NODE'?.1"N"1.N S @MAGRY@(0)="Node IEN "_NODE_" invalid"
- I NODE?1"N"1.N D Q
- . N MAGVIEN
- . S MAGVIEN=$E(NODE,2,999)
- . D IMGINFO^MAGNVQ03(MAGRY,MAGVIEN) ; Get P34 report
- . I $G(@MAGRY@(0)) S @MAGRY@(0)="****** Fields for Image IEN: "_MAGVIEN_" ******" Q
- . Q
- S NODE=+$G(NODE)
- I 'NODE S NODE=$P(^MAG(2005,0),U,3)
- S MAGIEN=NODE
- S MAGFILE=$$FILE^MAGGI11(NODE)
- S MAGWIN=$$BROKER^XWBLIB
- I 'MAGWIN W !,"MAGIEN"," ",MAGIEN
- K @MAGRY
- S @MAGRY@(0)="****** Fields for "_$S(MAGFILE=2005.1:"DELETED ",1:"")_"Image IEN: "_MAGIEN_" ******"
- S I=0,CT=0
- S FLAGS=$S($L($G(FLAGS)):FLAGS,1:"IERN")
- I MAGFILE'>0 Q ; problem getting file number
- D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- D LOAD
- I 'MAGWIN W !,"AFTER LOAD","MAGIEN= ",MAGIEN
- S N0=$G(^MAG(2005,MAGIEN,0))
- S MAGIEN=$P(N0,"^",3) I MAGIEN]"" D ;
- . S MAGFILE="2005.2"
- . S CT=CT+1,@MAGRY@(CT)=" ====== FULL File(Tier1): NETWORK LOCATION "_MAGIEN_" ======================"
- . D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- . D LOAD
- S MAGIEN=$P(N0,"^",4) I MAGIEN]"" D ;
- . S MAGFILE="2005.2"
- . S CT=CT+1,@MAGRY@(CT)=" ====== Abstract(Tier1): NETWORK LOCATION "_MAGIEN_" ======================"
- . D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- . D LOAD
- S MAGIEN=$P(N0,"^",5) I MAGIEN]"" D ;
- . S MAGFILE="2005.2"
- . S CT=CT+1,@MAGRY@(CT)=" ====== JukeBox(Tier2): NETWORK LOCATION "_MAGIEN_" ======================"
- . D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- . D LOAD
- Q
- ;
- LOAD ; p188 T3
- S NC=MAGIEN_","
- S I="" F S I=$O(MAGOUT(MAGFILE,NC,I)) Q:I="" D
- . S CT=CT+1
- . I $G(MAGOUT(MAGFILE,NC,I,"I"))=$G(MAGOUT(MAGFILE,NC,I,"E")) D Q
- . . S ZZ=I,$E(ZZ,45,999)=" = "_$G(MAGOUT(MAGFILE,NC,I,"E"))
- . . S @MAGRY@(CT)=ZZ
- . . Q
- . ;
- . S ZZ=I,$E(ZZ,25,999)=" = ("_$G(MAGOUT(MAGFILE,NC,I,"I"))_") "
- . I ($L(ZZ)>44) S ZZ=ZZ_" = "_$G(MAGOUT(MAGFILE,NC,I,"E")) S @MAGRY@(CT)=ZZ Q
- . I ($L(ZZ)<45) S $E(ZZ,45,999)=" = "_$G(MAGOUT(MAGFILE,NC,I,"E")) S @MAGRY@(CT)=ZZ Q
- . Q
- I $P($G(^MAG(MAGFILE,MAGIEN,2)),"^",6)=8925 D
- . K MAGOUT,MAGERR
- . S CT=CT+1,@MAGRY@(CT)=" *************** TIU *************** "
- . S CT=CT+1,@MAGRY@(CT)=" **** Field Values for TIUDA: "_$P(^MAG(MAGFILE,MAGIEN,2),"^",7)_" ****"
- . D GETS^DIQ(8925,$P(^MAG(MAGFILE,MAGIEN,2),"^",7),"*",FLAGS,"MAGOUT","MAGERR")
- . S NC=$P(^MAG(MAGFILE,MAGIEN,2),"^",7)_","
- . S I="" F S I=$O(MAGOUT(8925,NC,I)) Q:I="" D
- . . S CT=CT+1
- . . I $G(MAGOUT(8925,NC,I,"I"))=$G(MAGOUT(8925,NC,I,"E")) D Q
- . . . S ZZ=I,$E(ZZ,45,999)=" = "_$G(MAGOUT(8925,NC,I,"E"))
- . . . S @MAGRY@(CT)=ZZ
- . . . Q
- . . ;
- . . S ZZ=I,$E(ZZ,25,999)=" = ("_$G(MAGOUT(8925,NC,I,"I"))_") "
- . . I ($L(ZZ)>44) S ZZ=ZZ_" = "_$G(MAGOUT(8925,NC,I,"E")) S @MAGRY@(CT)=ZZ Q
- . . I ($L(ZZ)<45) S $E(ZZ,45,999)=" = "_$G(MAGOUT(8925,NC,I,"E")) S @MAGRY@(CT)=ZZ Q
- . . Q
- . Q
- Q
- OTH ; Called internally
- ; p188 T3 added extra functionality for the Imaging Info Advanced window.
- N MAGFDA,MAGGLB
- K @MAGRY
- W !,"NODE ",NODE
- S I=0,CT=0
- S FLAGS=$S($L($G(FLAGS)):FLAGS,1:"IERN")
- S MAGFILE=$P(NODE,"^",1),MAGIEN=$P(NODE,"^",2)
- I MAGIEN="ALL" D Q ;
- . S MAGGLB=^DIC(MAGFILE,0,"GL")
- . S MAGGLB=$E(MAGGLB,1,$L(MAGGLB)-1)_")"
- . S CT=CT+1 S @MAGRY@(CT)=" MAGGLB "_MAGGLB
- . S MAGFDA=0 F S MAGFDA=$O(@MAGGLB@(MAGFDA)) Q:'MAGFDA D ;
- . . S MAGIEN=MAGFDA
- . . S CT=CT+1
- . . S @MAGRY@(CT)=" ====== IEN "_MAGIEN_" ======================"
- . . D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- . . D LOAD
- . Q
- I MAGIEN="" D ;
- . I MAGFILE="2006.1" S MAGIEN=$$DUZ2PLC^MAGBAPIP
- . I MAGFILE="2005.2" S MAGIEN=$O(^MAG(2005.2,0))
- S FLAGS=$S($L($G(FLAGS)):FLAGS,1:"IERN")
- S @MAGRY@(0)="****** Fields for FILE : "_MAGFILE
- D GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- D LOAD
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTSYS 5606 printed Feb 18, 2025@23:29:45 Page 2
- MAGGTSYS ;WOIFO/GEK/NST - Calls from Imaging windows for System Manager ; 22 Dec 2010 10:51 AM
- +1 ;;3.0;IMAGING;**59,93,117,185,188**;Mar 19, 2002;Build 61;Mar 18, 2018
- +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 ; GETS
- +19 ; Called from Image Information Advanced in Clinical Display
- +20 ; NODE: integer or "" or integer^integer or "N"_integer
- +21 ; if Integer - this is IMAGE IEN, we display IMAGE entry for IEN
- +22 ; if "" - we defalut to Last entry in IMAGE File.
- +23 ; if int^int - this is FILE^IEN, we display FM Files for FILE IEN
- +24 ; if "N"_int - this is Patch 185 Call.
- +25 ;
- GETS(MAGRY,NODE,FLAGS) ; USE GETS^DIQ TO GET FIELD VALUES.
- +1 NEW MAGWIN,I,CT,Y,NC,MAGOUT,MAGERR,TNC,ZZ,MAGIEN,MAGFILE
- +2 NEW N0
- +3 SET MAGRY=$NAME(^TMP("MAGNODE",$JOB))
- +4 KILL @MAGRY
- +5 ;
- IF $LENGTH(NODE,"^")>1
- DO OTH
- QUIT
- +6 IF NODE'?.1"N"1.N
- SET @MAGRY@(0)="Node IEN "_NODE_" invalid"
- +7 IF NODE?1"N"1.N
- Begin DoDot:1
- +8 NEW MAGVIEN
- +9 SET MAGVIEN=$EXTRACT(NODE,2,999)
- +10 ; Get P34 report
- DO IMGINFO^MAGNVQ03(MAGRY,MAGVIEN)
- +11 IF $GET(@MAGRY@(0))
- SET @MAGRY@(0)="****** Fields for Image IEN: "_MAGVIEN_" ******"
- QUIT
- +12 QUIT
- End DoDot:1
- QUIT
- +13 SET NODE=+$GET(NODE)
- +14 IF 'NODE
- SET NODE=$PIECE(^MAG(2005,0),U,3)
- +15 SET MAGIEN=NODE
- +16 SET MAGFILE=$$FILE^MAGGI11(NODE)
- +17 SET MAGWIN=$$BROKER^XWBLIB
- +18 IF 'MAGWIN
- WRITE !,"MAGIEN"," ",MAGIEN
- +19 KILL @MAGRY
- +20 SET @MAGRY@(0)="****** Fields for "_$SELECT(MAGFILE=2005.1:"DELETED ",1:"")_"Image IEN: "_MAGIEN_" ******"
- +21 SET I=0
- SET CT=0
- +22 SET FLAGS=$SELECT($LENGTH($GET(FLAGS)):FLAGS,1:"IERN")
- +23 ; problem getting file number
- IF MAGFILE'>0
- QUIT
- +24 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +25 DO LOAD
- +26 IF 'MAGWIN
- WRITE !,"AFTER LOAD","MAGIEN= ",MAGIEN
- +27 SET N0=$GET(^MAG(2005,MAGIEN,0))
- +28 ;
- SET MAGIEN=$PIECE(N0,"^",3)
- IF MAGIEN]""
- Begin DoDot:1
- +29 SET MAGFILE="2005.2"
- +30 SET CT=CT+1
- SET @MAGRY@(CT)=" ====== FULL File(Tier1): NETWORK LOCATION "_MAGIEN_" ======================"
- +31 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +32 DO LOAD
- End DoDot:1
- +33 ;
- SET MAGIEN=$PIECE(N0,"^",4)
- IF MAGIEN]""
- Begin DoDot:1
- +34 SET MAGFILE="2005.2"
- +35 SET CT=CT+1
- SET @MAGRY@(CT)=" ====== Abstract(Tier1): NETWORK LOCATION "_MAGIEN_" ======================"
- +36 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +37 DO LOAD
- End DoDot:1
- +38 ;
- SET MAGIEN=$PIECE(N0,"^",5)
- IF MAGIEN]""
- Begin DoDot:1
- +39 SET MAGFILE="2005.2"
- +40 SET CT=CT+1
- SET @MAGRY@(CT)=" ====== JukeBox(Tier2): NETWORK LOCATION "_MAGIEN_" ======================"
- +41 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +42 DO LOAD
- End DoDot:1
- +43 QUIT
- +44 ;
- LOAD ; p188 T3
- +1 SET NC=MAGIEN_","
- +2 SET I=""
- FOR
- SET I=$ORDER(MAGOUT(MAGFILE,NC,I))
- if I=""
- QUIT
- Begin DoDot:1
- +3 SET CT=CT+1
- +4 IF $GET(MAGOUT(MAGFILE,NC,I,"I"))=$GET(MAGOUT(MAGFILE,NC,I,"E"))
- Begin DoDot:2
- +5 SET ZZ=I
- SET $EXTRACT(ZZ,45,999)=" = "_$GET(MAGOUT(MAGFILE,NC,I,"E"))
- +6 SET @MAGRY@(CT)=ZZ
- +7 QUIT
- End DoDot:2
- QUIT
- +8 ;
- +9 SET ZZ=I
- SET $EXTRACT(ZZ,25,999)=" = ("_$GET(MAGOUT(MAGFILE,NC,I,"I"))_") "
- +10 IF ($LENGTH(ZZ)>44)
- SET ZZ=ZZ_" = "_$GET(MAGOUT(MAGFILE,NC,I,"E"))
- SET @MAGRY@(CT)=ZZ
- QUIT
- +11 IF ($LENGTH(ZZ)<45)
- SET $EXTRACT(ZZ,45,999)=" = "_$GET(MAGOUT(MAGFILE,NC,I,"E"))
- SET @MAGRY@(CT)=ZZ
- QUIT
- +12 QUIT
- End DoDot:1
- +13 IF $PIECE($GET(^MAG(MAGFILE,MAGIEN,2)),"^",6)=8925
- Begin DoDot:1
- +14 KILL MAGOUT,MAGERR
- +15 SET CT=CT+1
- SET @MAGRY@(CT)=" *************** TIU *************** "
- +16 SET CT=CT+1
- SET @MAGRY@(CT)=" **** Field Values for TIUDA: "_$PIECE(^MAG(MAGFILE,MAGIEN,2),"^",7)_" ****"
- +17 DO GETS^DIQ(8925,$PIECE(^MAG(MAGFILE,MAGIEN,2),"^",7),"*",FLAGS,"MAGOUT","MAGERR")
- +18 SET NC=$PIECE(^MAG(MAGFILE,MAGIEN,2),"^",7)_","
- +19 SET I=""
- FOR
- SET I=$ORDER(MAGOUT(8925,NC,I))
- if I=""
- QUIT
- Begin DoDot:2
- +20 SET CT=CT+1
- +21 IF $GET(MAGOUT(8925,NC,I,"I"))=$GET(MAGOUT(8925,NC,I,"E"))
- Begin DoDot:3
- +22 SET ZZ=I
- SET $EXTRACT(ZZ,45,999)=" = "_$GET(MAGOUT(8925,NC,I,"E"))
- +23 SET @MAGRY@(CT)=ZZ
- +24 QUIT
- End DoDot:3
- QUIT
- +25 ;
- +26 SET ZZ=I
- SET $EXTRACT(ZZ,25,999)=" = ("_$GET(MAGOUT(8925,NC,I,"I"))_") "
- +27 IF ($LENGTH(ZZ)>44)
- SET ZZ=ZZ_" = "_$GET(MAGOUT(8925,NC,I,"E"))
- SET @MAGRY@(CT)=ZZ
- QUIT
- +28 IF ($LENGTH(ZZ)<45)
- SET $EXTRACT(ZZ,45,999)=" = "_$GET(MAGOUT(8925,NC,I,"E"))
- SET @MAGRY@(CT)=ZZ
- QUIT
- +29 QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 QUIT
- OTH ; Called internally
- +1 ; p188 T3 added extra functionality for the Imaging Info Advanced window.
- +2 NEW MAGFDA,MAGGLB
- +3 KILL @MAGRY
- +4 WRITE !,"NODE ",NODE
- +5 SET I=0
- SET CT=0
- +6 SET FLAGS=$SELECT($LENGTH($GET(FLAGS)):FLAGS,1:"IERN")
- +7 SET MAGFILE=$PIECE(NODE,"^",1)
- SET MAGIEN=$PIECE(NODE,"^",2)
- +8 ;
- IF MAGIEN="ALL"
- Begin DoDot:1
- +9 SET MAGGLB=^DIC(MAGFILE,0,"GL")
- +10 SET MAGGLB=$EXTRACT(MAGGLB,1,$LENGTH(MAGGLB)-1)_")"
- +11 SET CT=CT+1
- SET @MAGRY@(CT)=" MAGGLB "_MAGGLB
- +12 ;
- SET MAGFDA=0
- FOR
- SET MAGFDA=$ORDER(@MAGGLB@(MAGFDA))
- if 'MAGFDA
- QUIT
- Begin DoDot:2
- +13 SET MAGIEN=MAGFDA
- +14 SET CT=CT+1
- +15 SET @MAGRY@(CT)=" ====== IEN "_MAGIEN_" ======================"
- +16 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +17 DO LOAD
- End DoDot:2
- +18 QUIT
- End DoDot:1
- QUIT
- +19 ;
- IF MAGIEN=""
- Begin DoDot:1
- +20 IF MAGFILE="2006.1"
- SET MAGIEN=$$DUZ2PLC^MAGBAPIP
- +21 IF MAGFILE="2005.2"
- SET MAGIEN=$ORDER(^MAG(2005.2,0))
- End DoDot:1
- +22 SET FLAGS=$SELECT($LENGTH($GET(FLAGS)):FLAGS,1:"IERN")
- +23 SET @MAGRY@(0)="****** Fields for FILE : "_MAGFILE
- +24 DO GETS^DIQ(MAGFILE,MAGIEN,"*",FLAGS,"MAGOUT","MAGERR")
- +25 DO LOAD
- +26 ;
- +27 QUIT