source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDRA2.m@ 1604

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

initial load of WorldVistAEHR

File size: 4.8 KB
Line 
1MAGDRA2 ;WOIFO/LB -Routine for DICOM fix [ 06/20/2001 08:56 ] ; 06/06/2005 09:28
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 ; Routine to create the MAGDY variable needed by MAGDLB1 routine when
20 ; manually correcting DICOM FIX files.
21EN ;
22 ; MAGDY variable to be created during this execution.
23 N MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGSSN
24 S MAGBEG=1070101,MAGEND=$$DT^XLFDT
25READ ;
26 S (MAGDFN,MAGX)=$$READ^MAGDRA3
27 Q:MAGX="^"
28 S MAGDFN=+MAGDFN
29 I 'MAGDFN W !,"Entry not found, enter a ""^"" to quit." G READ
30 ;
31 I MAGX["~" G ONE ;Lookup was on case number and successful
32 S MAGXX=$$FIND1^DIC(70,"","","`"_MAGDFN) ;Radiology patient
33 ;
34 I MAGDFN=MAGXX D
35 . S INFO=$$PTINFO Q:$D(MAGERR)
36 . S MAGNME=$P(INFO,"^"),MAGSSN=$P(INFO,"^",2)
37 . K ^TMP($J,"RAE1") ;Re-established by EN1^RA07PC1 -DBIA available
38 . ; Set the beginning and ending date.
39 . D EN1^RAO7PC1(MAGDFN,MAGBEG,MAGEND,500)
40 . D:$D(^TMP($J,"RAE1")) LOOP^MAGDRA1
41 . Q
42 E D G:MAGX'="^" READ
43 . W !,"No Radiology information found for the supplied answer.",$C(7)
44 . Q
45 Q
46 ;
47PTINFO() ;
48 N INFO,MAGOUT
49 I '$D(MAGDFN) Q ""
50 D GETS^DIQ(2,MAGDFN,".01;.09","E","MAGOUT","MAGERR")
51 I $D(MAGERR) Q ""
52 I $D(MAGOUT) D Q INFO
53 . S INFO=$G(MAGOUT(2,MAGDFN_",",.01,"E"))
54 . S INFO=INFO_"^"_$G(MAGOUT(2,MAGDFN_",",.09,"E"))
55 . Q
56 Q ""
57 ;
58LCASE(MAGDT,MAGCASE) ;
59 Q $TR($TR($$FMTE^XLFDT(MAGDT,"2FD")," ","0"),"/","")_"-"_MAGCASE
60 ;
61IMG(MAGRPT) ;
62 N INFO,MAGOUT,MAGERR
63 I 'MAGRPT Q ""
64 D GETS^DIQ(74,MAGRPT,"2005*","I","MAGOUT","MAGERR")
65 I $D(MAGERR) Q ""
66 I $D(MAGOUT(74.02005)) Q " i"
67 Q ""
68 ;
69PROC(MAGPRC) ;
70 Q $$FIND1^DIC(71,,"XB",MAGPRC)
71 ;
72ONE ;
73 ;MAGDFN,MAGX variables expected from EN
74 I 'MAGDFN,'+MAGX Q
75 N BEG,CASE,CDATE,CS,DATA,END,FLDS,INFO,MAGCASE,MAGCNI,MAGDATE,MAGDTI
76 N MAGEXST,MAGLOC,MAGNME,MAGOUT,MAGPIEN,MAGPRC,MAGPSET,MAGPST,MAGRPT
77 N PP,PSET,RAENTRY,RAMEMLOW,RAPRTSET,RIEN,STAT,X,X1,X2,XX
78 N RARPT,RADFN,RADTI,RACNI ;<--Variables needed for EN1^RAUTL20
79 ; RAUTL20 used to retrieve if case is part of a print set.
80 S MAGDFN=$P(MAGX,"~"),INFO=$$PTINFO
81 S MAGNME=$P(INFO,"^"),MAGSSN=$P(INFO,"^",2)
82 S RIEN=$P(MAGX,"~",2)_","_$P(MAGX,"~",1)
83 S X1=9999999.9999-$P(MAGX,"~",2),X2=+2 D C^%DTC
84 S END=X,BEG=9999999.9999-$P(MAGX,"~",2)
85 K ^TMP($J,"RAE1")
86 D EN1^RAO7PC1(MAGDFN,BEG,END,20)
87 S RAENTRY=$P(MAGX,"~",2)_"-"_$P(MAGX,"~",3)
88 Q:'$D(^TMP($J,"RAE1"))
89 Q:'$D(^TMP($J,"RAE1",MAGDFN,RAENTRY))
90 S DATA=^TMP($J,"RAE1",MAGDFN,RAENTRY)
91 S MAGDATE=$P(RAENTRY,"-"),CDATE=9999999.9999-MAGDATE
92 S MAGDATE=$TR($$FMTE^XLFDT(CDATE,"2FD")," ","0")
93 S MAGPRC=$P(DATA,"^"),CASE=$P(DATA,"^",2),STAT=$P(DATA,"^",6)
94 S MAGEXST=$P(STAT,"~",2),MAGLOC=$P(DATA,"^",7)
95 S (MAGRPT,RARPT)=$P(DATA,"^",5)
96 S (MAGDTI,RADTI)=$P(RAENTRY,"-")
97 S (MAGCNI,RACNI)=$P(RAENTRY,"-",2),RADFN=MAGDFN
98 S MAGCASE=$$LCASE(CDATE,CASE),MAGPIEN=$$PROC(MAGPRC)
99 ; RADTI, RADFN, RACNI variables needed for EN1^RAULT20
100 D EN1^RAUTL20
101 S (PSET,MAGPSET)=""
102 S PSET=$S(RAMEMLOW:"+",RAPRTSET:".",1:"")
103 I PSET=".",RACNI>1 D
104 . N OLDENTRY S OLDENTRY=$P(RAENTRY,"-")_"-"
105 . S OLDENTRY=$O(^TMP($J,"RAE1",MAGDFN,OLDENTRY)) I $L(OLDENTRY) D
106 . . S MAGCASE=$P(^TMP($J,"RAE1",MAGDFN,OLDENTRY),"^",2)
107 . . S CDATE=$P(RAENTRY,"-")
108 . . S CDATE=9999999.9999-CDATE
109 . . S MAGCASE=$$LCASE^MAGDRA2(CDATE,MAGCASE),RACNI=$P(OLDENTRY,"-",2)
110 . . S MAGPST=CASE_" is part of this printset."
111 . . Q
112 . Q
113 I $D(RAPRTSET) S PP=$S(MAGCNI>1:".",MAGCNI=1:"+",1:"")
114 S MAGCNI=RACNI
115 W !,"PATIENT: ",MAGNME,?51,"SSN: ",MAGSSN
116 W !,"Case No.",?15,"Procedure",?42,"Location",?64,"Exam Date"
117 W !,"________",?15,"_________",?42,"________________",?64,"________"
118 W !,$G(PP),CASE,$$IMG(MAGRPT),?15,MAGPRC,?42,MAGLOC,?64,MAGDATE
119 W !,"Exam status: ",MAGEXST," "," ",$G(MAGPST)
120 D MAGDY
121 Q
122 ;
123MAGDY ;
124 S MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGSSN_"^"_MAGCASE_"^"_MAGPRC_"^"_MAGDTI
125 S MAGDY=MAGDY_"^"_MAGCNI_"^"_MAGPIEN_"^"_$G(MAGPST)_"^"
126 K MAGNME,MAGSSN,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST
127 Q
Note: See TracBrowser for help on using the repository browser.