source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTU31.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1MAGGTU31 ;WOIFO/GEK - Silent calls for Imaging ; [ 06/20/2001 08:57 ]
2 ;;3.0;IMAGING;**46,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
20ATTSTAT(IEN) ; Return a sentence saying if the Image was attached
21 ; to the TIU NOte before or after the Note was signed.
22 ; was signed.
23 N SIGNDT,NOTE,MARR,AMMEND,N2,MAGDT,NC,CLOSDT,X
24 S N2=$G(^MAG(2005,IEN,2))
25 I $P(N2,"^",6)'=8925 Q ""
26 S MAGDT=$S($P(N2,"^",11):$P(N2,"^",11),1:$P(N2,"^",1))
27 S NOTE=$P(N2,"^",7)
28 S NC=NOTE_","
29 D GETS^DIQ(8925,NOTE,".01;.06;1501;1606","I","MARR")
30 I $D(DIERR) Q "Error: Note-"_NOTE_" : "_$G(^TMP("DIERR",$J,1,"TEXT",1))
31 I (MARR(8925,NC,".01","I")=81)!(MARR(8925,NC,".06","I")>0) Q "Image is attached to an Addendum"
32 S SIGNDT=MARR(8925,NC,"1501","I")
33 S CLOSDT=MARR(8925,NC,"1606","I")
34 I CLOSDT]"" D Q X
35 . I $P(CLOSDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=CLOSDT S X="Image was attached Same Day as Note was Electronically Filed." Q
36 . I MAGDT>CLOSDT S X="Image was attached After Note was Electronically Filed." Q
37 . S X="Image was attached Before Note was Electronically Filed." Q
38 . Q
39 I SIGNDT="" Q "Image is attached to an UnSigned Note."
40 I $P(SIGNDT,".",2)="" S MAGDT=$P(MAGDT,".",1) I MAGDT=SIGNDT Q "Image was attached Same Day as Note was Signed."
41 I MAGDT>SIGNDT Q "Image was attached After the Note was Signed."
42 Q "Image was attached Before the Note was Signed."
43USERKEYS(MAGK) ; RPC [MAGGUSERKEYS] (called from MAGGTU3)
44 N Y
45 N MAGKS ; list of keys to send to XUS KEY CHECK
46 N MAGKG ; list returned from XUS KEY CHECK
47 N I,J,MAGMED,MAGKEY,MAGPLC
48 K MAGK
49 S MAGPLC=+$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002
50 S MAGKEY=+$P($G(^MAG(2006.1,MAGPLC,"KEYS")),U)
51 I 'MAGKEY S MAGK(0)="CAPTURE KEYS OFF"
52 E S MAGK(0)="CAPTURE KEYS ON"
53 N X S X="MAG",I=0
54 F S X=$O(^XUSEC(X)) Q:$E(X,1,3)'="MAG" D
55 . S I=I+1,MAGKS(I)=X
56 D OWNSKEY^XUSRB(.MAGKG,.MAGKS)
57 S I=0,J=0,MAGMED=0
58 F S I=$O(MAGKG(I)) Q:I="" D
59 . Q:MAGKG(I)=0
60 . S J=J+1,MAGK(J)=MAGKS(I)
61 . I MAGKS(I)["MAGCAP MED" S MAGMED=1
62 I MAGMED S J=J+1,MAGK(J)="MAGCAP MED"
63 Q
64GETINFO(MAGRY,IEN) ; RPC [MAG4 GET IMAGE INFO]Called from MAGGTU3
65 ; Call (3.0p8) to get information on 1 image
66 ; and Display in the Image Information Window
67 N Y,J,JI,I,CT,IENC,FLAGS,SNGRP,Z,M40,T,QACHK,OBJTYP,VAL,LBL
68 S I=0,CT=0
69 S MAGRY(CT)="Image ID#: "_IEN
70 I $D(^MAG(2005.1,IEN)) D Q
71 . S CT=CT+1,MAGRY(CT)=" STATUS: "_"HAS BEEN DELETED. !!"
72 . S CT=CT+1,MAGRY(CT)="Deleted By: "_$$GET1^DIQ(2005.1,IEN,30,"E")
73 . S CT=CT+1,MAGRY(CT)=" Reason: "_$$GET1^DIQ(2005.1,IEN,30.2,"E")
74 . S CT=CT+1,MAGRY(CT)=" Date: "_$$GET1^DIQ(2005.1,IEN,30.1,"E")
75 . Q
76 S M40=$G(^MAG(2005,IEN,40)),T=$P(M40,"^",3)
77 S Z=$P($G(^MAG(2005,IEN,0)),"^",10) I Z D
78 . S CT=CT+1,MAGRY(CT)=" is in Group#: "_Z_" ("_+$P(^MAG(2005,Z,1,0),"^",4)_" images)"
79 . D CHK^MAGGSQI(.QACHK,Z) Q:QACHK(0)
80 . S CT=CT+1,MAGRY(CT)=" QA Warning - Group#: "_Z_" "_$P(QACHK(0),"^",2)
81 . Q
82 S OBJTYP=$P(^MAG(2005,IEN,0),"^",6)
83 S SNGRP="FLDS"
84 I (+$O(^MAG(2005,IEN,1,0)))!(OBJTYP=11)!(OBJTYP=16) D
85 . S CT=CT+1,MAGRY(CT)=$P($G(^MAG(2005,IEN,40)),"^",1)_" Group of "_+$P($G(^MAG(2005,IEN,1,0)),U,4)
86 . S SNGRP="FLDG"
87 . Q
88 K QACHK
89 D CHK^MAGGSQI(.QACHK,IEN) I 'QACHK(0) D
90 . S CT=CT+1,MAGRY(CT)=" QA Warning - Image#: "_IEN_" "_$P(QACHK(0),"^",2)
91 N MAGOUT,MAGERR,MAGVAL,PKG
92 S IENC=IEN_","
93 S FLAGS="EN"
94 S I=-1
95 S PKG=""
96 F S I=I+1,Z=$T(@SNGRP+I) Q:$P(Z,";",3)="end" D
97 . S J=$P(Z,";",4),JI=J_";"
98 . K MAGOUT
99 . S CT=CT+1,MAGRY(CT)=$P(Z,";",3)
100 . I J=41 D Q ; Need to compute the Class. Class field in Image File is wrong.
101 . . S MAGVAL=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^MAG(2005.82,$P(^MAG(2005.83,T,0),"^",2),0),"^",1))
102 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
103 . . Q
104 . D GETS^DIQ(2005,IEN,JI,FLAGS,"MAGOUT","MAGERR")
105 . ; Get Extension from FileRef
106 . I J=1 S MAGVAL=$P($G(MAGOUT(2005,IENC,J,"E")),".",2)
107 . E S MAGVAL=$G(MAGOUT(2005,IENC,J,"E"))
108 . S MAGVAL=$TR(MAGVAL,"&","+")
109 . I J=40 S PKG=MAGVAL
110 . I ((J>=50)&(J<=54)) D Q
111 . . I PKG'="LAB" K MAGRY(CT) Q
112 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
113 . . Q
114 . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL
115 ; Compare Parent Association Date with Date/Time Note Signed.
116 I $P(^MAG(2005,IEN,0),"^",10) S IEN=$P(^MAG(2005,IEN,0),"^",10)
117 I $P(^MAG(2005,IEN,2),"^",6)=8925 S CT=CT+1,MAGRY(CT)=$$ATTSTAT^MAGGTU31(IEN)
118 ;
119 I (OBJTYP=11),($P($G(^MAG(2005,IEN,100)),"^",6)="") D
120 . S X=$O(^MAG(2005,IEN,1,0))
121 . S IEN=+$G(^MAG(2005,IEN,1,X,0))
122 . Q
123 I $P($G(^MAG(2005,IEN,100)),"^",6)]"" D
124 . I OBJTYP=11 D ; If a Group, get Object Type of First Child
125 . . S Z=$O(^MAG(2005,IEN,1,0))
126 . . I 'Z Q
127 . . S Z=+$G(^MAG(2005,IEN,1,Z,0))
128 . . S OBJTYP=+$P($G(^MAG(2005,Z,0)),"^",6) ; Object of First Child
129 . . Q
130 . S OBJTYP=","_OBJTYP_","
131 . S LBL="",VAL=""
132 . I ",3,9,10,12,100,"[OBJTYP S LBL="Image Creation Date: " ; "Acquisition Date";
133 . I ",15,101,102,103,104,105,"[OBJTYP S LBL="Document Creation Date: "
134 . I LBL="" S LBL="Image Creation Date: "
135 . S VAL=$$GET1^DIQ(2005,IEN,110,"E") S:(VAL="") VAL="N/A"
136 . S CT=CT+1,MAGRY(CT)=LBL_VAL
137 . Q
138 Q
139 ;
140FLDS ;;Format: ;3;;
141 ;;Extension: ;1;;
142FLDG ;;Patient: ;5;;
143 ;;Desc: ;10;;
144 ;;Procedure: ;6;;
145 ;; Date: ;15;;
146 ;;Class: ;41;;
147 ;;Package: ;40;;
148 ;;Type: ;42;;
149 ;;Proc/Event: ;43;;
150 ;;Spec/SubSpec: ;44;;
151 ;;Origin: ;45;;
152 ;;Accession # ;50;;
153 ;;Specimen Desc ;51;;
154 ;;Specimen# ;52;;
155 ;;Stain ;53;;
156 ;;Objective ;54;;
157 ;;Captured on: ;7;;
158 ;; by: ;8;;
159 ;;end;;
Note: See TracBrowser for help on using the repository browser.