source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA.m@ 1214

Last change on this file since 1214 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1MAGGTIA ;WOIFO/GEK/RMP - Imaging RPC Broker calls. Add/Modify Image entry ; [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**8,48**;Jan 11, 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 ;
20 ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE
21 ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL.
22 ;
23ADD(MAGRY,MAGGZ) ; RPC [MAGGADDIMAGE]
24 ; Call to UPDATE^DIE to Add an Image File entry
25 ; MAGGZ is an array of fields and their entries
26 ; i.e. MAGGZ(1)=".5^38" Image File, field .5 data is 38
27 ; If Long Description is included in fields, we create a new
28 ; array to hold the text, and pass that to UPDATE^DIE
29 ; If this entry is an object group
30 ; i.e. MAGGZ(n)="2005.04^344"
31 ; (the field 2005.04 is the OBJECT GROUP MULTIPLE)
32 ;
33 ; MAGRY - Ret variable (Single Variable)
34 ;
35 ; Changed to include hierarchical directory hash - PMK 04/23/98
36 ; If successful MAGRY = IEN^FILE NAME (with full path)
37 ; IEN is Internal Entry Number of ^MAG(2005
38 ; If UNsuccessful MAGRY = 0^Error desc
39 ;
40 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK
41 ; TO THE NEW FILE NAME RETURNED BY THIS CALL.
42 ;----------------------------------------------------------------
43 N MAGGXE,MAGGFDA,MAGGIEN,MAGGDRV,MAGGR,MAGGRC,MAGGDA,MAGGFNM
44 N MAGGWP,MAGGWPC,MAGGFLD,MAGGDAT,MAGERR,MAGGEXT,MAGGJB
45 N MAGADD,MAGMOD,MAGWRITE,MAGREF,MAGDHASH,MAGDCMSN,MAGDCMIN
46 N MAGBIG,MAGGABS,MAGQY,MAGRET,MAGETXT
47 N MAGFSPEC,MAGFNM
48 N I,J,X,Y,Z,ZZ
49 ;
50 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"
51 ;
52 S MAGADD=1 ;Flag says we are adding an entry.
53 S MAGRY="0^Starting Add Image Entry"
54 S MAGERR="",MAGGR=0,MAGGRC=1,MAGGWPC=0
55 I ($D(MAGGZ)<10) S MAGRY="0^No input data, Operation CANCELED" Q
56 ;
57 S Z="" F S Z=$O(MAGGZ(Z)) Q:Z="" D I $L(MAGERR) Q
58 . S MAGGFLD=$P(MAGGZ(Z),U,1),MAGGDAT=$P(MAGGZ(Z),U,2,99)
59 . I MAGGFLD=""!(MAGGDAT="") S MAGRY="0^Field and Value are Required" Q
60 . I MAGGFLD=5 S MAGGDAT=+MAGGDAT ; MOD RED 10/5/95
61 . I MAGGFLD=2005.04 S MAGGDAT=+MAGGDAT ; MOD RED 10/18/95
62 . I MAGGFLD="IEN" S MAGMOD=+MAGGDAT Q
63 . I MAGGFLD="EXT" S MAGGEXT=MAGGDAT Q
64 . I MAGGFLD="ABS" S MAGGABS=MAGGDAT Q
65 . I MAGGFLD="JB" S MAGGJB=MAGGDAT Q
66 . I MAGGFLD="WRITE" S MAGWRITE=MAGGDAT Q
67 . I MAGGFLD="BIG" S MAGBIG=MAGGDAT Q
68 . I MAGGFLD="DICOMSN" S MAGDCMSN=MAGGDAT Q
69 . I MAGGFLD="DICOMIN" S MAGDCMIN=MAGGDAT Q
70 . ;
71 . ; if this is a group object.
72 . I MAGGFLD=2005.04 D Q
73 . . S MAGGR=1
74 . . I '+MAGGDAT Q ; making a group entry, with no group entries.
75 . . S MAGGR(MAGGDAT)=""
76 . . S MAGGRC=MAGGRC+1
77 . . I '$D(^MAG(2005,MAGGDAT,0)) S MAGERR="0^Group Object "_MAGGDAT_" doesn't exist"
78 . . S MAGGFDA(2005.04,"+"_MAGGRC_",+1,",.01)=MAGGDAT
79 . ;
80 . ; if we are getting a WP for Long Desc, set array to pass.
81 . I MAGGFLD=11 D ; this is a line of the WP Long Desc field.
82 . . S MAGGWPC=MAGGWPC+1,MAGGWP(MAGGWPC)=MAGGDAT
83 . ;
84 . ;if a BAD field number
85 . I '$$VFIELD^DILFD(2005,MAGGFLD) S MAGERR="0^Field Number "_MAGGFLD_" doesn't exist" Q
86 . ;
87 . ; Get Field Specifiers
88 . D FIELD^DID(2005,MAGGFLD,"","LABEL;SPECIFIER","MAGFSPEC")
89 . ; if a Date field, we'll convert it here.
90 . I (MAGFSPEC("SPECIFIER")["D") D Q:$L(MAGERR)
91 . . S %DT="T",X=MAGGDAT D ^%DT
92 . . I Y=-1 S MAGERR="0^Invalid Date: "_MAGGDAT_" Field: "_MAGFSPEC("LABEL") Q
93 . . S MAGGDAT=Y
94 . ;
95 . ; if a pointer field, we'll assure the pointed to entry exists.
96 . I (MAGFSPEC("SPECIFIER")["P") D Q:$L(MAGERR)
97 . . I ($$EXTERNAL^DILFD(2005,MAGGFLD,"",MAGGDAT)="") S MAGERR="0^Invalid Value for Field "_MAGFSPEC("LABEL") Q
98 . ;
99 . I (MAGFSPEC("SPECIFIER")["S") D Q:$L(MAGERR)
100 . . D VAL^DIE(2005,"",MAGGFLD,"",MAGGDAT,.MAGRET,"","MAGETXT") I MAGRET="^" D Q
101 . . . S MAGERR="0^"_MAGETXT("DIERR",1,"TEXT",1)
102 . . ;P48T1 This assures we are filing the Internal code for a set.
103 . . S MAGGDAT=MAGRET
104 . ;
105 . ; made it here, so set the Node for the UPDATE^DIC Call.
106 . S MAGGFDA(2005,"+1,",MAGGFLD)=MAGGDAT
107 ;
108 ; if there was an Error in data we'll quit now.
109 I $L(MAGERR) S MAGRY=MAGERR Q
110 I $D(MAGMOD) D
111 . I $D(MAGGWP) S MAGGFDA(2005,"+1,",11)="MAGGWP"
112 . S MAGMOD=MAGMOD_","
113 . M MAGXXX(2005,MAGMOD)=MAGGFDA(2005,"+1,") K MAGGFDA
114 . M MAGGFDA=MAGXXX K MAGXXX
115 I $D(MAGMOD) D ADD^MAGGTIA1 Q
116 ;
117 ; some possible problems, we'll check for now.
118 I '$D(MAGGFDA(2005,"+1,")) S MAGRY="0^No data to file Operation CANCELED " Q
119 ;
120 ; We're making Object Type and either Patient, or short Desc Required.
121 I '$D(MAGGFDA(2005,"+1,",3)) S MAGRY="0^Need an Object Type " Q
122 ; Change to require patient. not patient or short desc.
123 I '$D(MAGGFDA(2005,"+1,",5)) D Q
124 . S MAGRY="0^Need Patient. Operation CANCELED "
125 ; MAGQA check.
126 D QACHK^MAGGTIA2(.MAGQY,MAGGFDA(2005,"+1,",5),$G(MAGGFDA(2005,"+1,",16)),$G(MAGGFDA(2005,"+1,",17)))
127 I 'MAGQY S MAGRY=MAGQY Q
128 ;-Checking for a missing TYPE value, and generating a value if needed
129 ;- are being deferred to a later patch.
130 ; Check for Image TYPE #42
131 ;-I '$D(MAGGFDA(2005,"+1,",42)) D MAKETYPE^MAGGSIA1 I $L(MAGERR) S MAGRY=MAGERR Q
132 ; Check for Image Class, #41
133 I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
134 ; IF no Procedure text we'll give it some so crossref will set.
135 I '$D(MAGGFDA(2005,"+1,",6)) S MAGGFDA(2005,"+1,",6)="NO TEXT"
136 ; If no Procedure/Exam Date/Time we'll give it NOW
137 I '$D(MAGGFDA(2005,"+1,",15)) S MAGGFDA(2005,"+1,",15)=$$NOW^XLFDT
138 ; DateTime image saved.
139 I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$$NOW^XLFDT
140 ; If no INSTITUTION pointer then default to the DUZ(2) or the Kernel Site parameter file institution
141 I '$D(MAGGFDA(2005,"+1,",.05)) D
142 . I $D(DUZ(2)) S MAGGFDA(2005,"+1,",.05)=DUZ(2) Q
143 . ;Q:$T(KSP^XUPARAM)="" //GEK 4/15/2004 Not needed on Gateway anymore
144 . S MAGGFDA(2005,"+1,",.05)=$$KSP^XUPARAM("INST")
145 . Q
146 ;
147 I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGTIA1()
148 ; Only get drive:dir if not a group
149 I 'MAGGR D I $L(MAGERR) S MAGRY=MAGERR Q
150 . S X=$S($D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
151 . S Z=$$DRIVE^MAGGTU1(X) ;Drv:Dir to Write
152 . I 'Z S MAGERR=Z Q
153 . S MAGGDRV=$P(Z,U,2)
154 . S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic
155 . ; if a big file is being made on workstation, put NetWork Location
156 . ; pointer in the BIG NETWORK LOCATION field.
157 . ; (BIG files default to same Network Location as FullRes (or PACS))
158 . I $G(MAGBIG)=1 S MAGGFDA(2005,"+1,",102)=+Z
159 . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGTIA1
160 . I $G(MAGGABS)="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z
161 ;
162 ; If a Name (.01) wasn't sent, we'll make one
163 ; We know that either Patient or Short Desc, and Object Type exist
164 I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGTIA1()
165 ;
166 ; If a long description was sent.
167 I $D(MAGGWP) S MAGGFDA(2005,"+1,",11)="MAGGWP"
168 ;
169 D ADD^MAGGTIA1 ; continued
170 Q
Note: See TracBrowser for help on using the repository browser.