source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDCCSS.m@ 1724

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1MAGDCCSS ;WOIFO/MLH - DICOM Correct - Clinical Specialties - Sort/print for 2006.575 ; 06/06/2005 09:13
2 ;;3.0;IMAGING;**10,11,51**;26-August-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 ;
20SRT ;Sort the file first by the patient name but only the unique entries.
21 ;The "F" cross reference uses the gateway site and study uid number.
22 N MAGSUID,MAGIEN,MAGPT ;
23 N GWLOC ; -- gateway site
24 N KFIXALL ; -- does user hold the MAGDFIX ALL security key?
25 N MAGTYPE ; -- type of image (rad, med, clinspec)
26 ;
27 S KFIXALL=$$SECKEY^MAGDLB12
28 Q:'$D(^MAGD(2006.575,"F")) ;nothing to sort
29 K ^MAGD(2006.575,"D")
30 S GWLOC=""
31 F S GWLOC=$O(^MAGD(2006.575,"F",GWLOC)) Q:GWLOC="" D
32 . ; if this isn't the user's site, bail unless user holds the
33 . ; MAGDFIX ALL security key
34 . I GWLOC'=DUZ(2),'KFIXALL Q
35 . S MAGSUID=""
36 . F S MAGSUID=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID)) Q:MAGSUID="" D
37 . . S MAGIEN=0
38 . . F S MAGIEN=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)) Q:'MAGIEN D
39 . . . ; if no failed image rec, then there's a xref problem -> bail
40 . . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q
41 . . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN) ;clean up x-ref
42 . . . . Q
43 . . . ; if entry has already been corrected, do not include in sort
44 . . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
45 . . . ;Only Clinical Specialties images!
46 . . . S MAGTYPE=$P($G(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
47 . . . I MAGTYPE'="CON" Q
48 . . . S MAGPT=$P(^MAGD(2006.575,MAGIEN,0),"^",4)
49 . . . S ^MAGD(2006.575,"D",MAGPT,MAGIEN)=""
50 . . . Q
51 . . Q
52 . Q
53 Q
54 ;
55SRTDT ;Provide sorting by date entry but only if NOT fixed and by unique suid
56 N MAGSUID,MAGIEN,MAGDT
57 N GWLOC ; -- gateway site
58 N KFIXALL ; -- does user hold the MAGDFIX ALL security key?
59 N MAGTYPE ; -- type of image (rad, med, clinspec)
60 ;
61 S KFIXALL=$$SECKEY^MAGDLB12
62 Q:'$D(^MAGD(2006.575,"F"))
63 K ^MAGD(2006.575,"AD")
64 S GWLOC=""
65 F S GWLOC=$O(^MAGD(2006.575,"F",GWLOC)) Q:GWLOC="" D
66 . ; if this isn't the user's site, bail unless user holds the
67 . ; MAGDFIX ALL security key
68 . I GWLOC'=DUZ(2),'KFIXALL Q
69 . S MAGSUID=""
70 . F S MAGSUID=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID)) Q:MAGSUID="" D
71 . . S MAGIEN=0
72 . . F S MAGIEN=$O(^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)) Q:'MAGIEN D
73 . . . ; if no failed image rec, then there's a xref problem -> bail
74 . . . I '$D(^MAGD(2006.575,MAGIEN,0)) D Q
75 . . . . K ^MAGD(2006.575,"F",GWLOC,MAGSUID,MAGIEN)
76 . . . . Q
77 . . . ; if entry has already been corrected, do not include in sort
78 . . . I $D(^MAGD(2006.575,MAGIEN,"FIXD")),$P(^("FIXD"),"^") Q
79 . . . ;Only Clinical Specialties images!
80 . . . S MAGTYPE=$P($G(^MAGD(2006.575,MAGIEN,"TYPE")),"^")
81 . . . I MAGTYPE'="CON" Q
82 . . . Q:'$D(^MAGD(2006.575,MAGIEN,1))
83 . . . S MAGDT=$P(^MAGD(2006.575,MAGIEN,1),"^",3)
84 . . . S ^MAGD(2006.575,"AD",MAGDT,MAGIEN)=""
85 . . . Q
86 . . Q
87 . Q
88 Q
89 ;
90PRTDT(SORT,START,STOP) ;
91 ;Print entries using the "AD" cross reference (date order)
92 ; OR the "F" cross reference (unique study uid)
93 I '$D(DUZ) W !,"DUZ variable not defined." Q
94 I "DF"'[SORT Q ;only the date or unique suid
95 N DIC,BY,FLDS,L,FR,TO
96 S L(0)=2
97 I SORT="D" S SORT="AD" D
98 . I $L($G(START))>1,$L($G(STOP))>1 S FR(0,1)=START,TO(0,1)=STOP
99 . Q
100 S DIC="^MAGD(2006.575,",BY(0)="^MAGD(2006.575,"""_SORT_""","
101 S FLDS="[MAG FAILED IMAGES]",L=0
102 D EN1^DIP
103 Q
104 ;
105ADATE() ;date
106 N DIR,X,Y
107 S DIR(0)="D^",DIR("A")=$G(MESSAGE) D ^DIR
108 Q Y
109 ;
110ASKDT ;Ask date range
111 N MESSAGE
112 S MESSAGE="Enter start date" S STR=$$ADATE
113 Q:'STR
114 I STR'?7N W "Wrong date format." Q
115 S MESSAGE="Enter stop date" S STP=$$ADATE
116 I STP'?7N W "Wrong date format." Q
117 Q
118 ;
119PRNT ;
120 N DIR,X,Y,BY
121 S DIR(0)="S^D:Date;F:Unique Entries"
122 D ^DIR
123 Q:"DF"'[Y
124 I Y="D" D Q:'$D(STR)!'$D(STP)
125 . D ASKDT Q:'$D(STR)!'$D(STP)
126 . W !,"Please hold sorting by Date. " D SRTDT
127 . Q
128 S BY=Y K DIR,X,Y,DTOUT,DIRUT,DTOUT
129 D PRTDT(BY,$G(STR),$G(STP))
130 K BY,STR,STP
131 Q
132 ;
Note: See TracBrowser for help on using the repository browser.