MAGGTIA ;WOIFO/GEK/RMP - Imaging RPC Broker calls. Add/Modify Image entry ; [ 11/08/2001 17:18 ] ;;3.0;IMAGING;**8,48**;Jan 11, 2005 ;; +---------------------------------------------------------------+ ;; | 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 ; ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL. ; ADD(MAGRY,MAGGZ) ; RPC [MAGGADDIMAGE] ; Call to UPDATE^DIE to Add an Image File entry ; MAGGZ is an array of fields and their entries ; i.e. MAGGZ(1)=".5^38" Image File, field .5 data is 38 ; If Long Description is included in fields, we create a new ; array to hold the text, and pass that to UPDATE^DIE ; If this entry is an object group ; i.e. MAGGZ(n)="2005.04^344" ; (the field 2005.04 is the OBJECT GROUP MULTIPLE) ; ; MAGRY - Ret variable (Single Variable) ; ; Changed to include hierarchical directory hash - PMK 04/23/98 ; If successful MAGRY = IEN^FILE NAME (with full path) ; IEN is Internal Entry Number of ^MAG(2005 ; If UNsuccessful MAGRY = 0^Error desc ; ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK ; TO THE NEW FILE NAME RETURNED BY THIS CALL. ;---------------------------------------------------------------- N MAGGXE,MAGGFDA,MAGGIEN,MAGGDRV,MAGGR,MAGGRC,MAGGDA,MAGGFNM N MAGGWP,MAGGWPC,MAGGFLD,MAGGDAT,MAGERR,MAGGEXT,MAGGJB N MAGADD,MAGMOD,MAGWRITE,MAGREF,MAGDHASH,MAGDCMSN,MAGDCMIN N MAGBIG,MAGGABS,MAGQY,MAGRET,MAGETXT N MAGFSPEC,MAGFNM N I,J,X,Y,Z,ZZ ; N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" ; S MAGADD=1 ;Flag says we are adding an entry. S MAGRY="0^Starting Add Image Entry" S MAGERR="",MAGGR=0,MAGGRC=1,MAGGWPC=0 I ($D(MAGGZ)<10) S MAGRY="0^No input data, Operation CANCELED" Q ; S Z="" F S Z=$O(MAGGZ(Z)) Q:Z="" D I $L(MAGERR) Q . S MAGGFLD=$P(MAGGZ(Z),U,1),MAGGDAT=$P(MAGGZ(Z),U,2,99) . I MAGGFLD=""!(MAGGDAT="") S MAGRY="0^Field and Value are Required" Q . I MAGGFLD=5 S MAGGDAT=+MAGGDAT ; MOD RED 10/5/95 . I MAGGFLD=2005.04 S MAGGDAT=+MAGGDAT ; MOD RED 10/18/95 . I MAGGFLD="IEN" S MAGMOD=+MAGGDAT Q . I MAGGFLD="EXT" S MAGGEXT=MAGGDAT Q . I MAGGFLD="ABS" S MAGGABS=MAGGDAT Q . I MAGGFLD="JB" S MAGGJB=MAGGDAT Q . I MAGGFLD="WRITE" S MAGWRITE=MAGGDAT Q . I MAGGFLD="BIG" S MAGBIG=MAGGDAT Q . I MAGGFLD="DICOMSN" S MAGDCMSN=MAGGDAT Q . I MAGGFLD="DICOMIN" S MAGDCMIN=MAGGDAT Q . ; . ; if this is a group object. . I MAGGFLD=2005.04 D Q . . S MAGGR=1 . . I '+MAGGDAT Q ; making a group entry, with no group entries. . . S MAGGR(MAGGDAT)="" . . S MAGGRC=MAGGRC+1 . . I '$D(^MAG(2005,MAGGDAT,0)) S MAGERR="0^Group Object "_MAGGDAT_" doesn't exist" . . S MAGGFDA(2005.04,"+"_MAGGRC_",+1,",.01)=MAGGDAT . ; . ; if we are getting a WP for Long Desc, set array to pass. . I MAGGFLD=11 D ; this is a line of the WP Long Desc field. . . S MAGGWPC=MAGGWPC+1,MAGGWP(MAGGWPC)=MAGGDAT . ; . ;if a BAD field number . I '$$VFIELD^DILFD(2005,MAGGFLD) S MAGERR="0^Field Number "_MAGGFLD_" doesn't exist" Q . ; . ; Get Field Specifiers . D FIELD^DID(2005,MAGGFLD,"","LABEL;SPECIFIER","MAGFSPEC") . ; if a Date field, we'll convert it here. . I (MAGFSPEC("SPECIFIER")["D") D Q:$L(MAGERR) . . S %DT="T",X=MAGGDAT D ^%DT . . I Y=-1 S MAGERR="0^Invalid Date: "_MAGGDAT_" Field: "_MAGFSPEC("LABEL") Q . . S MAGGDAT=Y . ; . ; if a pointer field, we'll assure the pointed to entry exists. . I (MAGFSPEC("SPECIFIER")["P") D Q:$L(MAGERR) . . I ($$EXTERNAL^DILFD(2005,MAGGFLD,"",MAGGDAT)="") S MAGERR="0^Invalid Value for Field "_MAGFSPEC("LABEL") Q . ; . I (MAGFSPEC("SPECIFIER")["S") D Q:$L(MAGERR) . . D VAL^DIE(2005,"",MAGGFLD,"",MAGGDAT,.MAGRET,"","MAGETXT") I MAGRET="^" D Q . . . S MAGERR="0^"_MAGETXT("DIERR",1,"TEXT",1) . . ;P48T1 This assures we are filing the Internal code for a set. . . S MAGGDAT=MAGRET . ; . ; made it here, so set the Node for the UPDATE^DIC Call. . S MAGGFDA(2005,"+1,",MAGGFLD)=MAGGDAT ; ; if there was an Error in data we'll quit now. I $L(MAGERR) S MAGRY=MAGERR Q I $D(MAGMOD) D . I $D(MAGGWP) S MAGGFDA(2005,"+1,",11)="MAGGWP" . S MAGMOD=MAGMOD_"," . M MAGXXX(2005,MAGMOD)=MAGGFDA(2005,"+1,") K MAGGFDA . M MAGGFDA=MAGXXX K MAGXXX I $D(MAGMOD) D ADD^MAGGTIA1 Q ; ; some possible problems, we'll check for now. I '$D(MAGGFDA(2005,"+1,")) S MAGRY="0^No data to file Operation CANCELED " Q ; ; We're making Object Type and either Patient, or short Desc Required. I '$D(MAGGFDA(2005,"+1,",3)) S MAGRY="0^Need an Object Type " Q ; Change to require patient. not patient or short desc. I '$D(MAGGFDA(2005,"+1,",5)) D Q . S MAGRY="0^Need Patient. Operation CANCELED " ; MAGQA check. D QACHK^MAGGTIA2(.MAGQY,MAGGFDA(2005,"+1,",5),$G(MAGGFDA(2005,"+1,",16)),$G(MAGGFDA(2005,"+1,",17))) I 'MAGQY S MAGRY=MAGQY Q ;-Checking for a missing TYPE value, and generating a value if needed ;- are being deferred to a later patch. ; Check for Image TYPE #42 ;-I '$D(MAGGFDA(2005,"+1,",42)) D MAKETYPE^MAGGSIA1 I $L(MAGERR) S MAGRY=MAGERR Q ; Check for Image Class, #41 I '$D(MAGGFDA(2005,"+1,",41)) D MAKECLAS^MAGGSIU1 I $L(MAGERR) S MAGRY=MAGERR Q ; IF no Procedure text we'll give it some so crossref will set. I '$D(MAGGFDA(2005,"+1,",6)) S MAGGFDA(2005,"+1,",6)="NO TEXT" ; If no Procedure/Exam Date/Time we'll give it NOW I '$D(MAGGFDA(2005,"+1,",15)) S MAGGFDA(2005,"+1,",15)=$$NOW^XLFDT ; DateTime image saved. I '$D(MAGGFDA(2005,"+1,",7)) S MAGGFDA(2005,"+1,",7)=$$NOW^XLFDT ; If no INSTITUTION pointer then default to the DUZ(2) or the Kernel Site parameter file institution I '$D(MAGGFDA(2005,"+1,",.05)) D . I $D(DUZ(2)) S MAGGFDA(2005,"+1,",.05)=DUZ(2) Q . ;Q:$T(KSP^XUPARAM)="" //GEK 4/15/2004 Not needed on Gateway anymore . S MAGGFDA(2005,"+1,",.05)=$$KSP^XUPARAM("INST") . Q ; I '$D(MAGGFDA(2005,"+1,",10)) S MAGGFDA(2005,"+1,",10)=$$MAKENAME^MAGGTIA1() ; Only get drive:dir if not a group I 'MAGGR D I $L(MAGERR) S MAGRY=MAGERR Q . S X=$S($D(MAGGFDA(2005,"+1,",2)):MAGGFDA(2005,"+1,",2),1:"") . S Z=$$DRIVE^MAGGTU1(X) ;Drv:Dir to Write . I 'Z S MAGERR=Z Q . S MAGGDRV=$P(Z,U,2) . S MAGGFDA(2005,"+1,",2)=+Z ;Disk & Vol magnetic . ; if a big file is being made on workstation, put NetWork Location . ; pointer in the BIG NETWORK LOCATION field. . ; (BIG files default to same Network Location as FullRes (or PACS)) . I $G(MAGBIG)=1 S MAGGFDA(2005,"+1,",102)=+Z . S MAGREF=+Z ; save network location ien for $$DIRHASH in ^MAGGTIA1 . I $G(MAGGABS)="STUFFONLY" S MAGGFDA(2005,"+1,",2.1)=+Z ; ; If a Name (.01) wasn't sent, we'll make one ; We know that either Patient or Short Desc, and Object Type exist I '$D(MAGGFDA(2005,"+1,",.01)) S MAGGFDA(2005,"+1,",.01)=$$MAKENAME^MAGGTIA1() ; ; If a long description was sent. I $D(MAGGWP) S MAGGFDA(2005,"+1,",11)="MAGGWP" ; D ADD^MAGGTIA1 ; continued Q