source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDCCS2.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: 3.6 KB
Line 
1MAGDCCS2 ;WOIFO/MLH - DICOM Correct - Clinical Specialties - subroutines ; 05/06/2004 06:32
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 ; Routine to create the MAGDY variable needed by MAGDCCS routine when
20 ; manually correcting DICOM FIX files.
21EN ;
22 ; MAGDY variable to be created during this execution.
23 N D,DIC,DZ,MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGSSN
24 S MAGBEG=1070101,MAGEND=$$DT^XLFDT
25 W !,"*** Select a request/consult with whose ***"
26 W !,"*** TIU note to associate this image ***"
27 S DIC="^GMR(123,",DIC(0)="AENZ"
28 S DIC("A")="Enter patient or request/consultation: "
29 S D="F",DZ="??"
30 S DIC("W")="W "" REQ/CON #"",Y"
31 S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,1)" ; TO SERVICE
32 S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,.02)" ; PATIENT NAME
33 ;
34 D IX^DIC
35 Q:$D(DUOUT)
36 Q:'$D(Y(0)) ; nothing selected
37 S (MAGDFN,MAGX)=$P(Y(0),U,2)_"~"_Y
38 ;
39 D ONE ; Lookup was on req/con number and successful
40 Q
41 ;
42PTINFO() ;
43 N INFO,MAGOUT
44 I '$D(MAGDFN) Q ""
45 D GETS^DIQ(2,MAGDFN,".01;.09","E","MAGOUT","MAGERR")
46 I $D(MAGERR) Q ""
47 I $D(MAGOUT) D Q INFO
48 . S INFO=$G(MAGOUT(2,MAGDFN_",",.01,"E"))
49 . S INFO=INFO_"^"_$G(MAGOUT(2,MAGDFN_",",.09,"E"))
50 Q ""
51 ;
52ONE ; Process the single entry that was selected.
53 ; MAGDFN,MAGX variables expected from EN
54 I 'MAGDFN,'+MAGX Q
55 N BEG,CASE,CDATE,CS,DATA,END,FLDS,INFO,MAGCASE,MAGCNI,MAGDATE,MAGDTI
56 N MAGEXST,MAGLOC,MAGNME,MAGOUT,MAGPIEN,MAGPRC,MAGPSET,MAGPST,MAGRPT
57 N PP,PSET,RAENTRY,RAMEMLOW,RAPRTSET,RIEN,STAT,X,X1,X2,XX
58 N RARPT,RADFN,RADTI,RACNI ;<--Variables needed for EN1^RAUTL20
59 ; RAUTL20 used to retrieve if case is part of a print set.
60 N MAGRCARY ; array of req/con data from file 123
61 N MAGIENS ; internal entry number for MAGRCARY
62 ;
63 S MAGDFN=$P(MAGX,"~"),INFO=$$PTINFO
64 S MAGNME=$P(INFO,"^"),MAGSSN=$P(INFO,"^",2)
65 S MAGCASE=$P($P(MAGX,"~",2),U)
66 S (MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAGLOC,MAGDATE,MAGEXST,MAGPST)=""
67 K MAGRCARY D GETS^DIQ(123,MAGCASE,"*","EI","MAGRCARY")
68 ;
69 S MAGIENS=$O(MAGRCARY(123,""))
70 S MAGPRC=MAGRCARY(123,MAGIENS,4,"E") ; procedure
71 S MAGLOC=MAGRCARY(123,MAGIENS,1,"E") ; to service
72 S MAGDATE=MAGRCARY(123,MAGIENS,.01,"E") ; request date
73 S MAGPST=MAGRCARY(123,MAGIENS,8,"E") ; procedure status
74 W !,"PATIENT: ",MAGNME,?51,"SSN: ",MAGSSN
75 W !,"Req/Con No.",?13,"Procedure",?38,"To Service",?58,"Req Date"
76 W !,"-----------",?13,"---------",?38,"----------------",?58,"--------"
77 W !,MAGCASE,?13,MAGPRC,?38,MAGLOC,?58,MAGDATE
78 W !,"Exam status: ",MAGEXST," "," ",$G(MAGPST)
79 D MAGDY
80 Q
81 ;
82MAGDY ;
83 S MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGSSN_"^"_"GMRC-"_MAGCASE_"^"_MAGPRC_"^"_MAGDTI
84 S MAGDY=MAGDY_"^"_MAGCNI_"^"_MAGPIEN_"^"_$G(MAGPST)_"^"
85 K MAGNME,MAGSSN,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST
86 Q
Note: See TracBrowser for help on using the repository browser.