MAGGSIU5 ;WOIFO/GEK - Utilities for Image Import API ; 11 Jun 2013 5:37 PM
;;3.0;IMAGING;**121,135,154**;Mar 19, 2002;Build 9;Nov 07, 2014
;; 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
; ----- RSND1 ----- Rescind One Image
; This routine is called by other Imaging routines to Rescind One Image.
;
; Input Parameters
; ================
; MAGIEN = IEN of Image entry in IMAGE (#2005) File
; TIUDA = IEN of TIU note in TIU DOCUMENT file (#8925)
; DELREAS = Free text of Deleted Reason
;
; MAGIEN and TIUDA are required.
; We verify that the Image entry MAGIEN, points to TIUDA.
; We also call the Integrity Check for the image, and we do not
; process a Rescind Action if the IQ Check fails.
;
; Return Values
; =============
; Results are passed back in the MAGRY Array
; if error found during execution
; MAGRY(0) = 0^Error message"
; MAGRY(1..N) = messages describing the Error.
;
; if success, the result array is same as Import API
; MAGRY(0) = 1^Success
; MAGRY(1) = TRKID - Tracking ID
; MAGRY(2) = QUE - Queue Number from IMPORT QUEUE File(#2006.034)
;
; Tracking ID is a field in each of the following files:
; IMAGE File (#2005) (Field #108) (index "ATRKID")
; IMAGING WINDOWS SESSION File (#2006.82) (Field #8) (index "E")
; ACQUISITION SESSION FILE File(#2006.041)(Field #.02) (index "C")
;
;
RSND1(MAGRY,MAGIEN,TIUDA,DELREAS) ; Main entry point to rescind an Image
N QARR,TRKID,CALLBACK
N RSLT,REASON,REASDA,MAGTDAT
N I,QCT,N0,N2,N40,N100,MAGLT
N IMGSPLCS,MAGRQA,MAGRDY
N MAGTMP,X
N $ETRAP,$ESTACK S $ETRAP="D ERRA^"_$T(+0)
;
S MAGIEN=$G(MAGIEN),TIUDA=$G(TIUDA)
; Quit if MAGIEN is deleted.
I $$ISDEL^MAGGI11(MAGIEN) D Q
. S MAGRY(0)="0^Image: "_MAGIEN_" is Deleted"
. Q
; Check for TIUDA, and TIUDA, is same as Image Entry.
I 'TIUDA S MAGRY(0)="0^A TIU Note is required" Q
; If Group Image, use Group (MAGTMP) for next check.
; because the group image won't point to TIU, only Group Parent.
S MAGTMP=MAGIEN
I $P(^MAG(2005,MAGIEN,0),"^",10) S MAGTMP=$P(^MAG(2005,MAGIEN,0),"^",10)
I $$GET1^DIQ(2005,MAGTMP_",",17,"I")'=TIUDA D Q
. S MAGRY(0)="0^Mismatch between the TIU Note parameter and TIU Note linked to Image"
. S MAGRY(1)="TIU Note: "_TIUDA_" Image: "_MAGIEN
. Q
; Run the Integrity Checker, quit if it finds problem
D CHK^MAGGSQI(.MAGRQA,MAGIEN) I 'MAGRQA(0) D Q
. S MAGRY(0)=MAGRQA(0)
. Q
; Quit if Image is already Rescinded,
; (checking Field # 115.2 LINKED TYPE)
S MAGLT=$$GET1^DIQ(2005,MAGIEN_",",115.2,"I") I MAGLT=1 D Q
. S MAGRY(0)="0^Image is already Rescinded."
. S MAGRY(1)="RESCIND Action is Canceled."
. Q
; Now we check for OffLine Platters and other OffLine Issues.
I '$$DATAOK(.MAGRDY,MAGIEN,TIUDA) D Q
. M MAGRY=MAGRDY
;
S MAGRY(0)="0^Processing Rescind request..."
;
S CALLBACK="STATCB^MAGGSIU4"
S REASON=$G(DELREAS,"Rescinded TIU Note")
S REASDA=$$FIND1^DIC(2005.88,"","X",REASON)
; Get data for TIU Note.
D DATA^MAGGNTI(.MAGTDAT,TIUDA)
;
; IMGSPLCS : Image paths and Image places.
; Get string of Full File Path's | File Places.
; This is needed after success, to Delete the Files from Image Network.
; i.e. Image Full Path^Abs full Path^Big full Path|Image Place^Abs Place^Big Place
S IMGSPLCS=$$IMGPLC(MAGIEN)
S I=0,QCT=0
;
S N0=$G(^MAG(2005,MAGIEN,0))
S N2=$G(^MAG(2005,MAGIEN,2))
S N40=$G(^MAG(2005,MAGIEN,40))
S N100=$G(^MAG(2005,MAGIEN,100))
;
; We Delete the image entry first, then set the Import Queue.
S RSLT=$$DELETE^MAGGSIU4(MAGIEN,REASON)
; Quit if we can't delete.
I $P(RSLT,"^",1)=0 D Q ;
. S MAGRY(0)=RSLT
. Q
;
S TRKID=$$TRKID^MAGGSIU4() ; Get unique Import API tracking ID
I TRKID=0 S MAGRY(0)="0^Error generating a Tracking ID" Q
;
; Set up Import queue data
;--
; ACTION is the new Import Data Code. We'll send 'RESCIND' to the
; Active X control for special processing.
S QCT=QCT+1,QARR(QCT)="ACTION^RESCIND"
S QCT=QCT+1,QARR(QCT)="PXIEN^"_TIUDA ; IEN of TIU note
S QCT=QCT+1,QARR(QCT)="TRKID^"_TRKID ; Import API Track ID
S QCT=QCT+1,QARR(QCT)="STSCB^"_CALLBACK ; Status call back routine
; The format of 'IMAGE' Data for a Rescind is different than for
; a Normal Image Import. This is by design so that the
; old version of the IAPI (called by BP Patch 39 and before)
; does not process this import.
S QCT=QCT+1,QARR(QCT)="IMAGE"_"^"_MAGIEN_"^"_IMGSPLCS
;
; Now, set the Required data (plus new data) then call MAGGSIUI the
; same as always. It'll set an IMPORT QUEUE (#2006.034)
; and track the data in the IMAGING WINDOWS SESSION file (#2006.82)
; the same as all imports.
;
S QCT=QCT+1,QARR(QCT)="PXPKG^8925"
;;;S QCT=QCT+1,QARR(QCT)="PXDT^"_$P(MAGTDAT,"^",3) ;135 T6
S QCT=QCT+1,QARR(QCT)="PXDT^"_$P(N2,"^",5) ;135 T6
; 135 T6 Remedy INC000000795508 instead of MAGTDAT^3 (Entry Date) we use Procedure Date/Time
; from the Exiting Image Entry, which is the Reference Date of the TIU Note.
S QCT=QCT+1,QARR(QCT)="IDFN^"_$P(N0,"^",7)
; P135T6 Set Acquisition Site the same as existing Image
; if existing Acq Site is null, use DUZ(2)
S X=$P(N100,"^",3)
I X]"" S QCT=QCT+1,QARR(QCT)="ACQS^"_X
E S QCT=QCT+1,QARR(QCT)="ACQS^"_DUZ(2)
S QCT=QCT+1,QARR(QCT)="ACQD^"_"IAPI" ; This is the acquisition device. Import API.
S QCT=QCT+1,QARR(QCT)="GDESC^"_$E("RESCINDED "_$p(N2,"^",4),1,60)
;gek/p121t2 Force IXTYPE to be ADVANCE DIRECTIVE to fix IMED issue of
; indexing AD's as Miscelleneous Document.
S QCT=QCT+1,QARR(QCT)="IXTYPE^"_"ADVANCE DIRECTIVE" ;$P(N40,"^",3)
S QCT=QCT+1,QARR(QCT)="IXPROC^"_$P(N40,"^",4)
S QCT=QCT+1,QARR(QCT)="IXSPEC^"_$P(N40,"^",5)
S QCT=QCT+1,QARR(QCT)="IXORIGIN^"_$P(N40,"^",6)
; To this point, all data in array will be passed back from OCX.
; The data Below : will be validated in the call to REMOTE^MAGGSIUI, and stored in the Session
; File, but won't be returned in the call to ADD^MAGGSIA. the old design of the IAPI prohibits
; data except for the Import Codes known by IAPI. So in ADD^MAGGSIA1 before the call to UPDATE^DIC,
; the data for these fields (for Rescinded Import) will need to be retrieved from the
; Session file and added to the FDA array.
;
; PROCEDURE #6
; CREATION DATE #110
; LINKED IMAGE #115.1
; LINKED TYPE #115.2
; LINKED DATE #115.3 (DATE TIME)
;
; make sure the procedure field is not too long.
S QCT=QCT+1,QARR(QCT)="6^"_$E($P(N0,"^",8),1,10)
S QCT=QCT+1,QARR(QCT)="110^"_$P(N100,"^",6)
S QCT=QCT+1,QARR(QCT)="115.1^"_MAGIEN ;comment this out for testing.
S QCT=QCT+1,QARR(QCT)="115.2^"_"1" ; 1 = RESCIND
S QCT=QCT+1,QARR(QCT)="115.3^"_$$NOW^XLFDT
;
K MAGRY
D REMOTE^MAGGSIUI(.MAGRY,.QARR)
I MAGRY(0) D
. S MAGRY($O(MAGRY(""),-1)+1)="TrkID: "_$G(TRKID)
. S MAGRY($O(MAGRY(""),-1)+1)="Queue: "_+MAGRY(0)
. Q
Q
; ----- ERRA ---- Error trap
ERRA ; Error Trap for RSND1 - Array Return - MAGRY
N ERR S ERR=$$EC^%ZOSV
S MAGRY(0)="0^"_ERR
S MAGRY($O(MAGRY(""),-1)+1)=ERR
D LOGERR^MAGGTERR(ERR)
D @^%ZOSF("ERRTN")
Q
; ----- IMGPLC ---- internal call to return Image paths and places.
; MAGIEN = IMAGE File (#2005) internal entry number.
IMGPLC(MAGIEN) ; return a string of FullFile^AbsFile^BigFile|FullPlace^AbsPlace^BigPlace
;
N MAGXX,MAGPLC,FPATH
N RFILE,RPLC
; Here we 'New' the variables returned by MAGFILEB so they are cleared after this call.
N MAGFILE,MAGFILE1,MAGFILE2,MAGJBOL,MAGOFFLN
S RFILE="",RPLC=""
; Get Full Path and Place
S MAGXX=MAGIEN,MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"F")
D VSTNOCP^MAGFILEB
S FPATH=$P(MAGFILE2,"~",1) I FPATH="-1" S FPATH=""
S RFILE=RFILE_"^"_FPATH,RPLC=RPLC_"^"_MAGPLC
;
; Get Abs Path and Place
S MAGXX=MAGIEN,MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"A")
D ABSNOCP^MAGFILEB
S FPATH=$P(MAGFILE2,"~",1) I FPATH="-1" S FPATH=""
S RFILE=RFILE_"^"_FPATH,RPLC=RPLC_"^"_MAGPLC
;
; Get Big Patch and Place
S MAGXX=MAGIEN,MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"B")
D BIGNOCP^MAGFILEB
S FPATH=$P(MAGFILE2,"~",1) I FPATH="-1" S FPATH=""
S RFILE=RFILE_"^"_FPATH,RPLC=RPLC_"^"_MAGPLC
; get rid of first '^'
Q $E(RFILE,2,999)_"|"_$E(RPLC,2,999)
;
DATAOK(RY,MAGIEN,TIUDA) ;
; We access more data from MAGFILEB, and stop the Rescinding of Adv Directives
; if the Platter is Offline, Network Location is OffLine, Image can't be found
;
; Here we 'New' the variables returned by MAGFILEB so they are cleared after this call.
N MAGFILE,MAGFILE1,MAGFILE2,MAGJBOL,MAGOFFLN
S MAGXX=MAGIEN,MAGPLC=$$DA2PLC^MAGBAPIP(MAGIEN,"F")
D VSTNOCP^MAGFILEB
; P154 Quit if Image is Offline
I $G(MAGOFFLN)!$$IMOFFLN^MAGFILEB($P(^MAG(2005,MAGIEN,0),"^",2)) D Q 0
. S RY(0)="0^Image is on an OffLine Platter"
. S RY(1)="Platter: "_$G(MAGJBOL)
. S RY(2)="Contact Imaging staff to get Platter on line"
. Q
; Get here so, Image is not off line, but we'll also flag Invalid
; or other Errors.
; If other problem getting path to image then :
; MAGFILE1 is of format "-1~message"
I +MAGFILE1="-1" D Q 0
. S RY(0)="0^Error getting Image Data"
. S RY(1)="TIU Note: "_TIUDA_" Image: "_MAGIEN
. I $D(MAGFILE1("ERROR")) S RY(2)=MAGFILE1("ERROR")
. E S RY(2)=MAGFILE1
. Q
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIU5 10354 printed Dec 13, 2024@02:02:48 Page 2
MAGGSIU5 ;WOIFO/GEK - Utilities for Image Import API ; 11 Jun 2013 5:37 PM
+1 ;;3.0;IMAGING;**121,135,154**;Mar 19, 2002;Build 9;Nov 07, 2014
+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
+18 ; ----- RSND1 ----- Rescind One Image
+19 ; This routine is called by other Imaging routines to Rescind One Image.
+20 ;
+21 ; Input Parameters
+22 ; ================
+23 ; MAGIEN = IEN of Image entry in IMAGE (#2005) File
+24 ; TIUDA = IEN of TIU note in TIU DOCUMENT file (#8925)
+25 ; DELREAS = Free text of Deleted Reason
+26 ;
+27 ; MAGIEN and TIUDA are required.
+28 ; We verify that the Image entry MAGIEN, points to TIUDA.
+29 ; We also call the Integrity Check for the image, and we do not
+30 ; process a Rescind Action if the IQ Check fails.
+31 ;
+32 ; Return Values
+33 ; =============
+34 ; Results are passed back in the MAGRY Array
+35 ; if error found during execution
+36 ; MAGRY(0) = 0^Error message"
+37 ; MAGRY(1..N) = messages describing the Error.
+38 ;
+39 ; if success, the result array is same as Import API
+40 ; MAGRY(0) = 1^Success
+41 ; MAGRY(1) = TRKID - Tracking ID
+42 ; MAGRY(2) = QUE - Queue Number from IMPORT QUEUE File(#2006.034)
+43 ;
+44 ; Tracking ID is a field in each of the following files:
+45 ; IMAGE File (#2005) (Field #108) (index "ATRKID")
+46 ; IMAGING WINDOWS SESSION File (#2006.82) (Field #8) (index "E")
+47 ; ACQUISITION SESSION FILE File(#2006.041)(Field #.02) (index "C")
+48 ;
+49 ;
RSND1(MAGRY,MAGIEN,TIUDA,DELREAS) ; Main entry point to rescind an Image
+1 NEW QARR,TRKID,CALLBACK
+2 NEW RSLT,REASON,REASDA,MAGTDAT
+3 NEW I,QCT,N0,N2,N40,N100,MAGLT
+4 NEW IMGSPLCS,MAGRQA,MAGRDY
+5 NEW MAGTMP,X
+6 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^"_$TEXT(+0)
+7 ;
+8 SET MAGIEN=$GET(MAGIEN)
SET TIUDA=$GET(TIUDA)
+9 ; Quit if MAGIEN is deleted.
+10 IF $$ISDEL^MAGGI11(MAGIEN)
Begin DoDot:1
+11 SET MAGRY(0)="0^Image: "_MAGIEN_" is Deleted"
+12 QUIT
End DoDot:1
QUIT
+13 ; Check for TIUDA, and TIUDA, is same as Image Entry.
+14 IF 'TIUDA
SET MAGRY(0)="0^A TIU Note is required"
QUIT
+15 ; If Group Image, use Group (MAGTMP) for next check.
+16 ; because the group image won't point to TIU, only Group Parent.
+17 SET MAGTMP=MAGIEN
+18 IF $PIECE(^MAG(2005,MAGIEN,0),"^",10)
SET MAGTMP=$PIECE(^MAG(2005,MAGIEN,0),"^",10)
+19 IF $$GET1^DIQ(2005,MAGTMP_",",17,"I")'=TIUDA
Begin DoDot:1
+20 SET MAGRY(0)="0^Mismatch between the TIU Note parameter and TIU Note linked to Image"
+21 SET MAGRY(1)="TIU Note: "_TIUDA_" Image: "_MAGIEN
+22 QUIT
End DoDot:1
QUIT
+23 ; Run the Integrity Checker, quit if it finds problem
+24 DO CHK^MAGGSQI(.MAGRQA,MAGIEN)
IF 'MAGRQA(0)
Begin DoDot:1
+25 SET MAGRY(0)=MAGRQA(0)
+26 QUIT
End DoDot:1
QUIT
+27 ; Quit if Image is already Rescinded,
+28 ; (checking Field # 115.2 LINKED TYPE)
+29 SET MAGLT=$$GET1^DIQ(2005,MAGIEN_",",115.2,"I")
IF MAGLT=1
Begin DoDot:1
+30 SET MAGRY(0)="0^Image is already Rescinded."
+31 SET MAGRY(1)="RESCIND Action is Canceled."
+32 QUIT
End DoDot:1
QUIT
+33 ; Now we check for OffLine Platters and other OffLine Issues.
+34 IF '$$DATAOK(.MAGRDY,MAGIEN,TIUDA)
Begin DoDot:1
+35 MERGE MAGRY=MAGRDY
End DoDot:1
QUIT
+36 ;
+37 SET MAGRY(0)="0^Processing Rescind request..."
+38 ;
+39 SET CALLBACK="STATCB^MAGGSIU4"
+40 SET REASON=$GET(DELREAS,"Rescinded TIU Note")
+41 SET REASDA=$$FIND1^DIC(2005.88,"","X",REASON)
+42 ; Get data for TIU Note.
+43 DO DATA^MAGGNTI(.MAGTDAT,TIUDA)
+44 ;
+45 ; IMGSPLCS : Image paths and Image places.
+46 ; Get string of Full File Path's | File Places.
+47 ; This is needed after success, to Delete the Files from Image Network.
+48 ; i.e. Image Full Path^Abs full Path^Big full Path|Image Place^Abs Place^Big Place
+49 SET IMGSPLCS=$$IMGPLC(MAGIEN)
+50 SET I=0
SET QCT=0
+51 ;
+52 SET N0=$GET(^MAG(2005,MAGIEN,0))
+53 SET N2=$GET(^MAG(2005,MAGIEN,2))
+54 SET N40=$GET(^MAG(2005,MAGIEN,40))
+55 SET N100=$GET(^MAG(2005,MAGIEN,100))
+56 ;
+57 ; We Delete the image entry first, then set the Import Queue.
+58 SET RSLT=$$DELETE^MAGGSIU4(MAGIEN,REASON)
+59 ; Quit if we can't delete.
+60 ;
IF $PIECE(RSLT,"^",1)=0
Begin DoDot:1
+61 SET MAGRY(0)=RSLT
+62 QUIT
End DoDot:1
QUIT
+63 ;
+64 ; Get unique Import API tracking ID
SET TRKID=$$TRKID^MAGGSIU4()
+65 IF TRKID=0
SET MAGRY(0)="0^Error generating a Tracking ID"
QUIT
+66 ;
+67 ; Set up Import queue data
+68 ;--
+69 ; ACTION is the new Import Data Code. We'll send 'RESCIND' to the
+70 ; Active X control for special processing.
+71 SET QCT=QCT+1
SET QARR(QCT)="ACTION^RESCIND"
+72 ; IEN of TIU note
SET QCT=QCT+1
SET QARR(QCT)="PXIEN^"_TIUDA
+73 ; Import API Track ID
SET QCT=QCT+1
SET QARR(QCT)="TRKID^"_TRKID
+74 ; Status call back routine
SET QCT=QCT+1
SET QARR(QCT)="STSCB^"_CALLBACK
+75 ; The format of 'IMAGE' Data for a Rescind is different than for
+76 ; a Normal Image Import. This is by design so that the
+77 ; old version of the IAPI (called by BP Patch 39 and before)
+78 ; does not process this import.
+79 SET QCT=QCT+1
SET QARR(QCT)="IMAGE"_"^"_MAGIEN_"^"_IMGSPLCS
+80 ;
+81 ; Now, set the Required data (plus new data) then call MAGGSIUI the
+82 ; same as always. It'll set an IMPORT QUEUE (#2006.034)
+83 ; and track the data in the IMAGING WINDOWS SESSION file (#2006.82)
+84 ; the same as all imports.
+85 ;
+86 SET QCT=QCT+1
SET QARR(QCT)="PXPKG^8925"
+87 ;;;S QCT=QCT+1,QARR(QCT)="PXDT^"_$P(MAGTDAT,"^",3) ;135 T6
+88 ;135 T6
SET QCT=QCT+1
SET QARR(QCT)="PXDT^"_$PIECE(N2,"^",5)
+89 ; 135 T6 Remedy INC000000795508 instead of MAGTDAT^3 (Entry Date) we use Procedure Date/Time
+90 ; from the Exiting Image Entry, which is the Reference Date of the TIU Note.
+91 SET QCT=QCT+1
SET QARR(QCT)="IDFN^"_$PIECE(N0,"^",7)
+92 ; P135T6 Set Acquisition Site the same as existing Image
+93 ; if existing Acq Site is null, use DUZ(2)
+94 SET X=$PIECE(N100,"^",3)
+95 IF X]""
SET QCT=QCT+1
SET QARR(QCT)="ACQS^"_X
+96 IF '$TEST
SET QCT=QCT+1
SET QARR(QCT)="ACQS^"_DUZ(2)
+97 ; This is the acquisition device. Import API.
SET QCT=QCT+1
SET QARR(QCT)="ACQD^"_"IAPI"
+98 SET QCT=QCT+1
