source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIA1.m@ 1718

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

WorldVistAEHR overlayed on FOIAVistA
File size: 8.0 KB
Line 
1MAGGSIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ]
2 ;;3.0;IMAGING;**7,8,85**;16-March-2007;;Build 1039
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
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
19PRE(MAGERR,MAGGFDA,MAGGRP,MAGGDRV,MAGREF) ;
20 ; Check on some possible problems: required fields etc.
21 ; Object Type and (Patient, or Short Desc) Required.
22 N MAGRSLT,X,Z
23 I '$D(MAGGFDA(2005,"+1,",3)) D OBJTYPE
24 I '$D(MAGGFDA(2005,"+1,",3)) S MAGERR="0^Need an Object Type " Q
25 I '$D(MAGGFDA(2005,"+1,",5)),'$D(MAGGFDA(2005,"+1,",10)) D Q
26 . S MAGERR="0^Need Patient or Short Desc. Operation CANCELED "
27 ; IF no Procedure text we'll give it some so crossref will set.
28 D PATCHK(.MAGRSLT) I 'MAGRSLT S MAGERR=MAGRSLT Q
29 ; Patch 8 IAPI We Create IXCLS (#41 CLASS) and IXPKG (#40 Package) if TYPE is in Data.
30 ; But we are not making TYPE required yet for backward compatibality.
31 I $D(MAGGFDA(2005,"+1,",42)) D
32 . I $$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),2,"E")="INACTIVE" D S MAGRY=MAGERR Q
33 . . S MAGERR="0^Index Type: "_$$GET1^DIQ(2005.83,MAGGFDA(2005,"+1,",42),.01,"E")_"is INACTIVE"
34 . I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
35 . I ($D(MAGGFDA(2005,"+1,",16)))&($$ISTYPADM(MAGGFDA(2005,"+1,",42))) D S MAGRY=MAGERR Q
36 . . S MAGERR="0^Can't have an ADMIN TYPE with Clinical Image."
37 . I '$D(MAGGFDA(2005,"+1,",40)) D MAKEPKG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
38 . I '$D(MAGGFDA(2005,"+1,",6)) D MAKEPROC^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
39 . I '$D(MAGGFDA(2005,"+1,",45)) D MAKEORIG^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q
40 . Q
41 ;
42 I '$D(MAGGFDA(2005,"+1,",6)) D PROCTEXT
43 ;
44 ; If no Procedure/Exam Date/Time we'll give it DocDT, or NOW
45 I '$D(MAGGFDA(2005,"+1,",15)) D
46 . I $D(MAGGFDA(2005,"+1,",110)) S MAGGFDA(2005,"+1,",15)=MAGGFDA(2005,"+1,",110) Q
47 . S MAGGFDA(2005,"+1,",15)=$E($$NOW^XLFDT,1,12)
48 ; DateTime image saved.
49 I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$E($$NOW^XLFDT,1,12)
50 ; Short Description
51 ;I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
52 I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$G(MAGGFDA(2005,"+1,",6))
53 ; Name (.01)
54 I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGSIU1(.MAGGFDA)
55 I '$D(MAGGFDA(2005,"+1,",8)) S MAGGFDA(2005,"+1,",8)=$G(DUZ)
56 ; Acquisition Site, Use it to tell where to save the file.
57 I $D(MAGACT("ACQS")) D
58 . ; Patch 8 Have to modify: Field 105 (Acquisition Site) is NOW Field .05
59 . I $P(MAGACT("ACQS"),";")]"" S MAGGFDA(2005,"+1,",.05)=$P(MAGACT("ACQS"),";")
60 ; Only get drive:dir if not a group
61 I 'MAGGRP D I $L(MAGERR) Q
62 . ; The value of the Action Code "WRITE^value" OVERRIDES any Write Location
63 . ; sent as field # 2 in the input array. (The only value we check for is "PACS" from peter's code)
64 . S X=$S($D(MAGACT("WRITE")):MAGACT("WRITE"),$D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"")
65 . ;P85 Send ACQS as second Param. $$DRIVE will use ACQS If X = ""
66 . ;
67 . S Z=$$DRIVE^MAGGTU1(X,$G(MAGGFDA(2005,"+1,",.05))) ;Drv:Dir to Write
68 . I 'Z S MAGERR=Z Q
69 . S MAGGDRV=$P(Z,U,2)
70 . S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic
71 . ; if a big file is being made on workstation, put NetWork Location
72 . ; pointer in the BIG NETWORK LOCATION field.
73 . ; (BIG files default to same Network Location as FullRes (or PACS))
74 . I $G(MAGACT("BIG"))=1 S MAGGFDA(2005,"+1,",102)=+Z
75 . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGSIA1
76 . I $G(MAGACT("ABS"))="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z
77 ;
78 I $D(MAGACT("ACQL")) S MAGGFDA(2005,"+1,",101)=MAGACT("ACQL")
79 ; HERE we are putting PRE Processing for the Import API action codes.
80 ; "ACQD,ACQS" If Acquisition device entry doesn't exist, create it.
81 I $D(MAGACT("ACQD")) D
82 . ; IF Value is a pointer to the ACQ DEVICE File Quit. If it's invalid then UPDATE will catch it.
83 . I (+MAGACT("ACQD")=MAGACT("ACQD")) S MAGGFDA(2005,"+1,",107)=MAGACT("ACQD") Q
84 . I $D(^MAG(2006.04,"B",MAGACT("ACQD"))) D Q
85 . . ; IF Already exists, add it to the FDA
86 . . S MAGGFDA(2005,"+1,",107)=$O(^MAG(2006.04,"B",MAGACT("ACQD"),""))
87 . . ; What do we do with the Acquisition Site. IF Acq Dev already exists. ?
88 . . ; ??
89 . ; IF it doesn't exist, create it, and add it's ien to the image entry
90 . N MAGDFDA,MAGDIEN,MAGDXE
91 . S MAGDFDA(2006.04,"+1,",.01)=MAGACT("ACQD")
92 . S MAGDFDA(2006.04,"+1,",1)=$S($D(MAGACT("ACQS")):$P(MAGACT("ACQS"),";"),1:$G(MAGGFDA(2005,"+1,",.05)))
93 . S MAGDFDA(2006.04,"+1,",2)=$S($D(MAGACT("ACQL")):MAGACT("ACQL"),$D(MAGGFDA(2005,"+1,",101)):MAGGFDA(2005,"+1,",101),1:$P($G(MAGACT("ACQS")),";",2))
94 . ; ACQS was a 2 ';' piece value with Acq Location (HOSPITAL LOCATION) as 2nd piece
95 . ; now it is sent as it's own value in ACQL
96 . D UPDATE^DIE("","MAGDFDA","MAGDIEN","MAGDXE")
97 . S MAGGFDA(2005,"+1,",107)=MAGDIEN(1)
98 ;
99 ; Check the last entry in Audit File to see if it is greater than
100 ; last image in Image File. IF yes, change Image File (0) node entry.
101 I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
102 ;
103 Q
104PATCHK(MAGR) ; This uses the FDA Array and checks the Imaging Patient against the Procedure patient
105 ;
106 N MAGDFN,PX,PXDA,MAGY
107 S PX=$G(MAGGFDA(2005,"+1,",16))
108 S PXDA=$G(MAGGFDA(2005,"+1,",17))
109 I 'PX S MAGR=1 Q ; This is a category, or an Image of a group (no parent pointer)
110 S MAGDFN=MAGGFDA(2005,"+1,",5)
111 I (PX=8925) D Q
112 . I '$D(^TIU(8925,PXDA)) S MAGR="0^Invalid TIU Entry Number: "_PXDA Q
113 . D DATA^MAGGNTI(.MAGY,PXDA)
114 . I '(MAGDFN=$P(MAGY,U,4)) S MAGR="0^Procedure and Imaging patients don't match." Q
115 . S MAGR=1
116 Q
117OBJTYPE ; This call uses the EXT and computes an Object Type
118 N MTYPE
119 I '$L($G(MAGACT("EXT"))) Q
120 S MTYPE=$O(^MAG(2005.02,"AD",MAGACT("EXT"),""))
121 ;I 'MTYPE Q
122 ;TODO : Answer question, do we want to have a default Image type ?
123 I 'MTYPE S MTYPE=1
124 S MAGGFDA(2005,"+1,",3)=MTYPE
125 Q
126ISTYPADM(TYPE) ; Returns 1 if this is an Admin Type
127 N CL
128 I '$G(TYPE) Q 0
129 S CL=$$GET1^DIQ(2005.83,TYPE,1,"E")
130 Q $S($E(CL,1,5)="ADMIN":1,1:0)
131PROCTEXT ;This call uses flds 16 and 17 to compute fld #6 PROCEDURE TEXT [8F]
132 ; We are here because fld #6 PROCEDURE [8F] is null.
133 ; If a pointer to a package is in the data, (flds 16 and 17)
134 ; get fld #6 from that , if not then treat it as an UNASSIGNED image
135 ; i.e. Category UNASSIGNED.
136 N MAGYPX,PARENT,PARIEN,PXDESC
137 S PARENT=$G(MAGGFDA(2005,"+1,",16))
138 S PARIEN=$G(MAGGFDA(2005,"+1,",17))
139 ;
140 I (PARENT=8925),(PARIEN]"") D Q
141 . D DATA^MAGGNTI(.MAGYPX,PARIEN)
142 . S MAGGFDA(2005,"+1,",6)=$P(MAGYPX,U,2)
143 ;TODO; create calls to get default procedure desc for all specialties
144 ; AND default to NONE if a TYPE and no PARENT data File (fld 16)
145 ; If a Parent pointer exists, and it isn't TIU, for now set "NO Description"
146 I PARENT]"" S MAGGFDA(2005,"+1,",6)="No Description" Q
147 ;
148 ; Do we have a pointer to a MAG DESCRIPTIVE CATEGORY
149 I ($G(MAGGFDA(2005,"+1,",100))]"") D Q
150 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005.81,MAGGFDA(2005,"+1,",100),0),U,1)
151 ;
152 ; If a new child of a Group, use that Proc Desc
153 I $G(MAGGFDA(2005,"+1,",14))]"" D Q
154 . S MAGGFDA(2005,"+1,",6)=$P(^MAG(2005,MAGGFDA(2005,"+1,",14),0),U,8)
155 ;
156 ; Parent="", and no Category pointer, then we Call it UNASSIGNED
157 S MAGGFDA(2005,"+1,",100)=$O(^MAG(2005.81,"B","UNASSIGNED",""))
158 S MAGGFDA(2005,"+1,",6)="UNASSIGNED"
159 Q
Note: See TracBrowser for help on using the repository browser.