| 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 | 
|---|