| [613] | 1 | MAGDRA1 ;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
|
|---|
| 19 | LOOP ;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
|
|---|
| 65 | PRT ;
|
|---|
| 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
|
|---|
| 73 | HEAD ;
|
|---|
| 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
|
|---|
| 80 | SEL ;
|
|---|
| 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
|
|---|
| 93 | SET ;
|
|---|
| 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
|
|---|
| 102 | CHECK ;
|
|---|
| 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
|
|---|
