source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNTI.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1MAGGNTI ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 04 Apr 2002 2:37 PM
2 ;;3.0;IMAGING;**10,8,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 ;; | 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
19FILE(MAGRY,MAGDA,TIUDA) ;RPC [MAG3 TIU IMAGE]
20 ; Call to file TIU and Imaging Pointers
21 ; TIU API to add image to TIU
22 N X
23 I $P(^TIU(8925,TIUDA,0),U,2)'=$P(^MAG(2005,MAGDA,0),U,7) S MAGRY="0^Patient Mismatch." Q
24 D PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA) ;
25 I 'MAGRY Q
26 ; Now SET the Parent fields in the Image File
27 S $P(^MAG(2005,MAGDA,2),U,6,8)=8925_U_TIUDA_U_+MAGRY
28 ; DONE.
29 S MAGRY="1^Image pointer filed successfully"
30 ; Now we save the PARENT ASSOCIATION Date/Time
31 D LINKDT^MAGGTU6(.X,MAGDA)
32 Q
33DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA]
34 ; Call to get TIU data from the TIUDA
35 ; Return = TIUDA^Document Type ^Document Date^DFN^Author DUZ
36 ;
37 S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I")_U_$$GET1^DIQ(8925,TIUDA,"1202","I")_U
38 Q
39IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE]
40 ; Call to get all images for a given TIU DA
41 ; We first get all Image IEN's breaking groups into separate images
42 ; Then get Image Info for each one.
43 ; MAGRY - Return array of Image Data entries
44 ; MAGRY(0) is 1 ^ message if successful
45 ; 0 ^ Error message if error;
46 ; TIUDA is IEN in ^TIU(8925
47 ;
48 ; Call TIU API to get list of Image IEN's
49 N MAGARR,CT,TCT,I,J,Z K ^TMP($J,"MAGGX")
50 N DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT
51 N TIUDFN,MAGQUIT ; MAGQI 8/22/01
52 ; MAGFILE is returned from MAGGTII
53 ;
54 S MAGQUIT=0 ; MAGQI 8/22/01
55 S TIUDFN=$P($G(^TIU(8925,TIUDA,0)),U,2) ;MAGQI 8/22/01
56 I 'TIUDFN S MAGRY(0)="0^Invalid Patient DFN for Note ID: '"_TIUDA_"'"
57 D GETILST^TIUSRVPL(.MAGARR,TIUDA)
58 S CT=0,TCT=0
59 ; Now get all images for all groups and single images.
60 S I="" F S I=$O(MAGARR(I)) Q:'I S DA=MAGARR(I) D ;Q:MAGQUIT
61 . S Z=$$ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_Z Q
62 . ; Check that array of images from selected TIUDA have
63 . ; same patient's and valid backward pointers
64 . I $P($G(^MAG(2005,DA,0)),U,7)'=TIUDFN S MAGQUIT=1,MAGNCHK="Patient Mismatch. TIU: "_TIUDA
65 . I $P($G(^MAG(2005,DA,2)),U,7)'=TIUDA S MAGQUIT=1,MAGNCHK="Pointer Mismatch. TIU: "_TIUDA
66 . I MAGQUIT S MAGXX=DA D INFO^MAGGTII D Q
67 . . ; remove the Abstract and Image File Names ; 2/14/03 p8t14 remove c:\program files. with .\bmp\
68 . . S $P(MAGFILE,U,2,3)="-1~Questionable Data Integrity^.\bmp\imageQA.bmp"
69 . . ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
70 . . S $P(MAGFILE,U,6)=$S(($P(MAGFILE,U,6)'=11):"99",1:11)
71 . . S $P(MAGFILE,U,10)="M"
72 . . ;Send the error message
73 . . S $P(MAGFILE,U,17)=MAGNCHK
74 . . S TCT=TCT+1,MAGRY(TCT)="B2^"_MAGFILE
75 . ;
76 . I $O(^MAG(2005,DA,1,0)) D Q
77 . . ; Integrity check, if group is questionable, add it's ien to list, not it's
78 . . ; children. Later when list is looped through, it's INFO^MAGGTII will be in
79 . . ; list. Have to do this to allow other images in list from TIU to be processed.
80 . . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP($J,"MAGGX",CT)=DA Q
81 . . S J=0 ; the following line needs to take only the first piece of the node - PMK 4/4/02
82 . . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP($J,"MAGGX",CT)=$P(^(J,0),"^")
83 . S CT=CT+1
84 . S ^TMP($J,"MAGGX",CT)=DA
85 ; Now get image info for each image
86 ;
87 S Z=""
88 S MAGQUIET=1
89 F S Z=$O(^TMP($J,"MAGGX",Z)) Q:Z="" D
90 . S TCT=TCT+1,MAGXX=^TMP($J,"MAGGX",Z)
91 . ;GEK 8/24/00 Stopping the Invalid Image IEN's and Deleted Images
92 . I '$D(^MAG(2005,MAGXX)) D Q
93 . . D INVALID^MAGGTIG(MAGXX,.MAGRSLT) S MAGRY(CT)=MAGRSLT
94 . D INFO^MAGGTII
95 . S MAGRY(TCT)="B2^"_MAGFILE
96 K MAGQUIET
97 S MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE"
98 ; Put the Image IEN of the last image into the group IEN field.
99 Q:'TCT
100 S $P(MAGRY(0),U,3)=TIUDA
101 K MAGRSLT
102 D DATA(.MAGRSLT,TIUDA)
103 S $P(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$P(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($P(MAGRSLT,U,3),"8")
104 ;
105 S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U),$G(MAGXX):MAGXX,1:0)
106 Q
107 ;. S Z=ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_$P(Z,U,2) Q
108ISDELIMG(MAGIEN) ; Is this a deleted Image.
109 N MAGDEL,MAGIMG,MAGR,Z,MAGT
110 S MAGDEL=$D(^MAG(2005.1,MAGIEN))
111 S MAGIMG=$D(^MAG(2005,MAGIEN))
112 I MAGIMG,'MAGDEL S MAGR="0^Valid Image"
113 I 'MAGIMG,MAGDEL S MAGR="1^Deleted Image",MAGT=66
114 I 'MAGIMG,'MAGDEL S MAGR="1^Invalid Image pointer",MAGT=67
115 I MAGIMG,MAGDEL S MAGR="0^Image IEN exists, and is Deleted !"
116 I 'MAGR Q MAGR
117 S MAGR=$P(MAGR,U,2)
118 S $P(Z,U,1,4)=MAGIEN_"^-1~"_MAGR_"^-1~"_MAGR_"^"_MAGR
119 S $P(Z,U,6)=MAGT
120 ;this stops Delphi App from changing Abstract BMP to OFFLINE IMAGE
121 S $P(Z,U,10)="M"
122 ;Send the error message
123 S $P(Z,U,17)=$P(MAGR,U,2)
124 Q Z
125ISDOCCL(MAGRY,IEN,TIUFILE,CLASS) ;RPC [MAGG IS DOC CLASS]
126 ;Checks to see if IEN of TIU Files 8925 or 8925.1 is of a certain Doc Class
127 ;MAGRY = Return String
128 ; for Success "1^message"
129 ; for Failure "0^message"
130 ;IEN = Internal Entry Number in the TIUFILE
131 ;TIUFILE = either 8925 if we need to see if a Note is of a Document Class
132 ; or 8925.1 if we need to see if a Title is of a Document Class
133 ;CLASS = Text Name of the Document Class example: "ADVANCE DIRECTIVE"
134 ;
135 S MAGRY="0^Unknown Error checking TIU Document Class"
136 K MAGTRGT,DEFIEN,DOCCL,RES,DONE,NTTL
137 S DONE=0
138 ; If we're resolving a Title
139 I TIUFILE="8925.1" D Q:DONE
140 . S DEFIEN=IEN,NTTL="Title"
141 . I '$D(^TIU(8925.1,DEFIEN,0)) S MAGRY="0^Invalid Title IEN",DONE=1 Q
142 . Q
143 ; If we're resolving a Note
144 I TIUFILE="8925" D Q:DONE
145 . S NTTL="Note"
146 . I '$D(^TIU(8925,IEN)) S MAGRY="0^Invalid Note IEN",DONE=1 Q
147 . ; Get Title IEN from Note IEN
148 . S DEFIEN=$$GET1^DIQ(8925,IEN_",",.01,"I")
149 . I DEFIEN="" S MAGRY="0^Error resolving Document Class from Note IEN" S DONE=1 Q
150 . Q
151 ;
152 ; Find the IEN in 8925.1 for Document Class (CLASS)
153 D FIND^DIC(8925.1,"","@;.001","X",CLASS,"","","I $P(^(0),U,4)=""DC""","","MAGTRGT")
154 S DOCCL=$G(MAGTRGT("DILIST",2,1))
155 ;
156 ; See if ^TIU(8925.1,DEFIEN is of Document Class DOCCL
157 S RES=$$ISA^TIULX(DEFIEN,DOCCL)
158 I RES S MAGRY="1^The "_NTTL_" is of Document Class "_CLASS Q
159 S MAGRY="0^The "_NTTL_" is Not of Document Class "_CLASS
160 Q
Note: See TracBrowser for help on using the repository browser.