source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDRA1.m@ 1147

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1MAGDRA1 ;WOIFO/LB -Routine for DICOM fix ; 09/15/2004 13:34
2 ;;3.0;IMAGING;**10,11,30**;16-September-2004
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
19LOOP ;Loop thru ^TMP($J,"RAE1" global
20 ;MAGDFN should exist.
21 ;MAGNME,MAGSSN may exist.
22 Q:'$D(^TMP($J,"RAE1"))!('$D(MAGDFN))
23 N CCASE,CASE,CDATE,CODE,DATA,DATE,ENTRY,ENTRIES,ERR,ESTAT,INDEX
24 N LOC,MAGCASE,MAGCNI,MAGCPT,MAGDTI,MAGPIEN,MAGPRC,MAGPSET,MAGPST
25 N OUT,OLDCNI,OLDDT,OLDENTRY,PROC,PSET,PTINFO,RARPT,RADTI,RACNI,RADFN
26 N RAMELOW,RAPRTSET,REIN,STAT,X,Y
27 S (ENTRY,ENTRIES,OLDDT)=0
28 F S ENTRY=$O(^TMP($J,"RAE1",MAGDFN,ENTRY)) Q:'ENTRY!$G(OUT) D
29 . S DATA=^TMP($J,"RAE1",MAGDFN,ENTRY),ENTRIES=ENTRIES+1
30 . S DATE=$P(ENTRY,"-"),CDATE=9999999.9999-DATE
31 . S DATE=$TR($$FMTE^XLFDT(CDATE,"2FD")," ","0")
32 . S PROC=$P(DATA,"^"),CASE=$P(DATA,"^",2),STAT=$P(DATA,"^",6)
33 . S ESTAT=$P(STAT,"~",2),LOC=$P(DATA,"^",7)
34 . S RARPT=$P(DATA,"^",5)
35 . S RADTI=$P(ENTRY,"-"),RACNI=$P(ENTRY,"-",2),RADFN=MAGDFN
36 . S MAGCASE=$$LCASE^MAGDRA2(CDATE,CASE)
37 . ;Above radiology variables needed for EN1^RAULT20
38 . K RAMELOW,RAPRTSET
39 . D EN1^RAUTL20
40 . S (PSET,MAGPSET)=""
41 . I OLDDT'=RADTI S OLDCNI=""
42 . S PSET=$S(RAMEMLOW:"+",RAPRTSET:".",1:"")
43 . I PSET="+" S OLDCNI=RACNI
44 . I PSET=".",OLDCNI D
45 . . N OLDENTRY S OLDENTRY=$P(ENTRY,"-")_"-"_OLDCNI
46 . . I $D(^TMP($J,"RAE1",MAGDFN,OLDENTRY)) D
47 . . . S MAGCASE=$P(^TMP($J,"RAE1",MAGDFN,OLDENTRY),"^",2)
48 . . . S CDATE=$P(ENTRY,"-")
49 . . . S CDATE=9999999.9999-CDATE,RADTI=$P(OLDENTRY,"-"),RACNI=OLDCNI
50 . . . S MAGCASE=$$LCASE^MAGDRA2(CDATE,MAGCASE)
51 . . . S MAGPSET=CASE_" is part of this printset."
52 . . . Q
53 . . Q
54 . I '$D(MAGNME)!'($D(MAGSSN)) D
55 . . S PTINFO=$$PTINFO^MAGDRA2
56 . . S MAGNME=$P(PTINFO,"^"),MAGSSN=$P(PTINFO,"^",2)
57 . . Q
58 . S INDEX(ENTRIES)=PROC_"^"_$G(MAGPSET)_"^"_RADTI_"^"_RACNI_"^"_MAGCASE
59 . ; Radiology procedure^Printset^Inverse radiology date/time^Radioloty multiple^radiology case number
60 . D PRT S OLDDT=RADTI
61 . Q
62 D:'$G(OUT) SEL I +X,$D(INDEX(+X)) D SET
63 K OUT
64 Q
65PRT ;
66 S (X,Y)=0
67 I ENTRIES=1 D HEAD
68 I $Y+6>IOSL D HEAD
69 W !?1,ENTRIES,?5,PSET,?6,CASE_$$IMG^MAGDRA2(RARPT),?12,$E(PROC,1,28)
70 W ?41,DATE,?52,$E(ESTAT,1,12),?67,$E(LOC,1,12) Q:ENTRIES#15
71 D SEL
72 Q
73HEAD ;
74 W @IOF,"Patient: ",MAGNME,?50,"SSN: ",MAGSSN
75 W !!,?3,"Case #",?12,"Procedure",?41,"Exam Date",?52,"Status of"
76 W "Exam",?69,"Imaging Loc"
77 W !?3,"--------",?12,"-------------",?41,"---------"
78 W ?52,"--------------",?67,"-----------"
79 Q
80SEL ;
81 N DIR ; -- array for FileMan prompt data
82 S DIR(0)="NAO^1:"_ENTRIES
83 S DIR("?",1)="Enter a number between 1 and "_ENTRIES
84 S DIR("?")="corresponding to a single exam you wish to select."
85 S DIR("A",1)="'i' next to a case number denotes images collected on study."
86 S DIR("A")="Select an exam: "
87 D ^DIR
88 I '$D(DTOUT),'$D(DUOUT) ; didn't time out or uparrow out
89 E S OUT=1 Q
90 I Y,$D(INDEX(Y)) D CHECK I 'Y G SEL
91 I Y S Y=INDEX(Y) S OUT=1
92 Q
93SET ;
94 S DATA=Y K Y
95 S MAGCASE=$P(INDEX(+X),"^",5)
96 S MAGPRC=$P(INDEX(+X),"^"),MAGPIEN=$$PROC^MAGDRA2(MAGPRC)
97 S MAGDTI=$P(INDEX(+X),"^",3)
98 S MAGPST=$P(INDEX(+X),"^",2)
99 S MAGCNI=$P(INDEX(+X),"^",4)
100 D MAGDY^MAGDRA2
101 Q
102CHECK ;
103 ;Check to see if the entry still exists.
104 N RADTI,CNI
105 Q:'MAGDFN
106 S RADTI=$P(INDEX(Y),"^",3),CNI=$P(INDEX(Y),"^",4)
107 I '$D(^RADPT(MAGDFN,"DT",RADTI,"P",CNI)) D
108 . S Y=""
109 . W !,"There is a database problem with the entry selected.",!
110 . Q
111 I $P(INDEX(Y),"^")="" D
112 . S Y=""
113 . W !,"There are no procedures for the entry selected.",!
114 Q
Note: See TracBrowser for help on using the repository browser.