Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGSIUI

MAGGSIUI.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1. REMOTE(MAGRY,MAGDATA) ;RPC [MAG4 REMOTE IMPORT]
  1.  ; Import Images from a Windows App, by sending an array.
  1.  I ($D(MAGDATA)<10) S MAGRY(0)="0^Missing Data Array !." Q
  1.  N I,J,ICT,DCT,MAGIX,IMAGES,ERR,X,Z
  1.  S (ERR,ICT,DCT)=0
  1.  S I="" F  S I=$O(MAGDATA(I)) Q:I=""  S X=MAGDATA(I) D  Q:ERR
  1.  . S Z=$P(X,U)
  1.  . I (X="")!(Z="") S MAGRY(0)="0^INVALID Data in Input Array: Node "_I_"="""_X_"",ERR=1 Q
  1.  . I Z="IMAGE" S ICT=ICT+1,IMAGES(ICT)=$P(X,U,2,99) Q
  1.  . S DCT=DCT+1,MAGIX(Z)=$P(X,U,2,99)
  1.  I 'ERR D IMPORT(.MAGRY,.IMAGES,.MAGIX)
  1.  Q
  1.  ;
  1. IMPORT(MAGRY,IMAGES,MAGIX) ;
  1.  ; "IDFN","PXPKG","PXIEN","PXDT","TRKID","ACQD","ACQS","ACQL","STSCB","ITYPE",
  1.  ;        "CMTH","CDUZ","USERNAME","PASSWORD","GDESC","DFLG","TRTYPE","DOCCTG","DOCDT",
  1.  ;        "IXTYPE","IXSPEC","IXPROC","IXORIGIN    ;Patch 8: Added Index fields
  1.  ;        "PXSGNTYP","PXNEW","PXTIUTTL","PXTIUTXTxxxxx"  ; Patch 108
  1.  ;
  1.  ;Index fields Package, Class ("IXPKG" and "IXCLS") aren't accepted
  1.  ;    they are computed values.
  1.  ; - Convert field codes into an Input Data Array,
  1.  ;   validate, then set the Import Queue
  1.  ;
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
  1.  K MAGRY S MAGRY(0)="0^Importing data..."
  1.  N APISESS,MWIN
  1.  S MWIN=$$BROKER^XWBLIB
  1.  N PRM,CT,MAGA,MAGY,MAGTN,TNODE
  1.  N IDFN,PXPKG,PXIEN,PXDT,TRKID,ACQD,ACQS,ACQN,ACQL,STSCB,ITYPE,CMTH,CDUZ,USERNAME,PASSWORD
  1.  N GDESC,DFLG,TRTYPE,DOCCTG,DOCDT,IXPKG,IXCLS,IXTYPE,IXSPEC,IXPROC,IXORIGIN,MAX,SITEPLC
  1.  N ERR,MAGTM,QTIME,MAGIXZ
  1.  N PXNEW,PXTIUTTL,PXSGNTYP  ; Patch 108
  1.  N ACTION
  1.  S CT=0,ERR=0
  1.  M MAGIXZ=MAGIX
  1.  ;  DON'T CONVERT ACQS(really a ACQN) to a REAL ACQS, leave it ACQS to be converted by MAGGSIV
  1.  ;  121:  'ACTION' is new
  1.  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
  1.  . S @PRM=$G(MAGIX(PRM)) K MAGIX(PRM) ; P8T14 added K.. and next line to account for field numbers later.
  1.  . Q
  1.  S PRM="" F  S PRM=$O(MAGIX(PRM)) Q:PRM=""  D SA(PRM,$G(MAGIX(PRM)))
  1.  ;
  1.  S MAGTM=$$NOW^XLFDT
  1.  I '$G(DUZ) S MAGRY(0)="0^DUZ is undefined." Q  ;D ERRTRK Q
  1.  ; DATATRK sets Global var. APISESS  = IEN of Session File.
  1.  D DATATRK
  1.  I '$$REQPARAM^MAGGSIU2() D ERRTRK Q
  1.  S MAX=$P(TRKID,";",1)="MAX"
  1.  ;I 'MWIN W !,"----------------" ZW  W !,"---------------------"
  1.  ; Workaround VIC (Maximus) is sending Station Number 
  1.  ; we'll convert to Institution IEN
  1.  I MAX&(ACQS]"") D  Q:ERR
  1.  . S X=$O(^DIC(4,"D",ACQS,""))
  1.  . I X="" S MAGRY(0)="0^Invalid Station Number:(Maximus ACQS): "_ACQS,ERR=1 Q
  1.  . S SITEPLC=X ; We need the Place for the Queue
  1.  . ;S ACQS=X  Out in 85. Don't change to ACQS, that's done in VAL^MAGGSIV
  1.  . Q
  1.  ; Change to Allow ACQN - STATION NUMBER from INSTITUTION File.
  1.  I $L(ACQN) D  Q:ERR
  1.  . S ACQS=$O(^DIC(4,"D",ACQN,""))
  1.  . I ACQS="" S MAGRY(0)="0^Invalid STATION NUMBER: (ACQN): "_ACQN,ERR=1 Q
  1.  . ; VAL^MAGGSIV Will fail if ACQS is real and this is Maximus 
  1.  . I MAX S ACQS=ACQN K ACQN Q
  1.  . S ACQN="" ;We converted to ACQS, lets make "" so no confusion later.
  1.  . Q
  1.  ;
  1.  ; Set the input data array
  1.  ;
  1.  ; Patch 108
  1.  D SA("PXSGNTYP",PXSGNTYP)        ; Signature Type - 0 unsigned/ 1 administrative closed/ 2 signed
  1.  D SA("PXTIUTTL",PXTIUTTL)  ; TIU Title in case a new TIU stub needs to be created
  1.  D SA("PXNEW",PXNEW)        ; Flag to create a new package ( e.g. a new TUI stub)
  1.  ; PXIEN has to be set to zero because of Delphi function TMagImport.FileSpecialtyPointers
  1.  ; In this way we don't need to recompile BP
  1.  S:PXNEW="1" PXIEN=0
  1.  D SA(5,IDFN)    ;PATIENT
  1.  D SA(16,PXPKG)   ;PARENT DATA FILE
  1.  D SA(17,PXIEN) ;PARENT GLOBAL ROOT
  1.  D SA(15,PXDT)   ; PROCEDURE/EXAM DATE/TIME
  1.  D SA(108,TRKID) ; TRACKING ID (new)
  1.  D SA("ACQD",ACQD)  ; ACQUISTION DEVICE ( new )
  1.  I 'MAX S SITEPLC=ACQS D SA(.05,ACQS) ; this used to be fld 105
  1.  D SA(101,ACQL)
  1.  D SA("STATUSCB",STSCB)  ; STATUS CALLBACK  (was referred to as ExceptionHandler)
  1.  D SA(3,ITYPE)   ; OBJECT TYPE
  1.  D SA("CALLMTH",CMTH)     ; CALL METHOD
  1.  D SA(8,CDUZ)    ; IMAGE SAVE BY
  1.  D SA("USERNAME",USERNAME)
  1.  D SA("PASSWORD",PASSWORD)
  1.  D SA(10,GDESC)  ; SHORT DESCRIPTION
  1.  D SA("DELFLAG",DFLG)    ; DELETE FLAG
  1.  D SA("TRNSTYP",TRTYPE)  ; TRANSACTION TYPE
  1.  D SA(100,DOCCTG) ;  document Main category
  1.  D SA(110,DOCDT)     ;  document date
  1.  ; Patch 8 allows Index fields to be imported.
  1.  ;"IXTYPE","IXSPEC","IXPROC","IXORIGIN"
  1.  D SA(42,IXTYPE)     ;  Index Type
  1.  D SA(43,IXPROC)     ;  Index Proc/Event
  1.  D SA(44,IXSPEC)     ;  Index Spec/SubSpec
  1.  D SA(45,IXORIGIN)         ;  Index Origin
  1.  ; Patch 121 allows ACTION of RESCIND
  1.  D SA("ACTION",ACTION)     ; P121 ACTION=RESCIND
  1.  ;
  1.  D VAL^MAGGSIV(.MAGRY,.MAGA,1) I 'MAGRY(0) D ERRTRK Q
  1.  I MAX D SA(.05,ACQS) ; this used to be fld 105
  1.  ; Also Done in MAGGSIA when image is being Saved.
  1.  I '$$VALINDEX^MAGGSIV1(.MAGRY,IXTYPE,IXSPEC,IXPROC) D ERRTRK Q
  1.  ;   Array of Images to Import
  1.  D SI("IMAGES",.IMAGES) I 'MAGRY(0) D ERRTRK Q
  1.  K MAGRY
  1.  ;
  1.  I TRTYPE="NOQUEUE" M MAGRY=MAGA S MAGRY(0)="1^" Q
  1.  ; This call is for BP
  1.  S QTIME=$$NOW^XLFDT
  1.  ; p85 use ACQS instead of DUZ(2)
  1.  S MAGY=$$IMPORT^MAGBAPI(.MAGA,STSCB,TRKID,$$PLACE^MAGBAPI(SITEPLC))
  1.  ; Return Queue Number
  1.  I 'MAGY S MAGRY(0)="0^Error Setting Queue: "_$P(MAGY,U,2),MAGY=TRKID
  1.  E  S MAGRY(0)=MAGY_"^Data has been Queued.",MAGY=+MAGY
  1.  ; for debugging we'll track input array, and results array by Queue number.
  1.  I 'MAGRY(0) D ERRTRK Q
  1.  D LOGRES^MAGGSIU3(.MAGRY,0,APISESS)
  1.  ;
  1.  Q
  1.  ;
  1. SA(FLD,VAL) ;Set the data array with Fld,Value
  1.  Q:VAL=""
  1.  S CT=CT+1,MAGA(CT)=FLD_U_VAL
  1.  Q
  1. SI(FLD,ARR) ;Set the images into the data array
  1.  ; 'CT' is a global variable.
  1.  S MAGRY(0)="1^Valid Image file Extensions."
  1.  N I,MAGEXT,MAGFN
  1.  N RES
  1.  S I="" F  S I=$O(ARR(I)) Q:I=""  D  Q:'MAGRY(0)
  1.  . S CT=CT+1
  1.  . ; special case ACTION=RESCIND
  1.  . I ACTION="RESCIND" S MAGA(CT)="IMAGE^"_ARR(I) Q
  1.  . I ($L($P(ARR(I),U),".")<2) S MAGRY(0)="0^Invalid file name: "_ARR(I) Q
  1.  . S MAGFN=$P(ARR(I),"^")
  1.  . S MAGEXT=$$UP^XLFSTR($P(MAGFN,".",$L(MAGFN,".")))
  1.  . K RES
  1.  . D INFO^MAGGSFT(.RES,MAGEXT)
  1.  . I 'RES(0) S MAGRY(0)=RES(0) Q
  1.  . S MAGA(CT)="IMAGE"_U_ARR(I)
  1.  Q
  1. GETARR(ARR,QNUM) ;RPC [MAG4 DATA FROM IMPORT QUEUE]
  1.  ; Get the Input Array from Queue Number
  1.  I '$G(QNUM) S ARR(0)="0^INVALID QUEUE Number: "_$G(QNUM) Q
  1.  D IMPAR^MAGQBUT2(.ARR,QNUM)
  1.  Q
  1. STATUSCB(MAGRY,STAT,TAGRTN,DOCB) ;RPC [MAG4 STATUS CALLBACK]
  1.  ; Report Status to calling application
  1.  ; Now the IAPI and OCX make this call.  Not BP
  1.  ; STAT(0)= "0^message" or "1^message"
  1.  ; STAT(1)=TRKID,
  1.  ;        (2)=QNUM
  1.  ;        (3..N)=warnings
  1.  ;TAGRTN                 : The TAG^RTN to call with Status Array
  1.  ;DOCB                   : (1|0) to suppress execution of Status Callback
  1.  ; 
  1.  N APISESS,TRKID,CBMSG
  1.  S DOCB=$S($G(DOCB)="":1,1:+$G(DOCB)) ;  Default to TRUE
  1.  ; Old Import API and BP that made this call, will work : DOCB defaults to 1
  1.  S CBMSG=$S(DOCB:"Status Callback was called",1:"Status Callback was NOT called")
  1.  I DOCB D @(TAGRTN_"(.STAT)")
  1.  S MAGRY="1^"_CBMSG
  1.  S STAT($O(STAT(""),-1)+1)=MAGRY
  1.  S TRKID=$G(STAT(1))
  1.  ; Log Results. Always.
  1.  I $L(TRKID) D
  1.  . S APISESS=$$SES4TRK^MAGGSIU3(TRKID) ;
  1.  . I APISESS D LOGRES^MAGGSIU3(.STAT,0,APISESS) ;gek/send Tracking ID to log status
  1.  Q
  1. TESTCB(STATARR) ;TESTING.  This is the Status Callback for testing.
  1.  ; the STATUSCB property must have a Valid "M" TAG^ROUTINE
  1.  ; TAG TESTCB exists so that STATUSCB validates successfully
  1.  Q
  1. ERRTRK ;Track bad data and Quit
  1.  N I
  1.  D LOGERR^MAGGSERR("---- New Error ----",APISESS)
  1.  S I="" F  S I=$O(MAGRY(I)) Q:I=""  D LOGERR^MAGGSERR(MAGRY(I),APISESS)
  1.  Q
  1. DATATRK ; Track the raw data being sent to the Import API.
  1.  ; Log the data being imported.  Results are logged later.
  1.  N XY
  1.  S APISESS=$$LOG^MAGGSIU3(.XY,.MAGIXZ,.IMAGES,IDFN,ACQD,TRKID)
  1.  Q
  1. ERR ; ERROR TRAP FOR Import API
  1.  N ERR S ERR=$$EC^%ZOSV
  1.  S MAGRY(0)="0^ETRAP: "_ERR
  1.  D @^%ZOSF("ERRTN")
  1.  I $G(APISESS) D ERRTRK
  1.  Q
  1.  ; Patch 108
  1. GETIAPID(OUT,TRKID) ; Returns Import API data in OUT array from file (#2006.82) by tracking ID
  1.  ; OUT(FIELD)=VALUE
  1.  N I,X,Y,SNUM,VAL1
  1.  S SNUM=$O(^MAG(2006.82,"E",TRKID,""),-1)  ; Get the last recording for this TRKID
  1.  I 'SNUM Q  ; no data found
  1.  ; Patch 121/ gek Add the Return of the 'Image:' Data
  1.  S I=1
  1.  F  S I=$O(^MAG(2006.82,SNUM,"ACT",I)) Q:I'?1N.N  D
  1.  . S VAL1=$G(^MAG(2006.82,SNUM,"ACT",I,0))
  1.  . I VAL1="Data:" D
  1.  . . S X=$G(^MAG(2006.82,SNUM,"ACT",I,1))
  1.  . . S Y=$TR($P(X,":"),"()","")
  1.  . . S:Y'="" OUT(Y)=$P(X,": ",2,999)
  1.  . . Q
  1.  . I VAL1="Image:" D
  1.  . . S X=$G(^MAG(2006.82,SNUM,"ACT",I,1))
  1.  . . S Y=$TR($P(X,":"),"()","")
  1.  . . S:Y'="" OUT("IMAGE",Y)=$P(X,": ",2,999)
  1.  . . Q
  1.  . Q
  1.  Q