source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGXCVR.m@ 1582

Last change on this file since 1582 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1MAGXCVR ;WOIFO/SEB,MLH - Image File Conversion Reports ; 24 Mar 2005 10:56 AM
2 ;;3.0;IMAGING;**17,25,31**;Mar 31, 2005
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;
20 ; Entry point for the detail report option (MAG IMAGE INDEX DETAIL REPORT)
21REPORT N START,END S (START,END)=0
22 D BOUNDS^MAGXCVP(.START,.END) I START="^" Q
23 W !!,"Are you sure that you want to run this report for ",(END-START+1)," images? Y // " R RUN:DTIME
24 I "Yy"'[RUN W !,"OK, report not printed." G DONE
25 N ZTSAVE S ZTSAVE("START")=START,ZTSAVE("END")=END
26 U IO(0) W !,"This report must be run on a device at least 132 columns wide."
27 D EN^XUTMDEVQ("REPORT1^"_$T(+0),"Print Image Index Detail Report",.ZTSAVE)
28 G DONE
29 ;
30REPORT1 N MAGIEN,LINENUM,PAGE,RET,STARTDT,ENDDT
31 I IOM<132 W !,"This report must be run on a device at least 132 columns wide. Goodbye!" Q
32 D NOW^%DTC S Y=% D DD^%DT S STARTDT=Y
33 S LINENUM=0,PAGE=0,RET="" D HEADER(1)
34 S START=+$G(START),END=+$G(END)
35 I END=0 S END=+$P($G(^MAG(2005,0)),U,3)
36 S MAGIEN=START-1 I MAGIEN=-1 S MAGIEN=0
37 F S MAGIEN=$O(^MAG(2005,MAGIEN)) Q:MAGIEN>END!(+MAGIEN'=MAGIEN) D REPONE(MAGIEN,1) I RET="^" Q
38 D NOW^%DTC S Y=% D DD^%DT S ENDDT=Y
39 Q
40 ;
41 ; Print data for one image (IEN=MAGIEN)
42REPONE(MAGIEN,TYPE) N MAGTMP,MAGVALS,GRPIEN,UTYPE,INDXDATA,CHILD1
43 N GRPFLG ; ------- true (1) if this image is part of a group
44 ;
45 S GRPIEN=$$GET1^DIQ(2005,MAGIEN_",",14,"I"),GRPFLG=1
46 ; NEW: Skip child images (for MRs, CTs, etc.)
47 I GRPIEN]"" Q
48 I GRPIEN="" S GRPIEN=MAGIEN,GRPFLG=0
49 S LINENUM=LINENUM+1 I LINENUM>(IOSL-2) D HEADER(TYPE) I RET="^" Q
50 W !,MAGIEN
51 I '$D(^MAG(2005,GRPIEN)) D Q
52 . W ?9,"<<< "_$S(GRPFLG:"PARENT ",1:"")_"IMAGE RECORD DOES NOT EXIST! >>>"
53 . Q
54 K MAGTMP
55 D GETS^DIQ(2005,GRPIEN_",","3;6;8;10;16;100","EI","MAGTMP")
56 K MAGVALS M MAGVALS=MAGTMP(2005,GRPIEN_",")
57 S CHILD1=$G(^MAG(2005,GRPIEN,1,1,0))
58 I CHILD1'="" S MAGVALS(3,"E")=$$GET1^DIQ(2005,CHILD1_",",3,"E")
59 S UTYPE="" I $G(MAGVALS(8,"I"))]"" S UTYPE=$$GET1^DIQ(200,MAGVALS(8,"I")_",",29,"E")
60 W ?9,$E($G(MAGVALS(6,"E")),1,16),?27,$E($G(MAGVALS(10,"E")),1,27),?56,$E($G(MAGVALS(16,"E")),1,20)
61 W ?78,$E($G(MAGVALS(100,"E")),1,23),?103,$E($G(MAGVALS(3,"E")),1,17),?120,$E(UTYPE,1,10)
62 S INDXDATA=$G(^XTMP("MAGIXCVGEN",MAGIEN)) I INDXDATA="" Q
63 I TYPE=1 D INDICES(INDXDATA,TYPE) ;I RET'="^" W ! S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(TYPE) I RET="^" Q
64 Q
65 ;
66 ; Print index values for the current image
67INDICES(INDXDATA,TYPE) N D0,INDXVAL,INDXNUM,TAB,LEN,SPACES
68 S SPACES="",$P(SPACES," ",21)=""
69 W !
70 F D0=1:1:5 D
71 . S INDXVAL=$P(INDXDATA,U,D0+1)
72 . S INDXNUM=$S(D0=2:2005.82,D0=3:2005.83,D0=4:2005.85,D0=5:2005.84,1:"")
73 . I D0>1,INDXVAL]"" S INDXVAL=$$GET1^DIQ(INDXNUM,INDXVAL,.01,"E")
74 . S TAB=$P("9^27^36^56^78",U,D0),LEN=$P("20^7^18^20^20",U,D0)
75 . I TYPE=1 W ?TAB,$E(INDXVAL,1,LEN)," "
76 . I TYPE=2 W $P("Package^Class^Type^Procedure^Specialty",U,D0),": ",$E(INDXVAL,1,LEN),$E(SPACES,1,LEN-$L(INDXVAL))
77 . Q
78 S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(TYPE) I RET="^" Q
79 Q
80 ;
81 ; Entry point for the summary report option (MAG IMAGE INDEX SUMMARY REPORT)
82SUMMARY N ZTSAVE,DETAIL
83ALL R !!,"Display data for all images? N // ",DETAIL:DTIME
84 S DETAIL=$$UCASE^MAGXCVP(DETAIL) I DETAIL="^" G DONE
85 I DETAIL'="Y" S DETAIL="N"
86 S ZTSAVE("DETAIL")=DETAIL
87 D EN^XUTMDEVQ("SUMMARY1^"_$T(+0),"Print Image Index Summary Report",.ZTSAVE)
88 G DONE
89 ;
90SUMMARY1 N SUMMARY,SUMDATA,PAGE,LINENUM,RET,MAGIEN
91 I IOM'=132 W !,"This report must be run on a 132-column device. Goodbye!" Q
92 S SUMMARY="",PAGE=0,LINENUM=0,RET="" D HEADER(2)
93 F S SUMMARY=$O(^XTMP("MAG30P25","SUMMARY",SUMMARY)) Q:SUMMARY=""!(RET="^") D
94 . S SUMDATA=$G(^XTMP("MAG30P25","SUMMARY",SUMMARY))
95 . D INDICES(U_SUMMARY,2) I RET="^" Q
96 . W ! S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
97 . I DETAIL="Y" D DETL(SUMMARY) I RET="^" Q
98 . I DETAIL="N" D SUMM(SUMDATA) I RET="^" Q
99 . W ! F I=1:1:132 W "-"
100 . S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
101 . Q
102 I RET="^" Q
103 W !!,"Index Commit History:" S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
104 F I=1:1:+$G(^XTMP("MAG30P25","HISTORY")) Q:I="" D
105 . S SUMDATA=$G(^XTMP("MAG30P25","HISTORY",I))
106 . W !?2,I,?8,$P(SUMDATA,U),"-",$P(SUMDATA,U,3)," started on ",$P(SUMDATA,U,2),", finished on ",$P(SUMDATA,U,4)
107 . S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
108 . Q
109 Q
110 ;
111 ; Print the header of the report
112HEADER(TYPE) N I,STATUS ; TYPE = 1: Detail, 2: Summary
113 S STATUS=$G(^XTMP("MAG30P25","SUMMARY"))
114 I PAGE>0,IOT="TRM"!(IOT="VTRM") R !!,"Press <RETURN> to continue, or '^' to exit: ",RET:DTIME I RET="^" Q
115 S LINENUM=$P("6^5",U,TYPE),PAGE=PAGE+1
116 W:PAGE>0 # W ! F I=1:1:132 W "-"
117 W !?53,"Image Index Report ",$S(TYPE=1:"Detail",1:"Summary"),?106,"Page #",PAGE
118 I TYPE=1 D
119 . W !,"Img ID",?9,"Procedure",?27,"Short Description",?56,"Parent Data File"
120 . W ?78,"Document Category",?103,"Obj. Type",?120,"User Type"
121 . W !?9,"Package",?27,"Class",?36,"Type",?56,"Procedure/Event",?78,"Specialty"
122 . Q
123 I TYPE=2 D
124 . W !?40,"Compiled: ",$P(STATUS,U,2),"-",$P(STATUS,U,4)
125 . W !?(132-11-$L($P(STATUS,U))-$L($P(STATUS,U,3))/2),"Image IDs: ",$P(STATUS,U),"-",$P(STATUS,U,3)
126 . Q
127 W ! F I=1:1:132 W "-"
128 Q
129 ;
130SUMM(SUMDATA) W !,"Total: ",$P(SUMDATA,U),?15,"First IEN: ",$P(SUMDATA,U,2),?35,"Last IEN: ",$P(SUMDATA,U,3)
131 S LINENUM=LINENUM+2 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
132 W !,"Img ID",?9,"Procedure",?27,"Short Description",?56,"Parent Data File"
133 W ?78,"Document Category",?103,"Obj. Type",?120,"User Type"
134 S LINENUM=LINENUM+1 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
135 ;D REPONE($P(SUMDATA,U,2),2) I RET="^" Q
136 I $P(SUMDATA,U,2)'=$P(SUMDATA,U,3) D I RET="^" Q
137 . ;D REPONE($P(SUMDATA,U,3),2) I RET="^" Q
138 . Q
139 Q
140 ;
141DETL(SUMMARY) N MAGIEN
142 W !,"Img ID",?9,"Procedure",?27,"Short Description",?56,"Parent Data File"
143 W ?78,"Document Category",?103,"Obj. Type",?120,"User Type"
144 S LINENUM=LINENUM+2 I LINENUM>(IOSL-3) D HEADER(2) I RET="^" Q
145 S MAGIEN="" F S MAGIEN=$O(^XTMP("MAG30P25","SUMMARY",SUMMARY,MAGIEN)) Q:MAGIEN=""!(RET="^") D
146 . D REPONE(MAGIEN,2) I RET="^" Q
147 . Q
148 Q
149 ;
150DONE W !!,"Done!"
151 Q
152 ;
153 ; Entry point for the status report option (MAG IMAGE INDEX STATUS)
154STATUS N STDATA,STFLAG,TASKNUM
155 S STDATA=$G(^XTMP("MAG30P25","STATUS")),STFLAG=$P(STDATA,U,13),TASKNUM=$P(STDATA,U,14)
156 W ! F CT=1:1:80 W "-"
157 W !,"Current status: ",$$ST I TASKNUM>0 W " (#",TASKNUM,")"
158 W ?60,"Current IEN: ",$P(STDATA,U,((STFLAG>3)+1)*6)
159 W !!,"Last generation started on: ",$P(STDATA,U,3),?53,"Starting IEN: ",$P(STDATA,U,2)
160 W !?18,"ended on: ",$P(STDATA,U,5),?55,"Ending IEN: ",$P(STDATA,U,4)
161 W !!?4,"Last commit started on: ",$P(STDATA,U,9),?53,"Starting IEN: ",$P(STDATA,U,8)
162 W !?18,"ended on: ",$P(STDATA,U,11),?55,"Ending IEN: ",$P(STDATA,U,10)
163 W ! F CT=1:1:80 W "-"
164 Q
165 ;
166ST() N STDATA,STFLAG,STATUS
167 S STDATA=$G(^XTMP("MAG30P25","STATUS"))
168 S STFLAG=$P(STDATA,U,13)
169 I +STFLAG=0 Q "Image index conversion not started yet"
170 S STATUS="Image index "_$S(STFLAG<4:"generation",1:"commit")_" "_$S(STFLAG#3=0:"done",STFLAG#3=1:"in progress",1:"aborted")
171 Q STATUS
Note: See TracBrowser for help on using the repository browser.