1 | MAGGSIUI ;WOIFO/GEK - Utilities for Image Import API
|
---|
2 | ;;3.0;IMAGING;**7,8,48,20,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
|
---|
20 | REMOTE(MAGRY,MAGDATA) ;RPC [MAG4 REMOTE IMPORT]
|
---|
21 | ; Import Images from a Windows App, by sending an array.
|
---|
22 | I ($D(MAGDATA)<10) S MAGRY(0)="0^Missing Data Array !." Q
|
---|
23 | N I,J,ICT,DCT,MAGIX,IMAGES,ERR,X,Z
|
---|
24 | S (ERR,ICT,DCT)=0
|
---|
25 | S I="" F S I=$O(MAGDATA(I)) Q:I="" S X=MAGDATA(I) D Q:ERR
|
---|
26 | . S Z=$P(X,U)
|
---|
27 | . I (X="")!(Z="") S MAGRY(0)="0^INVALID Data in Input Array: Node "_I_"="""_X_"",ERR=1 Q
|
---|
28 | . I Z="IMAGE" S ICT=ICT+1,IMAGES(ICT)=$P(X,U,2,99) Q
|
---|
29 | . S DCT=DCT+1,MAGIX(Z)=$P(X,U,2,99)
|
---|
30 | I 'ERR D IMPORT(.MAGRY,.IMAGES,.MAGIX)
|
---|
31 | Q
|
---|
32 | ;
|
---|
33 | IMPORT(MAGRY,IMAGES,MAGIX) ;
|
---|
34 | ; "IDFN","PXPKG","PXIEN","PXDT","TRKID","ACQD","ACQS","ACQL","STSCB","ITYPE",
|
---|
35 | ; "CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT",
|
---|
36 | ; "IXTYPE","IXSPEC","IXPROC","IXORIGIN ;Patch 8: Added Index fields
|
---|
37 | ;
|
---|
38 | ;Index fields Package, Class ("IXPKG" and "IXCLS") aren't accepted
|
---|
39 | ; they are computed values.
|
---|
40 | ; - Convert field codes into an Input Data Array,
|
---|
41 | ; validate, then set the Import Queue
|
---|
42 | ;
|
---|
43 | N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
|
---|
44 | K MAGRY S MAGRY(0)="0^Importing data..."
|
---|
45 | N APISESS,MWIN
|
---|
46 | S MWIN=$$BROKER^XWBLIB
|
---|
47 | N PRM,CT,MAGA,MAGY,MAGTN,TNODE
|
---|
48 | N IDFN,PXPKG,PXIEN,PXDT,TRKID,ACQD,ACQS,ACQN,ACQL,STSCB,ITYPE,CMTH,CDUZ,USERNAME,PASSWORD
|
---|
49 | N GDESC,DFLG,TRTYPE,DOCCTG,DOCDT,IXPKG,IXCLS,IXTYPE,IXSPEC,IXPROC,IXORIGIN,MAX,SITEPLC
|
---|
50 | N ERR,MAGTM,QTIME,MAGIXZ
|
---|
51 | S CT=0,ERR=0
|
---|
52 | M MAGIXZ=MAGIX
|
---|
53 | ; DON'T CONVERT ACQS(really a ACQN) to a REAL ACQS, leave it ACQS to be converted by MAGGSIV
|
---|
54 | ;
|
---|
55 | F PRM="IDFN","PXPKG","PXIEN","PXDT","TRKID","ACQD","ACQS","ACQN","ACQL","STSCB","ITYPE","CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT","IXTYPE","IXSPEC","IXPROC","IXORIGIN" D
|
---|
56 | . S @PRM=$G(MAGIX(PRM)) K MAGIX(PRM) ; P8T14 added K.. and next line to account for field numbers later.
|
---|
57 | . Q
|
---|
58 | S PRM="" F S PRM=$O(MAGIX(PRM)) Q:PRM="" D SA(PRM,$G(MAGIX(PRM)))
|
---|
59 | ;
|
---|
60 | S MAGTM=$$NOW^XLFDT
|
---|
61 | I '$G(DUZ) S MAGRY(0)="0^DUZ is undefined." Q ;D ERRTRK Q
|
---|
62 | ; DATATRK sets Global var. APISESS = IEN of Session File.
|
---|
63 | D DATATRK
|
---|
64 | I '$$REQPARAM^MAGGSIU2() D ERRTRK Q
|
---|
65 | S MAX=$P(TRKID,";",1)="MAX"
|
---|
66 | ;I 'MWIN W !,"----------------" ZW W !,"---------------------"
|
---|
67 | ; Workaround VIC (Maximus) is sending Station Number
|
---|
68 | ; we'll convert to Institution IEN
|
---|
69 | I MAX&(ACQS]"") D Q:ERR
|
---|
70 | . S X=$O(^DIC(4,"D",ACQS,""))
|
---|
71 | . I X="" S MAGRY(0)="0^Invalid Station Number:(Maximus ACQS): "_ACQS,ERR=1 Q
|
---|
72 | . S SITEPLC=X ; We need the Place for the Queue
|
---|
73 | . ;S ACQS=X Out in 85. Don't change to ACQS, that's done in VAL^MAGGSIV
|
---|
74 | . Q
|
---|
75 | ; Change to Allow ACQN - STATION NUMBER from INSTITUTION File.
|
---|
76 | I $L(ACQN) D Q:ERR
|
---|
77 | . S ACQS=$O(^DIC(4,"D",ACQN,""))
|
---|
78 | . I ACQS="" S MAGRY(0)="0^Invalid STATION NUMBER: (ACQN): "_ACQN,ERR=1 Q
|
---|
79 | . ; VAL^MAGGSIV Will fail if ACQS is real and this is Maximus
|
---|
80 | . I MAX S ACQS=ACQN K ACQN Q
|
---|
81 | . S ACQN="" ;We converted to ACQS, lets make "" so no confusion later.
|
---|
82 | . Q
|
---|
83 | ;
|
---|
84 | ; Set the input data array
|
---|
85 | D SA(5,IDFN) ;PATIENT
|
---|
86 | D SA(16,PXPKG) ;PARENT DATA FILE
|
---|
87 | D SA(17,PXIEN) ;PARENT GLOBAL ROOT
|
---|
88 | D SA(15,PXDT) ; PROCEDURE/EXAM DATE/TIME
|
---|
89 | D SA(108,TRKID) ; TRACKING ID (new)
|
---|
90 | D SA("ACQD",ACQD) ; ACQUISTION DEVICE ( new )
|
---|
91 | I 'MAX S SITEPLC=ACQS D SA(.05,ACQS) ; this used to be fld 105
|
---|
92 | D SA(101,ACQL)
|
---|
93 | D SA("STATUSCB",STSCB) ; STATUS CALLBACK (was referred to as ExceptionHandler)
|
---|
94 | D SA(3,ITYPE) ; OBJECT TYPE
|
---|
95 | D SA("CALLMTH",CMTH) ; CALL METHOD
|
---|
96 | D SA(8,CDUZ) ; IMAGE SAVE BY
|
---|
97 | D SA("USERNAME",USERNAME)
|
---|
98 | D SA("PASSWORD",PASSWORD)
|
---|
99 | D SA(10,GDESC) ; SHORT DESCRIPTION
|
---|
100 | D SA("DELFLAG",DFLG) ; DELETE FLAG
|
---|
101 | D SA("TRNSTYP",TRTYPE) ; TRANSACTION TYPE
|
---|
102 | D SA(100,DOCCTG) ; document Main category
|
---|
103 | D SA(110,DOCDT) ; document date
|
---|
104 | ; Patch 8 allows Index fields to be imported.
|
---|
105 | ;"IXTYPE","IXSPEC","IXPROC","IXORIGIN"
|
---|
106 | D SA(42,IXTYPE) ; Index Type
|
---|
107 | D SA(43,IXPROC) ; Index Proc/Event
|
---|
108 | D SA(44,IXSPEC) ; Index Spec/SubSpec
|
---|
109 | D SA(45,IXORIGIN) ; Index Origin
|
---|
110 | ;
|
---|
111 | D VAL^MAGGSIV(.MAGRY,.MAGA,1) I 'MAGRY(0) D ERRTRK Q
|
---|
112 | I MAX D SA(.05,ACQS) ; this used to be fld 105
|
---|
113 | ; Also Done in MAGGSIA when image is being Saved.
|
---|
114 | I '$$VALINDEX^MAGGSIV1(.MAGRY,IXTYPE,IXSPEC,IXPROC) D ERRTRK Q
|
---|
115 | ; Array of Images to Import
|
---|
116 | D SI("IMAGES",.IMAGES) I 'MAGRY(0) D ERRTRK Q
|
---|
117 | K MAGRY
|
---|
118 | ;
|
---|
119 | I TRTYPE="NOQUEUE" M MAGRY=MAGA S MAGRY(0)="1^" Q
|
---|
120 | ; This call is for BP
|
---|
121 | S QTIME=$$NOW^XLFDT
|
---|
122 | ; p85 use ACQS instead of DUZ(2)
|
---|
123 | S MAGY=$$IMPORT^MAGBAPI(.MAGA,STSCB,TRKID,$$PLACE^MAGBAPI(SITEPLC))
|
---|
124 | ; Return Queue Number
|
---|
125 | I 'MAGY S MAGRY(0)="0^Error Setting Queue: "_$P(MAGY,U,2),MAGY=TRKID
|
---|
126 | E S MAGRY(0)=MAGY_"^Data has been Queued.",MAGY=+MAGY
|
---|
127 | ; for Testing, we'll track input array, and results array by Queue number.
|
---|
128 | I 'MAGRY(0) D ERRTRK Q
|
---|
129 | D LOGRES^MAGGSIU3(.MAGRY,0,APISESS)
|
---|
130 | ;
|
---|
131 | Q
|
---|
132 | ;
|
---|
133 | SA(FLD,VAL) ;Set the data array with Fld,Value
|
---|
134 | Q:VAL=""
|
---|
135 | S CT=CT+1,MAGA(CT)=FLD_U_VAL
|
---|
136 | Q
|
---|
137 | SI(FLD,ARR) ;Set the images into the data array
|
---|
138 | ; 'CT' is a global variable.
|
---|
139 | S MAGRY(0)="1^Valid Image file Extensions."
|
---|
140 | N I,MAGEXT,MAGFN
|
---|
141 | S I="" F S I=$O(ARR(I)) Q:I="" D Q:'MAGRY(0)
|
---|
142 | . S CT=CT+1
|
---|
143 | . I ($L($P(ARR(I),U),".")<2) S MAGRY(0)="0^Invalid file name: "_ARR(I) Q
|
---|
144 | . S MAGFN=$P(ARR(I),"^")
|
---|
145 | . S MAGEXT=$$UP^XLFSTR($P(MAGFN,".",$L(MAGFN,".")))
|
---|
146 | . I '$D(^MAG(2005.021,"B",MAGEXT)) S MAGRY(0)="0^Unsupported File Type:'."_MAGEXT Q
|
---|
147 | . S MAGA(CT)="IMAGE"_U_ARR(I)
|
---|
148 | Q
|
---|
149 | GETARR(ARR,QNUM) ;RPC [MAG4 DATA FROM IMPORT QUEUE]
|
---|
150 | ; Get the Input Array from Queue Number
|
---|
151 | I '$G(QNUM) S ARR(0)="0^INVALID QUEUE Number: "_$G(QNUM) Q
|
---|
152 | D IMPAR^MAGQBUT2(.ARR,QNUM)
|
---|
153 | Q
|
---|
154 | STATUSCB(MAGRY,STAT,TAGRTN,DOCB) ;RPC [MAG4 STATUS CALLBACK]
|
---|
155 | ; Report Status to calling application
|
---|
156 | ; Now the IAPI and OCX make this call. Not BP
|
---|
157 | ; STAT(0)= "0^message" or "1^message"
|
---|
158 | ; STAT(1)=TRKID,
|
---|
159 | ; (2)=QNUM
|
---|
160 | ; (3..N)=warnings
|
---|
161 | ;TAGRTN : The TAG^RTN to call with Status Array
|
---|
162 | ;DOCB : (1|0) to suppress execution of Status Callback
|
---|
163 | ;
|
---|
164 | N APISESS,TRKID,CBMSG
|
---|
165 | S DOCB=$S($G(DOCB)="":1,1:+$G(DOCB)) ; Default to TRUE
|
---|
166 | ; Old Import API and BP that made this call, will work : DOCB defaults to 1
|
---|
167 | S CBMSG=$S(DOCB:"Status Callback was called",1:"Status Callback was NOT called")
|
---|
168 | I DOCB D @(TAGRTN_"(.STAT)")
|
---|
169 | S MAGRY="1^"_CBMSG
|
---|
170 | S STAT($O(STAT(""),-1)+1)=MAGRY
|
---|
171 | S TRKID=$G(STAT(1))
|
---|
172 | ; Log Results. Always.
|
---|
173 | I $L(TRKID) D
|
---|
174 | . S APISESS=$$SES4TRK^MAGGSIU3(TRKID) ;
|
---|
175 | . I APISESS D LOGRES^MAGGSIU3(.STAT,0,APISESS) ;gek/send Tracking ID to log status
|
---|
176 | Q
|
---|
177 | TESTCB(STATARR) ;TESTING. This is the Status Callback for testing.
|
---|
178 | ; the STATUSCB property must have a Valid "M" TAG^ROUTINE
|
---|
179 | ; TAG TESTCB exists so that STATUSCB validates successfully
|
---|
180 | Q
|
---|
181 | ERRTRK ;Track bad data and Quit
|
---|
182 | N I
|
---|
183 | D LOGERR^MAGGSERR("---- New Error ----",APISESS)
|
---|
184 | S I="" F S I=$O(MAGRY(I)) Q:I="" D LOGERR^MAGGSERR(MAGRY(I),APISESS)
|
---|
185 | Q
|
---|
186 | DATATRK ; Track the raw data being sent to the Import API.
|
---|
187 | ; Log the data being imported. Results are logged later.
|
---|
188 | N XY
|
---|
189 | S APISESS=$$LOG^MAGGSIU3(.XY,.MAGIXZ,.IMAGES,IDFN,ACQD,TRKID)
|
---|
190 | Q
|
---|
191 | ERR ; ERROR TRAP FOR Import API
|
---|
192 | N ERR S ERR=$$EC^%ZOSV
|
---|
193 | S MAGRY(0)="0^ETRAP: "_ERR
|
---|
194 | D @^%ZOSF("ERRTN")
|
---|
195 | I $G(APISESS) D ERRTRK
|
---|
196 | Q
|
---|