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

MAGGTIA1.m

Go to the documentation of this file.
  1. MAGGTIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; Dec 05, 2018@1:42pm
  1. ;;3.0;IMAGING;**21,8,59,93,201,221**;Dec 02, 2009;Build 163
  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. ;; | |
  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. ADD ;Now call Fileman to file the data
  1. N NEWIEN,MAGGDA,X,Y
  1. ;~~~ Delete this comment and the following line of code when
  1. ; the IMAGE AUDIT file (#2005.1) is completely eliminated.
  1. ; Because we delete the Image node on image deletion, we have to
  1. ; check the last entry in Audit File, to see if it is greater
  1. ;~~~ than the last image in the Image File.
  1. I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
  1. ; we know that MAGGIEN WILL contain the internal number.
  1. ; after the call.
  1. ;
  1. I $G(MAGMOD) D Q ; WE'LL QUIT AFTER MODIFICATION
  1. . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
  1. . S MAGRY="1^OK"
  1. . ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
  1. . D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN
  1. ;
  1. S (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12() ; SG - MAG*3*93
  1. D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
  1. ;
  1. I '$G(MAGGIEN(1)) D S MAGRY=MAGERR Q
  1. . S MAGERR="0^ERROR Creating new Image File Entry "
  1. . I $D(DIERR) D RTRNERR(.MAGERR)
  1. . D CLEAN
  1. ;
  1. S MAGGDA=MAGGIEN(1)
  1. ;
  1. D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
  1. ;
  1. ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
  1. ; we'll do this by hand, Else it'll take forever.
  1. ; we Return the IEN with NO Filename. Groups don't get Filename
  1. ;
  1. I MAGGR S MAGRY=MAGGDA_U,Z="" D G C1
  1. . F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA
  1. . D CLEAN
  1. ;
  1. S X=$G(MAGGFDA(2005,"+1,",14)) I +X D
  1. . ; If here: This image is a member of a Group
  1. . ; -Modify the Group Parent, add DA to it's group
  1. . ; -Also set 'Series Number' and 'Image Number' if they exist;
  1. . K MAGGFDA
  1. . S Y="+2,"_X_","
  1. . S MAGGFDA(2005.04,Y,.01)=MAGGDA
  1. . ; GEK 4/4/00 ADDED $L( we were dying on "0"
  1. . I $L($G(MAGDCMSN)) S MAGGFDA(2005.04,Y,1)=MAGDCMSN
  1. . I $L($G(MAGDCMIN)) S MAGGFDA(2005.04,Y,2)=MAGDCMIN
  1. . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
  1. ;
  1. ; Now get the Image file name. DOS FILE name
  1. ; The ENTRY in Image File has been made, if any errors from here on
  1. ; then we have to delete the image entry.
  1. I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1
  1. K MAGGFDA
  1. S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGGEXT)) I 'X D S MAGRY=MAGERR Q
  1. . S MAGERR=X
  1. . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
  1. . K DA,DIC,DIK
  1. . D CLEAN
  1. S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
  1. S MAGGFDA(2005,Y,1)=MAGGFNM
  1. D UPDATE^DIE("","MAGGFDA","","MAGGXE")
  1. ; shouldn't have an error just editing one entry, but just in case.
  1. I $D(DIERR) D S MAGRY=MAGERR Q
  1. . D RTRNERR(.MAGERR)
  1. . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
  1. . K DA,DIC,DIK
  1. . D CLEAN
  1. ;
  1. C1 ; we jump here if we already had a Filename sent
  1. K MAGGFDA
  1. ; New Index Field Check. If this entry doesn't have the Index fields introduced
  1. ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
  1. ;
  1. ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry.
  1. I '$D(^MAG(2005,MAGGDA,40)) D
  1. . N INDXD
  1. . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
  1. . S ^MAG(2005,MAGGDA,40)=INDXD
  1. . S ^MAGIXCVT(2006.96,MAGGDA)=2 ; Flag. Says fields were converted Patch 59
  1. . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
  1. . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
  1. . D ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
  1. . Q
  1. ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
  1. I '$P(^MAG(2005,MAGGDA,40),"^",3) D
  1. . N INDXD,J,OLD40,N40
  1. . S (N40,OLD40)=^MAG(2005,MAGGDA,40)
  1. . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
  1. . ; If Origin doesn't exist in existing, this will put V in.
  1. . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
  1. . ; We're not changing existing values of Spec,Proc or Origin
  1. . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
  1. . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
  1. . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5)
  1. . S ^MAG(2005,MAGGDA,40)=N40
  1. . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
  1. . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
  1. . Q
  1. ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
  1. ;** IT IS DONE IN A SEPERATE CALL
  1. ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
  1. ;** the workstation
  1. ;
  1. ; Queue it to be copied to Jukebox.
  1. ; CREATE ABSTRACT
  1. ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
  1. I $G(MAGGABS)="YES" S X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
  1. ; RESTORE AFTER GLOBAL SETUP
  1. I $G(MAGGJB)="YES" S X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
  1. ; Code for setting a Queue to Copy BIG to JUKEBOX
  1. ;
  1. ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
  1. ; example: 487^C:\IMAGE\^DC000487.TIF
  1. ; The calling routine is responsible for renaming/naming the file
  1. ; to the returned DRIVE:\DIR\FILENAME.EXT
  1. ; 4/23/98 to include hierarchical directory structure -- PMK
  1. ;
  1. I 'MAGGR D
  1. . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
  1. . S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
  1. . ; For now, BIG files are in same directory as FullRes (or PACS) file
  1. . I $G(MAGBIG) D
  1. . . S X=$P(MAGGFNM,".",1)_".BIG"
  1. . . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
  1. . . Q
  1. . Q
  1. ;
  1. N MAGOUT
  1. D NWI2005^MAGNWRK1(.MAGOUT,MAGGDA) ; add a new storage work item
  1. ;
  1. CLEAN ;
  1. D CLEAN^DILF
  1. L -^MAG(2005,NEWIEN)
  1. Q
  1. RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
  1. S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
  1. Q
  1. ERR ; Error trap
  1. S MAGRY="0^ERROR "_$$EC^%ZOSV
  1. D @^%ZOSF("ERRTN")
  1. Q
  1. MAKENAME() ; MAGGFDA exists so get info from that.
  1. ; We'll make NAME (.01) with PATIENT NAME SSN
  1. ; DOCUMENT Imaging was making name of
  1. ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
  1. N Z,ZT,ZNAME,ZSSN,ZDESC
  1. ; GEK 10/10/2000
  1. ; Modifying this procedure to make same name for all Image types
  1. ; The name will be (first 18 chars of patient Name) _ SSN
  1. I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
  1. I $D(MAGGFDA(2005,"+1,",5)) D
  1. . S X=MAGGFDA(2005,"+1,",5)
  1. . S ZNAME=$P(^DPT(X,0),U),ZSSN=$P(^DPT(X,0),U,9)
  1. ;
  1. ; For all Images the name is first 18 characters of patient name
  1. ; concatenated with SSN. If No patient name is sent, well make
  1. ; the name from the short desc.
  1. I $D(ZNAME) S Z=$E(ZNAME,1,18)_" "_ZSSN
  1. E S Z=ZDESC
  1. Q Z