- 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 Feb 18, 2025@23:37:15 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
