MAGXCVX ;WOIFO/SEB,MLH - Image File Conversion Export ; 24 Mar 2005 11:00 AM
;;3.0;IMAGING;**17,25,31**;Mar 31, 2005
;; +---------------------------------------------------------------+
;; | 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
;
; Entry point for the Export Results option (MAG IMAGE INDEX EXPORT)
EXPORT N FNAME,COUNT,MAGDATA,MAGFLD,MAGID,CT,DR,DIE,DA,%ZIS,CLEAR
N MAGIEN,GRPIEN,CHILD1,UTYPE,MAGTMP,MAGVALS,FLDNUM,START,END
N MAGNOD ; --- nodes of the current image record, for fast lookup
N I ; -------- scratch loop index
N INT ; ------ internal code value
N EXT ; ------ array for return of external code value from VAL^DIE
;
S COUNT=0
EX1 R !!,"Please enter the filename of the output file: ",FNAME:DTIME
I $E(FNAME)="?" D G EX1
. W !!,"Enter a file name, including the path, of the file to export."
. Q
I $TR(FNAME,"^")="" W !!,"No filename entered. Goodbye!" Q
S %ZIS="",%ZIS("HFSNAME")=FNAME,%ZIS("HFSMODE")="W",IOP="HFS"
S X="ERR^"_$T(+0),@^%ZOSF("TRAP")
D ^%ZIS I POP=1 W !,"Unable to open "_FNAME_" for output. Please try again." G EX1
W ! D BOUNDS^MAGXCVP(.START,.END) I START="^" S COUNT=-1 G ERR
S START=+$G(START),END=+$G(END) I END=0 S END=+$P($G(^MAG(2005,0)),U,3)
S MAGIEN=START-1 I MAGIEN=-1 S MAGIEN=0
W ! U IO W "Image IEN",$C(9),"Short Description",$C(9),"Procedure",$C(9),"Parent Data File",$C(9)
W "Document Category",$C(9),"Object Type",$C(9),"Save By Group",$C(9)
W "Package",$C(9),"Class",$C(9),"Type",$C(9),"Specialty",$C(9),"Proc/Event",$C(9),"Origin",!
F CT=0:1 S MAGIEN=$O(^XTMP("MAGIXCVGEN",MAGIEN)) Q:MAGIEN>END!(+MAGIEN'=MAGIEN) D
. U IO(0) W:CT#100=0 MAGIEN W:CT#10=0 "."
. S GRPIEN=$P($G(^MAG(2005,MAGIEN,0)),U,10) I GRPIEN="" S GRPIEN=MAGIEN
. F I=0,2,100 S MAGNOD(I)=$G(^MAG(2005,GRPIEN,I))
. K MAGVALS,UTYPE
. ; get internal values
. S MAGVALS(3,"I")=$P(MAGNOD(0),U,6) ; object type
. S CHILD1=$P($G(^MAG(2005,GRPIEN,1,1,0)),U)
. I CHILD1]"" S MAGVALS(3,"I")=$P($G(^MAG(2005,CHILD1,0)),U,6)
. S MAGVALS(6,"I")=$P(MAGNOD(0),U,8) ; procedure
. S MAGVALS(8,"I")=$P(MAGNOD(2),U,2) ; image save by
. S MAGVALS(10,"I")=$P(MAGNOD(2),U,4) ; short description
. S MAGVALS(16,"I")=$P(MAGNOD(2),U,6) ; parent data file
. S MAGVALS(100,"I")=$P(MAGNOD(100),U) ; descriptive category
. ; get external values
. I MAGVALS(3,"I") D
. . S MAGVALS(3,"E")=$P($G(^MAG(2005.02,MAGVALS(3,"I"),0)),U)
. . Q
. S MAGVALS(6,"E")=MAGVALS(6,"I")
. I MAGVALS(8,"I") S UTYPE=$$GET1^DIQ(200,MAGVALS(8,"I")_",",29,"E")
. S MAGVALS(10,"E")=MAGVALS(10,"I")
. I MAGVALS(16,"I") D
. . S MAGVALS(16,"E")=$P($G(^MAG(2005.03,MAGVALS(16,"I"),0)),U)
. . Q
. I MAGVALS(100,"I") D
. . S MAGVALS(100,"E")=$P($G(^MAG(2005.81,MAGVALS(100,"I"),0)),U)
. . Q
. U IO W MAGIEN F FLDNUM=10,6,16,100,3 W $C(9),$G(MAGVALS(FLDNUM,"E"))
. W $C(9),$G(UTYPE)
. S MAGDATA=$G(^XTMP("MAGIXCVGEN",MAGIEN))
. W $C(9),$P(MAGDATA,U,2)
. W $C(9) I $P(MAGDATA,U,3)'="" W $P(MAGDATA,U,3),"-",$P($G(^MAG(2005.82,$P(MAGDATA,U,3),0)),U)
. W $C(9) I $P(MAGDATA,U,4)'="" W $P(MAGDATA,U,4),"-",$P($G(^MAG(2005.83,$P(MAGDATA,U,4),0)),U)
. W $C(9) I $P(MAGDATA,U,6)'="" W $P(MAGDATA,U,6),"-",$P($G(^MAG(2005.84,$P(MAGDATA,U,6),0)),U)
. W $C(9) I $P(MAGDATA,U,5)'="" W $P(MAGDATA,U,5),"-",$P($G(^MAG(2005.85,$P(MAGDATA,U,5),0)),U)
. W $C(9) I $P(MAGDATA,U,7)'="" D ; convert set-of-codes to external value
. . S INT=$P(MAGDATA,U,7)
. . D VAL^DIE(2005,"",45,"E",INT,.EXT)
. . W INT_"-"_$G(EXT(0))
. . Q
. W !
. Q
U IO W "***end***",!
U IO(0)
D ^%ZISC G EXDONE
;
ERR ; Reached when an error (including end-of-file) occurs.
D ^%ZISC
EXDONE S COUNT=COUNT+1
I COUNT=1 W !,"Done exporting generated index values."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGXCVX 4617 printed Nov 22, 2024@17:20:51 Page 2
MAGXCVX ;WOIFO/SEB,MLH - Image File Conversion Export ; 24 Mar 2005 11:00 AM
+1 ;;3.0;IMAGING;**17,25,31**;Mar 31, 2005
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 ; Entry point for the Export Results option (MAG IMAGE INDEX EXPORT)
EXPORT NEW FNAME,COUNT,MAGDATA,MAGFLD,MAGID,CT,DR,DIE,DA,%ZIS,CLEAR
+1 NEW MAGIEN,GRPIEN,CHILD1,UTYPE,MAGTMP,MAGVALS,FLDNUM,START,END
+2 ; --- nodes of the current image record, for fast lookup
NEW MAGNOD
+3 ; -------- scratch loop index
NEW I
+4 ; ------ internal code value
NEW INT
+5 ; ------ array for return of external code value from VAL^DIE
NEW EXT
+6 ;
+7 SET COUNT=0
EX1 READ !!,"Please enter the filename of the output file: ",FNAME:DTIME
+1 IF $EXTRACT(FNAME)="?"
Begin DoDot:1
+2 WRITE !!,"Enter a file name, including the path, of the file to export."
+3 QUIT
End DoDot:1
GOTO EX1
+4 IF $TRANSLATE(FNAME,"^")=""
WRITE !!,"No filename entered. Goodbye!"
QUIT
+5 SET %ZIS=""
SET %ZIS("HFSNAME")=FNAME
SET %ZIS("HFSMODE")="W"
SET IOP="HFS"
+6 SET X="ERR^"_$TEXT(+0)
SET @^%ZOSF("TRAP")
+7 DO ^%ZIS
IF POP=1
WRITE !,"Unable to open "_FNAME_" for output. Please try again."
GOTO EX1
+8 WRITE !
DO BOUNDS^MAGXCVP(.START,.END)
IF START="^"
SET COUNT=-1
GOTO ERR
+9 SET START=+$GET(START)
SET END=+$GET(END)
IF END=0
SET END=+$PIECE($GET(^MAG(2005,0)),U,3)
+10 SET MAGIEN=START-1
IF MAGIEN=-1
SET MAGIEN=0
+11 WRITE !
USE IO
WRITE "Image IEN",$CHAR(9),"Short Description",$CHAR(9),"Procedure",$CHAR(9),"Parent Data File",$CHAR(9)
+12 WRITE "Document Category",$CHAR(9),"Object Type",$CHAR(9),"Save By Group",$CHAR(9)
+13 WRITE "Package",$CHAR(9),"Class",$CHAR(9),"Type",$CHAR(9),"Specialty",$CHAR(9),"Proc/Event",$CHAR(9),"Origin",!
+14 FOR CT=0:1
SET MAGIEN=$ORDER(^XTMP("MAGIXCVGEN",MAGIEN))
if MAGIEN>END!(+MAGIEN'=MAGIEN)
QUIT
Begin DoDot:1
+15 USE IO(0)
if CT#100=0
WRITE MAGIEN
if CT#10=0
WRITE "."
+16 SET GRPIEN=$PIECE($GET(^MAG(2005,MAGIEN,0)),U,10)
IF GRPIEN=""
SET GRPIEN=MAGIEN
+17 FOR I=0,2,100
SET MAGNOD(I)=$GET(^MAG(2005,GRPIEN,I))
+18 KILL MAGVALS,UTYPE
+19 ; get internal values
+20 ; object type
SET MAGVALS(3,"I")=$PIECE(MAGNOD(0),U,6)
+21 SET CHILD1=$PIECE($GET(^MAG(2005,GRPIEN,1,1,0)),U)
+22 IF CHILD1]""
SET MAGVALS(3,"I")=$PIECE($GET(^MAG(2005,CHILD1,0)),U,6)
+23 ; procedure
SET MAGVALS(6,"I")=$PIECE(MAGNOD(0),U,8)
+24 ; image save by
SET MAGVALS(8,"I")=$PIECE(MAGNOD(2),U,2)
+25 ; short description
SET MAGVALS(10,"I")=$PIECE(MAGNOD(2),U,4)
+26 ; parent data file
SET MAGVALS(16,"I")=$PIECE(MAGNOD(2),U,6)
+27 ; descriptive category
SET MAGVALS(100,"I")=$PIECE(MAGNOD(100),U)
+28 ; get external values
+29 IF MAGVALS(3,"I")
Begin DoDot:2
+30 SET MAGVALS(3,"E")=$PIECE($GET(^MAG(2005.02,MAGVALS(3,"I"),0)),U)
+31 QUIT
End DoDot:2
+32 SET MAGVALS(6,"E")=MAGVALS(6,"I")
+33 IF MAGVALS(8,"I")
SET UTYPE=$$GET1^DIQ(200,MAGVALS(8,"I")_",",29,"E")
+34 SET MAGVALS(10,"E")=MAGVALS(10,"I")
+35 IF MAGVALS(16,"I")
Begin DoDot:2
+36 SET MAGVALS(16,"E")=$PIECE($GET(^MAG(2005.03,MAGVALS(16,"I"),0)),U)
+37 QUIT
End DoDot:2
+38 IF MAGVALS(100,"I")
Begin DoDot:2
+39 SET MAGVALS(100,"E")=$PIECE($GET(^MAG(2005.81,MAGVALS(100,"I"),0)),U)
+40 QUIT
End DoDot:2
+41 USE IO
WRITE MAGIEN
FOR FLDNUM=10,6,16,100,3
WRITE $CHAR(9),$GET(MAGVALS(FLDNUM,"E"))
+42 WRITE $CHAR(9),$GET(UTYPE)
+43 SET MAGDATA=$GET(^XTMP("MAGIXCVGEN",MAGIEN))
+44 WRITE $CHAR(9),$PIECE(MAGDATA,U,2)
+45 WRITE $CHAR(9)
IF $PIECE(MAGDATA,U,3)'=""
WRITE $PIECE(MAGDATA,U,3),"-",$PIECE($GET(^MAG(2005.82,$PIECE(MAGDATA,U,3),0)),U)
+46 WRITE $CHAR(9)
IF $PIECE(MAGDATA,U,4)'=""
WRITE $PIECE(MAGDATA,U,4),"-",$PIECE($GET(^MAG(2005.83,$PIECE(MAGDATA,U,4),0)),U)
+47 WRITE $CHAR(9)
IF $PIECE(MAGDATA,U,6)'=""
WRITE $PIECE(MAGDATA,U,6),"-",$PIECE($GET(^MAG(2005.84,$PIECE(MAGDATA,U,6),0)),U)
+48 WRITE $CHAR(9)
IF $PIECE(MAGDATA,U,5)'=""
WRITE $PIECE(MAGDATA,U,5),"-",$PIECE($GET(^MAG(2005.85,$PIECE(MAGDATA,U,5),0)),U)
+49 ; convert set-of-codes to external value
WRITE $CHAR(9)
IF $PIECE(MAGDATA,U,7)'=""
Begin DoDot:2
+50 SET INT=$PIECE(MAGDATA,U,7)
+51 DO VAL^DIE(2005,"",45,"E",INT,.EXT)
+52 WRITE INT_"-"_$GET(EXT(0))
+53 QUIT
End DoDot:2
+54 WRITE !
+55 QUIT
End DoDot:1
+56 USE IO
WRITE "***end***",!
+57 USE IO(0)
+58 DO ^%ZISC
GOTO EXDONE
+59 ;
ERR ; Reached when an error (including end-of-file) occurs.
+1 DO ^%ZISC
EXDONE SET COUNT=COUNT+1
+1 IF COUNT=1
WRITE !,"Done exporting generated index values."
+2 QUIT
