source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGXCVS.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1MAGXCVS ;WOIFO/MLH - Imaging - index conversion - summary report ; 28 Mar 2005 9:20 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 ;
20MAKESUMM ; entry point - construct a summary report from site data
21 ; This expects that the site will already have created an export file.
22 ;
23 N %ZIS,IOP,X,COUNT,LN,DATA,MAGIEN,PKG,CLS,TYP,SPEC,PROC,PROC2,DESC
24 N SUB ; ------- station or substation mnemonic
25 N FQFNAME ; --- fully qualified file name to process
26 N FNAME ; ----- file name without directory or extension
27 N RANGE ; ----- range of records (for documentation)
28 N DTIME ; ----- timeout (in seconds) for input
29 N FULABR ; ---- Full or Abridged report flag
30 ;
31 K ^TMP($J,"MAGIXCVSTAT")
32 S COUNT=0
33 S:'$D(DTIME) DTIME=$$DTIME^XUP(DUZ)
34SM1 ; set frequency threshold based on full or abridged report
35 ;
36 K DIR S DIR(0)="SB^A:Abridged;F:Full"
37 S DIR("A")="Abridged or Full report"
38 S DIR("?",1)="Enter A if you wish to see the mapping only for those combinations"
39 S DIR("?",2)=" of source field values that occurred more than 50 times."
40 S DIR("?",3)=" "
41 S DIR("?",4)="Enter F if you wish to see the mapping for all combinations of source"
42 S DIR("?",5)=" field values in the range of image IENs that you mapped, even those"
43 S DIR("?",6)=" that occurred fewer than 50 times."
44 S DIR("?")=" "
45 D ^DIR Q:$D(DTOUT) Q:$D(DUOUT) S FRQTHRS=$S(Y="A":50,1:1)
46 ;
47SM15 ; what export file?
48 ;
49 K DIR S DIR(0)="FO"
50 S DIR("A")="Please enter the filename of the export file to use for input"
51 S DIR("?")="Enter a file name, including the path, of the export file that contains the data to be summarized in the report."
52 D ^DIR Q:$D(DTOUT) Q:$D(DUOUT) S FQFNAME=Y
53 I FQFNAME="" W !!,"No filename entered. Goodbye!" Q
54 S %ZIS="",%ZIS("HFSNAME")=FQFNAME,%ZIS("HFSMODE")="R",IOP="HFS"
55 S $ET="G ERR^"_$T(+0)
56 D ^%ZIS I POP=1 W !,"Unable to open "_FQFNAME_". Please try again." G SM15
57 W ! S FNAME=$P($P(FQFNAME,"\",$L(FQFNAME,"\")),".")
58 S (SUB,CODE)=$$UCASE^MAGXCVP($P(FNAME,"_")),RANGE=$P(FNAME,"_",2)
59 I RANGE="" S RANGE="not given"
60 K ^TMP($J,"MAGIXCVSTAT") S ^TMP($J,"MAGIXCVSTAT",0)=SUB_"^"_RANGE
61 F LN=1:1 U IO R DATA:99999 Q:DATA="***end***" I LN>1 D ; Skip header
62 . S MAGIEN=$P(DATA,$C(9))
63 . S PKG=$P(DATA,$C(9),8) I PKG="" S PKG="(none)"
64 . S CLS=+$P(DATA,$C(9),9),TYP=+$P(DATA,$C(9),10),SPEC=+$P(DATA,$C(9),11)
65 . S PROC=+$P(DATA,$C(9),12)
66 . S X=$P(DATA,$C(9),13),ORIG=$S(X="":"(none)",1:$P(X,"-")_" - "_$P(X,"-",2,999))
67 . I ORIG="" S ORIG="(none)"
68 . S DESC=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($P(DATA,$C(9),2))) I DESC="" S DESC="(none)"
69 . S PROCTXT=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($P(DATA,$C(9),3))) I PROCTXT="" S PROCTXT="(none)"
70 . S PARENT=$P(DATA,$C(9),4) I PARENT="" S PARENT="(none)"
71 . S DOCCAT=$P(DATA,$C(9),5) I DOCCAT="" S DOCCAT="(none)"
72 . S OBJTYP=$P(DATA,$C(9),6) I OBJTYP="" S OBJTYP="(none)"
73 . S SAVBYGRP=$P(DATA,$C(9),7) I SAVBYGRP="" S SAVBYGRP="(none)"
74 . S ^(SAVBYGRP)=$G(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP))+1
75 . I LN#100=0 U IO(0) W "."
76 . I LN#5000=0 U IO(0) W LN,!
77 . Q
78 D ^%ZISC
79 U IO(0) W !,"File import complete.",! G SM2
80 ;
81 ; Reached when an error (including end-of-file) occurs.
82ERR ;
83 S $ET=""
84 D ^%ZISC
85 U IO(0) X "W !,$ZE" W !,"Processing interrupted after ",LN," lines.",!
86 ;
87SM2 ;
88 W !,"This report must be run on at least a 132-column device.",!
89 D EN^XUTMDEVQ("ANZRPT^"_$T(+0),"Print Image Index Summary Report",.ZTSAVE)
90 Q
91 ;
92ANZRPT ;
93 I IOM<132 W !,"This report must be run on at least a 132-column device. Goodbye!",! Q
94 N FQUIT ; --- quit flag from header logic
95 N RDATE ; --- report date
96 ;
97 S %H=$H D YX^%DTC S RDATE=Y
98 S PG=0
99 S FQUIT=0
100 S SUB=$O(^MAG(2006.1,0)) I SUB S SUB=$P($G(^MAG(2006.1,SUB,0)),U)
101 ;
102 S PKG=""
103 F S PKG=$O(^TMP($J,"MAGIXCVSTAT",PKG)) Q:PKG="" D Q:FQUIT
104 . S CLS=""
105 . F S CLS=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS)) Q:CLS="" D Q:FQUIT
106 . . S TYP=""
107 . . F S TYP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP)) Q:TYP="" D Q:FQUIT
108 . . . S PROC=""
109 . . . F S PROC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC)) Q:PROC="" D Q:FQUIT
110 . . . . S SPEC=""
111 . . . . F S SPEC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC)) Q:SPEC="" D Q:FQUIT
112 . . . . . S ORIG=""
113 . . . . . F S ORIG=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG)) Q:ORIG="" D SPEC1 Q:FQUIT
114 . . . . Q
115 . . . Q
116 . . Q
117 . Q
118 Q
119 ;
120SPEC1 ;
121 S NUPG=1
122 S DESC=""
123 F S DESC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC)) Q:DESC="" D Q:FQUIT
124 . S PROCTXT=""
125 . F S PROCTXT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT)) Q:PROCTXT="" D Q:FQUIT
126 . . S PARENT=""
127 . . F S PARENT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT)) Q:PARENT="" D Q:FQUIT
128 . . . S DOCCAT=""
129 . . . F S DOCCAT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT)) Q:DOCCAT="" D Q:FQUIT
130 . . . . S OBJTYP=""
131 . . . . F S OBJTYP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP)) Q:OBJTYP="" D Q:FQUIT
132 . . . . . S SAVBYGRP=""
133 . . . . . F S SAVBYGRP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP)) Q:SAVBYGRP="" S KT=^(SAVBYGRP) D Q:FQUIT
134 . . . . . . I KT<FRQTHRS Q ; count must exceed frequency threshold
135 . . . . . . I ($Y>(IOSL-3))!NUPG D ANZHED Q:FQUIT
136 . . . . . . W DESC," ",?34,PROCTXT," ",?64,PARENT," ",?78,DOCCAT," ",?92,OBJTYP," ",?106,SAVBYGRP," ",?150,$J(KT,8),!
137 . . . . . . Q
138 . . . . . Q
139 . . . . Q
140 . . . Q
141 . . Q
142 . Q
143 Q
144 ;
145ANZHED ;
146 I PG>0,IOT="TRM"!(IOT="VTRM") D Q:FQUIT
147 . R !!,"Press <RETURN> to continue, or '^' to exit: ",RET:DTIME
148 . S FQUIT=(RET="^")
149 . Q
150 S PG=PG+1,NUPG=0
151 W #!,"Site: ",SUB D CTR("IMAGE INDEX GENERATION REPORT") W ?115,"DATE ",RDATE,!
152 ;W "Range: ",RANGE
153 D CTR("Package: "_PKG)
154 W ?122,$J("PAGE "_PG,8),!
155 D CTR("Class: "_$S(CLS:CLS_" - "_$P($G(^MAG(2005.82,CLS,0)),"^"),1:"(none)")) W !
156 D CTR("Type: "_$S(TYP:TYP_" - "_$P($G(^MAG(2005.83,TYP,0)),"^"),1:"(none)")) W !
157 D CTR("Procedure/Event: "_$S(PROC:PROC_" - "_$P($G(^MAG(2005.85,PROC,0)),"^"),1:"(none)")) W !
158 D CTR("Specialty: "_$S(SPEC:SPEC_" - "_$P($G(^MAG(2005.84,SPEC,0)),"^"),1:"(none)")) W !
159 D CTR("Origin: "_ORIG) W !!
160 W ?64,"Parent",!
161 W "Short Description",?34,"Procedure Text",?64,"Data File",?78,"Document Cat",?92,"Object Type",?106,"Save By Group",?153,"Count",!!
162 Q
163 ;
164CTR(X) W ?65-($L(X)/2),X Q
165EOR ;END ROUTINE
Note: See TracBrowser for help on using the repository browser.