source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA1.m@ 1203

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

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