MAGGSIUI ;WOIFO/GEK/NST - Utilities for Image Import API ; 20 Jan 2010 10:10 AM
;;3.0;IMAGING;**7,8,48,20,85,59,108,121**;Mar 19, 2002;Build 2340;Oct 20, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
REMOTE(MAGRY,MAGDATA) ;RPC [MAG4 REMOTE IMPORT]
; Import Images from a Windows App, by sending an array.
I ($D(MAGDATA)<10) S MAGRY(0)="0^Missing Data Array !." Q
N I,J,ICT,DCT,MAGIX,IMAGES,ERR,X,Z
S (ERR,ICT,DCT)=0
S I="" F S I=$O(MAGDATA(I)) Q:I="" S X=MAGDATA(I) D Q:ERR
. S Z=$P(X,U)
. I (X="")!(Z="") S MAGRY(0)="0^INVALID Data in Input Array: Node "_I_"="""_X_"",ERR=1 Q
. I Z="IMAGE" S ICT=ICT+1,IMAGES(ICT)=$P(X,U,2,99) Q
. S DCT=DCT+1,MAGIX(Z)=$P(X,U,2,99)
I 'ERR D IMPORT(.MAGRY,.IMAGES,.MAGIX)
Q
;
IMPORT(MAGRY,IMAGES,MAGIX) ;
; "IDFN","PXPKG","PXIEN","PXDT","TRKID","ACQD","ACQS","ACQL","STSCB","ITYPE",
; "CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT",
; "IXTYPE","IXSPEC","IXPROC","IXORIGIN ;Patch 8: Added Index fields
; "PXSGNTYP","PXNEW","PXTIUTTL","PXTIUTXTxxxxx" ; Patch 108
;
;Index fields Package, Class ("IXPKG" and "IXCLS") aren't accepted
; they are computed values.
; - Convert field codes into an Input Data Array,
; validate, then set the Import Queue
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
K MAGRY S MAGRY(0)="0^Importing data..."
N APISESS,MWIN
S MWIN=$$BROKER^XWBLIB
N PRM,CT,MAGA,MAGY,MAGTN,TNODE
N IDFN,PXPKG,PXIEN,PXDT,TRKID,ACQD,ACQS,ACQN,ACQL,STSCB,ITYPE,CMTH,CDUZ,USERNAME,PASSWORD
N GDESC,DFLG,TRTYPE,DOCCTG,DOCDT,IXPKG,IXCLS,IXTYPE,IXSPEC,IXPROC,IXORIGIN,MAX,SITEPLC
N ERR,MAGTM,QTIME,MAGIXZ
N PXNEW,PXTIUTTL,PXSGNTYP ; Patch 108
N ACTION
S CT=0,ERR=0
M MAGIXZ=MAGIX
; DON'T CONVERT ACQS(really a ACQN) to a REAL ACQS, leave it ACQS to be converted by MAGGSIV
; 121: 'ACTION' is new
F PRM="ACTION","IDFN","PXSGNTYP","PXPKG","PXIEN","PXDT","PXNEW","PXTIUTTL","TRKID","ACQD","ACQS","ACQN","ACQL","STSCB","ITYPE","CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT","IXTYPE","IXSPEC","IXPROC","IXORIGIN" D
. S @PRM=$G(MAGIX(PRM)) K MAGIX(PRM) ; P8T14 added K.. and next line to account for field numbers later.
. Q
S PRM="" F S PRM=$O(MAGIX(PRM)) Q:PRM="" D SA(PRM,$G(MAGIX(PRM)))
;
S MAGTM=$$NOW^XLFDT
I '$G(DUZ) S MAGRY(0)="0^DUZ is undefined." Q ;D ERRTRK Q
; DATATRK sets Global var. APISESS = IEN of Session File.
D DATATRK
I '$$REQPARAM^MAGGSIU2() D ERRTRK Q
S MAX=$P(TRKID,";",1)="MAX"
;I 'MWIN W !,"----------------" ZW W !,"---------------------"
; Workaround VIC (Maximus) is sending Station Number
; we'll convert to Institution IEN
I MAX&(ACQS]"") D Q:ERR
. S X=$O(^DIC(4,"D",ACQS,""))
. I X="" S MAGRY(0)="0^Invalid Station Number:(Maximus ACQS): "_ACQS,ERR=1 Q
. S SITEPLC=X ; We need the Place for the Queue
. ;S ACQS=X Out in 85. Don't change to ACQS, that's done in VAL^MAGGSIV
. Q
; Change to Allow ACQN - STATION NUMBER from INSTITUTION File.
I $L(ACQN) D Q:ERR
. S ACQS=$O(^DIC(4,"D",ACQN,""))
. I ACQS="" S MAGRY(0)="0^Invalid STATION NUMBER: (ACQN): "_ACQN,ERR=1 Q
. ; VAL^MAGGSIV Will fail if ACQS is real and this is Maximus
. I MAX S ACQS=ACQN K ACQN Q
. S ACQN="" ;We converted to ACQS, lets make "" so no confusion later.
. Q
;
; Set the input data array
;
; Patch 108
D SA("PXSGNTYP",PXSGNTYP) ; Signature Type - 0 unsigned/ 1 administrative closed/ 2 signed
D SA("PXTIUTTL",PXTIUTTL) ; TIU Title in case a new TIU stub needs to be created
D SA("PXNEW",PXNEW) ; Flag to create a new package ( e.g. a new TUI stub)
; PXIEN has to be set to zero because of Delphi function TMagImport.FileSpecialtyPointers
; In this way we don't need to recompile BP
S:PXNEW="1" PXIEN=0
D SA(5,IDFN) ;PATIENT
D SA(16,PXPKG) ;PARENT DATA FILE
D SA(17,PXIEN) ;PARENT GLOBAL ROOT
D SA(15,PXDT) ; PROCEDURE/EXAM DATE/TIME
D SA(108,TRKID) ; TRACKING ID (new)
D SA("ACQD",ACQD) ; ACQUISTION DEVICE ( new )
I 'MAX S SITEPLC=ACQS D SA(.05,ACQS) ; this used to be fld 105
D SA(101,ACQL)
D SA("STATUSCB",STSCB) ; STATUS CALLBACK (was referred to as ExceptionHandler)
D SA(3,ITYPE) ; OBJECT TYPE
D SA("CALLMTH",CMTH) ; CALL METHOD
D SA(8,CDUZ) ; IMAGE SAVE BY
D SA("USERNAME",USERNAME)
D SA("PASSWORD",PASSWORD)
D SA(10,GDESC) ; SHORT DESCRIPTION
D SA("DELFLAG",DFLG) ; DELETE FLAG
D SA("TRNSTYP",TRTYPE) ; TRANSACTION TYPE
D SA(100,DOCCTG) ; document Main category
D SA(110,DOCDT) ; document date
; Patch 8 allows Index fields to be imported.
;"IXTYPE","IXSPEC","IXPROC","IXORIGIN"
D SA(42,IXTYPE) ; Index Type
D SA(43,IXPROC) ; Index Proc/Event
D SA(44,IXSPEC) ; Index Spec/SubSpec
D SA(45,IXORIGIN) ; Index Origin
; Patch 121 allows ACTION of RESCIND
D SA("ACTION",ACTION) ; P121 ACTION=RESCIND
;
D VAL^MAGGSIV(.MAGRY,.MAGA,1) I 'MAGRY(0) D ERRTRK Q
I MAX D SA(.05,ACQS) ; this used to be fld 105
; Also Done in MAGGSIA when image is being Saved.
I '$$VALINDEX^MAGGSIV1(.MAGRY,IXTYPE,IXSPEC,IXPROC) D ERRTRK Q
; Array of Images to Import
D SI("IMAGES",.IMAGES) I 'MAGRY(0) D ERRTRK Q
K MAGRY
;
I TRTYPE="NOQUEUE" M MAGRY=MAGA S MAGRY(0)="1^" Q
; This call is for BP
S QTIME=$$NOW^XLFDT
; p85 use ACQS instead of DUZ(2)
S MAGY=$$IMPORT^MAGBAPI(.MAGA,STSCB,TRKID,$$PLACE^MAGBAPI(SITEPLC))
; Return Queue Number
I 'MAGY S MAGRY(0)="0^Error Setting Queue: "_$P(MAGY,U,2),MAGY=TRKID
E S MAGRY(0)=MAGY_"^Data has been Queued.",MAGY=+MAGY
; for debugging we'll track input array, and results array by Queue number.
I 'MAGRY(0) D ERRTRK Q
D LOGRES^MAGGSIU3(.MAGRY,0,APISESS)
;
Q
;
SA(FLD,VAL) ;Set the data array with Fld,Value
Q:VAL=""
S CT=CT+1,MAGA(CT)=FLD_U_VAL
Q
SI(FLD,ARR) ;Set the images into the data array
; 'CT' is a global variable.
S MAGRY(0)="1^Valid Image file Extensions."
N I,MAGEXT,MAGFN
N RES
S I="" F S I=$O(ARR(I)) Q:I="" D Q:'MAGRY(0)
. S CT=CT+1
. ; special case ACTION=RESCIND
. I ACTION="RESCIND" S MAGA(CT)="IMAGE^"_ARR(I) Q
. I ($L($P(ARR(I),U),".")<2) S MAGRY(0)="0^Invalid file name: "_ARR(I) Q
. S MAGFN=$P(ARR(I),"^")
. S MAGEXT=$$UP^XLFSTR($P(MAGFN,".",$L(MAGFN,".")))
. K RES
. D INFO^MAGGSFT(.RES,MAGEXT)
. I 'RES(0) S MAGRY(0)=RES(0) Q
. S MAGA(CT)="IMAGE"_U_ARR(I)
Q
GETARR(ARR,QNUM) ;RPC [MAG4 DATA FROM IMPORT QUEUE]
; Get the Input Array from Queue Number
I '$G(QNUM) S ARR(0)="0^INVALID QUEUE Number: "_$G(QNUM) Q
D IMPAR^MAGQBUT2(.ARR,QNUM)
Q
STATUSCB(MAGRY,STAT,TAGRTN,DOCB) ;RPC [MAG4 STATUS CALLBACK]
; Report Status to calling application
; Now the IAPI and OCX make this call. Not BP
; STAT(0)= "0^message" or "1^message"
; STAT(1)=TRKID,
; (2)=QNUM
; (3..N)=warnings
;TAGRTN : The TAG^RTN to call with Status Array
;DOCB : (1|0) to suppress execution of Status Callback
;
N APISESS,TRKID,CBMSG
S DOCB=$S($G(DOCB)="":1,1:+$G(DOCB)) ; Default to TRUE
; Old Import API and BP that made this call, will work : DOCB defaults to 1
S CBMSG=$S(DOCB:"Status Callback was called",1:"Status Callback was NOT called")
I DOCB D @(TAGRTN_"(.STAT)")
S MAGRY="1^"_CBMSG
S STAT($O(STAT(""),-1)+1)=MAGRY
S TRKID=$G(STAT(1))
; Log Results. Always.
I $L(TRKID) D
. S APISESS=$$SES4TRK^MAGGSIU3(TRKID) ;
. I APISESS D LOGRES^MAGGSIU3(.STAT,0,APISESS) ;gek/send Tracking ID to log status
Q
TESTCB(STATARR) ;TESTING. This is the Status Callback for testing.
; the STATUSCB property must have a Valid "M" TAG^ROUTINE
; TAG TESTCB exists so that STATUSCB validates successfully
Q
ERRTRK ;Track bad data and Quit
N I
D LOGERR^MAGGSERR("---- New Error ----",APISESS)
S I="" F S I=$O(MAGRY(I)) Q:I="" D LOGERR^MAGGSERR(MAGRY(I),APISESS)
Q
DATATRK ; Track the raw data being sent to the Import API.
; Log the data being imported. Results are logged later.
N XY
S APISESS=$$LOG^MAGGSIU3(.XY,.MAGIXZ,.IMAGES,IDFN,ACQD,TRKID)
Q
ERR ; ERROR TRAP FOR Import API
N ERR S ERR=$$EC^%ZOSV
S MAGRY(0)="0^ETRAP: "_ERR
D @^%ZOSF("ERRTN")
I $G(APISESS) D ERRTRK
Q
; Patch 108
GETIAPID(OUT,TRKID) ; Returns Import API data in OUT array from file (#2006.82) by tracking ID
; OUT(FIELD)=VALUE
N I,X,Y,SNUM,VAL1
S SNUM=$O(^MAG(2006.82,"E",TRKID,""),-1) ; Get the last recording for this TRKID
I 'SNUM Q ; no data found
; Patch 121/ gek Add the Return of the 'Image:' Data
S I=1
F S I=$O(^MAG(2006.82,SNUM,"ACT",I)) Q:I'?1N.N D
. S VAL1=$G(^MAG(2006.82,SNUM,"ACT",I,0))
. I VAL1="Data:" D
. . S X=$G(^MAG(2006.82,SNUM,"ACT",I,1))
. . S Y=$TR($P(X,":"),"()","")
. . S:Y'="" OUT(Y)=$P(X,": ",2,999)
. . Q
. I VAL1="Image:" D
. . S X=$G(^MAG(2006.82,SNUM,"ACT",I,1))
. . S Y=$TR($P(X,":"),"()","")
. . S:Y'="" OUT("IMAGE",Y)=$P(X,": ",2,999)
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIUI 9910 printed Sep 23, 2025@19:39:01 Page 2
MAGGSIUI ;WOIFO/GEK/NST - Utilities for Image Import API ; 20 Jan 2010 10:10 AM
+1 ;;3.0;IMAGING;**7,8,48,20,85,59,108,121**;Mar 19, 2002;Build 2340;Oct 20, 2011
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
REMOTE(MAGRY,MAGDATA) ;RPC [MAG4 REMOTE IMPORT]
+1 ; Import Images from a Windows App, by sending an array.
+2 IF ($DATA(MAGDATA)<10)
SET MAGRY(0)="0^Missing Data Array !."
QUIT
+3 NEW I,J,ICT,DCT,MAGIX,IMAGES,ERR,X,Z
+4 SET (ERR,ICT,DCT)=0
+5 SET I=""
FOR
SET I=$ORDER(MAGDATA(I))
if I=""
QUIT
SET X=MAGDATA(I)
Begin DoDot:1
+6 SET Z=$PIECE(X,U)
+7 IF (X="")!(Z="")
SET MAGRY(0)="0^INVALID Data in Input Array: Node "_I_"="""_X_""
SET ERR=1
QUIT
+8 IF Z="IMAGE"
SET ICT=ICT+1
SET IMAGES(ICT)=$PIECE(X,U,2,99)
QUIT
+9 SET DCT=DCT+1
SET MAGIX(Z)=$PIECE(X,U,2,99)
End DoDot:1
if ERR
QUIT
+10 IF 'ERR
DO IMPORT(.MAGRY,.IMAGES,.MAGIX)
+11 QUIT
+12 ;
IMPORT(MAGRY,IMAGES,MAGIX) ;
+1 ; "IDFN","PXPKG","PXIEN","PXDT","TRKID","ACQD","ACQS","ACQL","STSCB","ITYPE",
+2 ; "CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT",
+3 ; "IXTYPE","IXSPEC","IXPROC","IXORIGIN ;Patch 8: Added Index fields
+4 ; "PXSGNTYP","PXNEW","PXTIUTTL","PXTIUTXTxxxxx" ; Patch 108
+5 ;
+6 ;Index fields Package, Class ("IXPKG" and "IXCLS") aren't accepted
+7 ; they are computed values.
+8 ; - Convert field codes into an Input Data Array,
+9 ; validate, then set the Import Queue
+10 ;
+11 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+12 KILL MAGRY
SET MAGRY(0)="0^Importing data..."
+13 NEW APISESS,MWIN
+14 SET MWIN=$$BROKER^XWBLIB
+15 NEW PRM,CT,MAGA,MAGY,MAGTN,TNODE
+16 NEW IDFN,PXPKG,PXIEN,PXDT,TRKID,ACQD,ACQS,ACQN,ACQL,STSCB,ITYPE,CMTH,CDUZ,USERNAME,PASSWORD
+17 NEW GDESC,DFLG,TRTYPE,DOCCTG,DOCDT,IXPKG,IXCLS,IXTYPE,IXSPEC,IXPROC,IXORIGIN,MAX,SITEPLC
+18 NEW ERR,MAGTM,QTIME,MAGIXZ
+19 ; Patch 108
NEW PXNEW,PXTIUTTL,PXSGNTYP
+20 NEW ACTION
+21 SET CT=0
SET ERR=0
+22 MERGE MAGIXZ=MAGIX
+23 ; DON'T CONVERT ACQS(really a ACQN) to a REAL ACQS, leave it ACQS to be converted by MAGGSIV
+24 ; 121: 'ACTION' is new
+25 FOR PRM="ACTION","IDFN","PXSGNTYP","PXPKG","PXIEN","PXDT","PXNEW","PXTIUTTL","TRKID","ACQD","ACQS","ACQN","ACQL","STSCB","ITYPE","CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT","IXTYPE","IXSPEC","IXPROC","IXORIGIN"
Begin DoDot:1
+26 ; P8T14 added K.. and next line to account for field numbers later.
SET @PRM=$GET(MAGIX(PRM))
KILL MAGIX(PRM)
+27 QUIT
End DoDot:1
+28 SET PRM=""
FOR
SET PRM=$ORDER(MAGIX(PRM))
if PRM=""
QUIT
DO SA(PRM,$GET(MAGIX(PRM)))
+29 ;
+30 SET MAGTM=$$NOW^XLFDT
+31 ;D ERRTRK Q
IF '$GET(DUZ)
SET MAGRY(0)="0^DUZ is undefined."
QUIT
+32 ; DATATRK sets Global var. APISESS = IEN of Session File.
+33 DO DATATRK
+34 IF '$$REQPARAM^MAGGSIU2()
DO ERRTRK
QUIT
+35 SET MAX=$PIECE(TRKID,";",1)="MAX"
+36 ;I 'MWIN W !,"----------------" ZW W !,"---------------------"
+37 ; Workaround VIC (Maximus) is sending Station Number
+38 ; we'll convert to Institution IEN
+39 IF MAX&(ACQS]"")
Begin DoDot:1
+40 SET X=$ORDER(^DIC(4,"D",ACQS,""))
+41 IF X=""
SET MAGRY(0)="0^Invalid Station Number:(Maximus ACQS): "_ACQS
SET ERR=1
QUIT
+42 ; We need the Place for the Queue
SET SITEPLC=X
+43 ;S ACQS=X Out in 85. Don't change to ACQS, that's done in VAL^MAGGSIV
+44 QUIT
End DoDot:1
if ERR
QUIT
+45 ; Change to Allow ACQN - STATION NUMBER from INSTITUTION File.
+46 IF $LENGTH(ACQN)
Begin DoDot:1
+47 SET ACQS=$ORDER(^DIC(4,"D",ACQN,""))
+48 IF ACQS=""
SET MAGRY(0)="0^Invalid STATION NUMBER: (ACQN): "_ACQN
SET ERR=1
QUIT
+49 ; VAL^MAGGSIV Will fail if ACQS is real and this is Maximus
+50 IF MAX
SET ACQS=ACQN
KILL ACQN
QUIT
+51 ;We converted to ACQS, lets make "" so no confusion later.
SET ACQN=""
+52 QUIT
End DoDot:1
if ERR
QUIT
+53 ;
+54 ; Set the input data array
+55 ;
+56 ; Patch 108
+57 ; Signature Type - 0 unsigned/ 1 administrative closed/ 2 signed
DO SA("PXSGNTYP",PXSGNTYP)
+58 ; TIU Title in case a new TIU stub needs to be created
DO SA("PXTIUTTL",PXTIUTTL)
+59 ; Flag to create a new package ( e.g. a new TUI stub)
DO SA("PXNEW",PXNEW)
+60 ; PXIEN has to be set to zero because of Delphi function TMagImport.FileSpecialtyPointers
+61 ; In this way we don't need to recompile BP
+62 if PXNEW="1"
SET PXIEN=0
+63 ;PATIENT
DO SA(5,IDFN)
+64 ;PARENT DATA FILE
DO SA(16,PXPKG)
+65 ;PARENT GLOBAL ROOT
DO SA(17,PXIEN)
+66 ; PROCEDURE/EXAM DATE/TIME
DO SA(15,PXDT)
+67 ; TRACKING ID (new)
DO SA(108,TRKID)
+68 ; ACQUISTION DEVICE ( new )
DO SA("ACQD",ACQD)
+69 ; this used to be fld 105
IF 'MAX
SET SITEPLC=ACQS
DO SA(.05,ACQS)
+70 DO SA(101,ACQL)
+71 ; STATUS CALLBACK (was referred to as ExceptionHandler)
DO SA("STATUSCB",STSCB)
+72 ; OBJECT TYPE
DO SA(3,ITYPE)
+73 ; CALL METHOD
DO SA("CALLMTH",CMTH)
+74 ; IMAGE SAVE BY
DO SA(8,CDUZ)
+75 DO SA("USERNAME",USERNAME)
+76 DO SA("PASSWORD",PASSWORD)
+77 ; SHORT DESCRIPTION
DO SA(10,GDESC)
+78 ; DELETE FLAG
DO SA("DELFLAG",DFLG)
+79 ; TRANSACTION TYPE
DO SA("TRNSTYP",TRTYPE)
+80 ; document Main category
DO SA(100,DOCCTG)
+81 ; document date
DO SA(110,DOCDT)
+82 ; Patch 8 allows Index fields to be imported.
+83 ;"IXTYPE","IXSPEC","IXPROC","IXORIGIN"
+84 ; Index Type
DO SA(42,IXTYPE)
+85 ; Index Proc/Event
DO SA(43,IXPROC)
+86 ; Index Spec/SubSpec
DO SA(44,IXSPEC)
+87 ; Index Origin
DO SA(45,IXORIGIN)
+88 ; Patch 121 allows ACTION of RESCIND
+89 ; P121 ACTION=RESCIND
DO SA("ACTION",ACTION)
+90 ;
+91 DO VAL^MAGGSIV(.MAGRY,.MAGA,1)
IF 'MAGRY(0)
DO ERRTRK
QUIT
+92 ; this used to be fld 105
IF MAX
DO SA(.05,ACQS)
+93 ; Also Done in MAGGSIA when image is being Saved.
+94 IF '$$VALINDEX^MAGGSIV1(.MAGRY,IXTYPE,IXSPEC,IXPROC)
DO ERRTRK
QUIT
+95 ; Array of Images to Import
+96 DO SI("IMAGES",.IMAGES)
IF 'MAGRY(0)
DO ERRTRK
QUIT
+97 KILL MAGRY
+98 ;
+99 IF TRTYPE="NOQUEUE"
MERGE MAGRY=MAGA
SET MAGRY(0)="1^"
QUIT
+100 ; This call is for BP
+101 SET QTIME=$$NOW^XLFDT
+102 ; p85 use ACQS instead of DUZ(2)
+103 SET MAGY=$$IMPORT^MAGBAPI(.MAGA,STSCB,TRKID,$$PLACE^MAGBAPI(SITEPLC))
+104 ; Return Queue Number
+105 IF 'MAGY
SET MAGRY(0)="0^Error Setting Queue: "_$PIECE(MAGY,U,2)
SET MAGY=TRKID
+106 IF '$TEST
SET MAGRY(0)=MAGY_"^Data has been Queued."
SET MAGY=+MAGY
+107 ; for debugging we'll track input array, and results array by Queue number.
+108 IF 'MAGRY(0)
DO ERRTRK
QUIT
+109 DO LOGRES^MAGGSIU3(.MAGRY,0,APISESS)
+110 ;
+111 QUIT
+112 ;
SA(FLD,VAL) ;Set the data array with Fld,Value
+1 if VAL=""
QUIT
+2 SET CT=CT+1
SET MAGA(CT)=FLD_U_VAL
+3 QUIT
SI(FLD,ARR) ;Set the images into the data array
+1 ; 'CT' is a global variable.
+2 SET MAGRY(0)="1^Valid Image file Extensions."
+3 NEW I,MAGEXT,MAGFN
+4 NEW RES
+5 SET I=""
FOR
SET I=$ORDER(ARR(I))
if I=""
QUIT
Begin DoDot:1
+6 SET CT=CT+1
+7 ; special case ACTION=RESCIND
+8 IF ACTION="RESCIND"
SET MAGA(CT)="IMAGE^"_ARR(I)
QUIT
+9 IF ($LENGTH($PIECE(ARR(I),U),".")<2)
SET MAGRY(0)="0^Invalid file name: "_ARR(I)
QUIT
+10 SET MAGFN=$PIECE(ARR(I),"^")
+11 SET MAGEXT=$$UP^XLFSTR($PIECE(MAGFN,".",$LENGTH(MAGFN,".")))
+12 KILL RES
+13 DO INFO^MAGGSFT(.RES,MAGEXT)
+14 IF 'RES(0)
SET MAGRY(0)=RES(0)
QUIT
+15 SET MAGA(CT)="IMAGE"_U_ARR(I)
End DoDot:1
if 'MAGRY(0)
QUIT
+16 QUIT
GETARR(ARR,QNUM) ;RPC [MAG4 DATA FROM IMPORT QUEUE]
+1 ; Get the Input Array from Queue Number
+2 IF '$GET(QNUM)
SET ARR(0)="0^INVALID QUEUE Number: "_$GET(QNUM)
QUIT
+3 DO IMPAR^MAGQBUT2(.ARR,QNUM)
+4 QUIT
STATUSCB(MAGRY,STAT,TAGRTN,DOCB) ;RPC [MAG4 STATUS CALLBACK]
+1 ; Report Status to calling application
+2 ; Now the IAPI and OCX make this call. Not BP
+3 ; STAT(0)= "0^message" or "1^message"
+4 ; STAT(1)=TRKID,
+5 ; (2)=QNUM
+6 ; (3..N)=warnings
+7 ;TAGRTN : The TAG^RTN to call with Status Array
+8 ;DOCB : (1|0) to suppress execution of Status Callback
+9 ;
+10 NEW APISESS,TRKID,CBMSG
+11 ; Default to TRUE
SET DOCB=$SELECT($GET(DOCB)="":1,1:+$GET(DOCB))
+12 ; Old Import API and BP that made this call, will work : DOCB defaults to 1
+13 SET CBMSG=$SELECT(DOCB:"Status Callback was called",1:"Status Callback was NOT called")
+14 IF DOCB
DO @(TAGRTN_"(.STAT)")
+15 SET MAGRY="1^"_CBMSG
+16 SET STAT($ORDER(STAT(""),-1)+1)=MAGRY
+17 SET TRKID=$GET(STAT(1))
+18 ; Log Results. Always.
+19 IF $LENGTH(TRKID)
Begin DoDot:1
+20 ;
SET APISESS=$$SES4TRK^MAGGSIU3(TRKID)
+21 ;gek/send Tracking ID to log status
IF APISESS
DO LOGRES^MAGGSIU3(.STAT,0,APISESS)
End DoDot:1
+22 QUIT
TESTCB(STATARR) ;TESTING. This is the Status Callback for testing.
+1 ; the STATUSCB property must have a Valid "M" TAG^ROUTINE
+2 ; TAG TESTCB exists so that STATUSCB validates successfully
+3 QUIT
ERRTRK ;Track bad data and Quit
+1 NEW I
+2 DO LOGERR^MAGGSERR("---- New Error ----",APISESS)
+3 SET I=""
FOR
SET I=$ORDER(MAGRY(I))
if I=""
QUIT
DO LOGERR^MAGGSERR(MAGRY(I),APISESS)
+4 QUIT
DATATRK ; Track the raw data being sent to the Import API.
+1 ; Log the data being imported. Results are logged later.
+2 NEW XY
+3 SET APISESS=$$LOG^MAGGSIU3(.XY,.MAGIXZ,.IMAGES,IDFN,ACQD,TRKID)
+4 QUIT
ERR ; ERROR TRAP FOR Import API
+1 NEW ERR
SET ERR=$$EC^%ZOSV
+2 SET MAGRY(0)="0^ETRAP: "_ERR
+3 DO @^%ZOSF("ERRTN")
+4 IF $GET(APISESS)
DO ERRTRK
+5 QUIT
+6 ; Patch 108
GETIAPID(OUT,TRKID) ; Returns Import API data in OUT array from file (#2006.82) by tracking ID
+1 ; OUT(FIELD)=VALUE
+2 NEW I,X,Y,SNUM,VAL1
+3 ; Get the last recording for this TRKID
SET SNUM=$ORDER(^MAG(2006.82,"E",TRKID,""),-1)
+4 ; no data found
IF 'SNUM
QUIT
+5 ; Patch 121/ gek Add the Return of the 'Image:' Data
+6 SET I=1
+7 FOR
SET I=$ORDER(^MAG(2006.82,SNUM,"ACT",I))
if I'?1N.N
QUIT
Begin DoDot:1
+8 SET VAL1=$GET(^MAG(2006.82,SNUM,"ACT",I,0))
+9 IF VAL1="Data:"
Begin DoDot:2
+10 SET X=$GET(^MAG(2006.82,SNUM,"ACT",I,1))
+11 SET Y=$TRANSLATE($PIECE(X,":"),"()","")
+12 if Y'=""
SET OUT(Y)=$PIECE(X,": ",2,999)
+13 QUIT
End DoDot:2
+14 IF VAL1="Image:"
Begin DoDot:2
+15 SET X=$GET(^MAG(2006.82,SNUM,"ACT",I,1))
+16 SET Y=$TRANSLATE($PIECE(X,":"),"()","")
+17 if Y'=""
SET OUT("IMAGE",Y)=$PIECE(X,": ",2,999)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
