Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIA.m
r613 r623 1 MAGGSIA ;WOIFO/GEK - Imaging RPC Broker calls. Add/Modify Image entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,21,8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 11 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 Q 20 ; 21 ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE 22 ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL. 23 ; 24 ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE] 25 ; Calls UPDATE^DIE to Add an Image File entry 26 ; Called from Import API Delphi component and ImportX (Active X) control. 27 ; Parameters : 28 ; MAGARRAY - array of field numbers and their entries 29 ; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38 30 ; If Long Description is included in array (field 11), we create a new 31 ; array to hold the text, and pass that to UPDATE^DIE 32 ; If this entry is an Image Group 33 ; i.e. MAGARRAY(n)="2005.04^344" 34 ; (the field 2005.04 is the OBJECT GROUP MULTIPLE) 35 ; ( 344 is the pointer to the Image File Entry that will be added 36 ; ( as a member of this new/existing Group) 37 ; 38 ; Return Variable 39 ; 40 ; MAGRY(0) - Array 41 ; Successful MAGRY(0) = IEN^FILE NAME (with full path) 42 ; UNsuccessful MAGRY(0) = 0^Error desc 43 ; MAGRY(0)(1..n) = Errors and warnings. 44 ; 45 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK 46 ; TO THE NEW FILE NAME RETURNED BY THIS CALL. 47 ; Changed to include hierarchical directory hash - PMK 04/23/98 48 ;---------------------------------------------------------------- 49 N MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM 50 N MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE 51 N GIEN,DIEN,NEWIEN ;3.0 52 N I,J,X,Y,Z,WPCT 53 ; 54 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGSERR" 55 I ($D(MAGARRAY)<10) S MAGRY(0)="0^No input data, Operation CANCELED" Q 56 ; 57 S MAGRY(0)="0^Creating VistA Image Entry..." 58 S MAGERR="",MAGGRP=0,GRPCT=1,WPCT=0 59 ; Validate the Data, and Action codes in the Input Array 60 D VAL^MAGGSIV(.MAGRY,.MAGARRAY) I 'MAGRY(0) Q 61 ; 62 ; Make the FileMan FDA array and the Imaging Action array. 63 D MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP) 64 I '$D(MAGGFDA(2005,"+1,")) S MAGRY(0)="0^No data to file. Operation CANCELED." Q 65 ; 66 ;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43))) 67 ; Check on some possible problems: required fields, create default values etc. 68 D PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF) I $L(MAGERR) S MAGRY(0)=MAGERR Q 69 ; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two. 70 S GIEN=$O(^MAG(2005," "),-1)+1 71 S DIEN=$O(^MAG(2005.1," "),-1)+1 72 S NEWIEN=$S(GIEN>DIEN:GIEN,1:DIEN) 73 LOCK L +^MAG(2005,NEWIEN):0 E S NEWIEN=NEWIEN+1 G LOCK ; lock it, or get next 74 I $D(^MAG(2005,NEWIEN)) L -^MAG(2005,NEWIEN) S NEWIEN=NEWIEN+1 G LOCK ; if it exists, get next 75 S MAGGIEN(1)=NEWIEN 76 D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE") 77 ; 78 ; ERROR: QUIT 79 I '$G(MAGGIEN(1)) D S MAGRY(0)=MAGERR Q 80 . S MAGERR="0^ERROR Creating new Image File Entry " 81 . I $D(DIERR) D RTRNERR^MAGGSIU1(.MAGERR) 82 . D CLEAN 83 ; 84 S MAGGDA=MAGGIEN(1) 85 ; 86 D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA) 87 ; 88 ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT 89 ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename 90 I MAGGRP D G C1 91 . D UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA) 92 . S MAGRY(0)=MAGGDA_U 93 . D CLEAN 94 . Q 95 ; ENTRY in Image File has been made, if any errors from here on 96 ; then we have to delete the image entry. 97 ; IF This image is a member of a Group, Update the Group Entry with new child. 98 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q 99 . D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA) 100 . I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN 101 ; 102 ; Now generate the Image FileName. This is passed back to the calling app, 103 ; and the calling app is responsible for renaming/copying the Image File to 104 ; this new name. 105 I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) 106 E D I $L(MAGERR) S MAGRY(0)=MAGERR Q 107 . N MAGXFDA 108 . S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGACT("EXT"))) I 'X D Q 109 . . S MAGERR=X 110 . . D KILLENT^MAGGSIU1(MAGGDA) 111 . . D CLEAN 112 . ; 113 . S MAGGFNM=$P(X,U,2),Y=MAGGDA_"," 114 . S MAGXFDA(2005,Y,1)=MAGGFNM 115 . D UPDATE^DIE("","MAGXFDA","","MAGGXE") 116 . ; in case of an error 117 . I $D(DIERR) D Q 118 . . D RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE) 119 . . D KILLENT^MAGGSIU1(MAGGDA) 120 . . D CLEAN 121 ; 122 C1 ; 59 123 K MAGGFDA ; P59. 124 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry 125 I '$D(^MAG(2005,MAGGDA,40)) D 126 . N INDXD 127 . D GENIEN^MAGXCVI(MAGGDA,.INDXD) 128 . D COMIEN^MAGXCVC(MAGGDA,.INDXD) 129 . S ^MAGIXCVT(2006.96,MAGGDA)=1 ; Flag. Says fields were converted by index generation 130 . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108) 131 . ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108)) 132 . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5)) 133 . Q 134 ; 135 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values. 136 I '$P(^MAG(2005,MAGGDA,40),"^",3) D 137 . N INDXD,OLD40,N40 138 . S (N40,OLD40)=^MAG(2005,MAGGDA,40) 139 . D GENIEN^MAGXCVI(MAGGDA,.INDXD) 140 . ; If Origin doesn't exist in existing, this will put V in. 141 . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V" 142 . ; We're not changing existing values of Spec,Proc or Origin 143 . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J) 144 . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc 145 . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5) 146 . S ^MAG(2005,MAGGDA,40)=N40 147 . ;;D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108)) 148 . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5)) 149 . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1) 150 . Q 151 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE. 152 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation 153 ; 154 ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG] 155 ; example: 487^C:\IMAGE\^DC000487.TIF 156 ; The calling routine is responsible for renaming/naming the file 157 ; to the returned DRIVE:\DIR\FILENAME.EXT 158 ; 159 ; Modified 4/23/98 to include hierarchical directory structure -- PMK 160 I 'MAGGRP D 161 . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 162 . ; For now, BIG files are in same directory as FullRes (or PACS) file 163 . S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 164 . ; If BIG file also, add it's Drive, Hash, Filename to end of Return string. 165 . I $G(MAGACT("BIG")) D 166 . . S X=$P(MAGGFNM,".",1)_".BIG" 167 . . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X 168 . . Q 169 . Q 170 ; 171 CLEAN ; Called as tag 172 D CLEAN^DILF 173 L -^MAG(2005,NEWIEN) 174 Q 1 MAGGSIA ;WOIFO/GEK - Imaging RPC Broker calls. Add/Modify Image entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,21,8**;Sep 15, 2004 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 ;; | | 11 ;; | The Food and Drug Administration classifies this software as | 12 ;; | a medical device. As such, it may not be changed in any way. | 13 ;; | Modifications to this software may result in an adulterated | 14 ;; | medical device under 21CFR820, the use of which is considered | 15 ;; | to be a violation of US Federal Statutes. | 16 ;; +---------------------------------------------------------------+ 17 ;; 18 Q 19 ; 20 ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE 21 ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL. 22 ; 23 ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE] 24 ; Calls UPDATE^DIE to Add an Image File entry 25 ; Called from Import API Delphi component and ImportX (Active X) control. 26 ; Parameters : 27 ; MAGARRAY - array of field numbers and their entries 28 ; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38 29 ; If Long Description is included in array (field 11), we create a new 30 ; array to hold the text, and pass that to UPDATE^DIE 31 ; If this entry is an Image Group 32 ; i.e. MAGARRAY(n)="2005.04^344" 33 ; (the field 2005.04 is the OBJECT GROUP MULTIPLE) 34 ; ( 344 is the pointer to the Image File Entry that will be added 35 ; ( as a member of this new/existing Group) 36 ; 37 ; Return Variable 38 ; 39 ; MAGRY(0) - Array 40 ; Successful MAGRY(0) = IEN^FILE NAME (with full path) 41 ; UNsuccessful MAGRY(0) = 0^Error desc 42 ; MAGRY(0)(1..n) = Errors and warnings. 43 ; 44 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK 45 ; TO THE NEW FILE NAME RETURNED BY THIS CALL. 46 ; Changed to include hierarchial directory hash - PMK 04/23/98 47 ;---------------------------------------------------------------- 48 N MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM 49 N MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE 50 N GIEN,DIEN,NEWIEN ;3.0 51 N I,J,X,Y,Z,WPCT 52 ; 53 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGSERR" 54 I ($D(MAGARRAY)<10) S MAGRY(0)="0^No input data, Operation CANCELED" Q 55 ; 56 S MAGRY(0)="0^Creating VistA Image Entry..." 57 S MAGERR="",MAGGRP=0,GRPCT=1,WPCT=0 58 ; Validate the Data, and Action codes in the Input Array 59 D VAL^MAGGSIV(.MAGRY,.MAGARRAY) I 'MAGRY(0) Q 60 ; 61 ; Make the FileMan FDA array and the Imaging Action array. 62 D MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP) 63 I '$D(MAGGFDA(2005,"+1,")) S MAGRY(0)="0^No data to file. Operation CANCELED." Q 64 ; 65 ; Check on some possible problems: required fields, create default values etc. 66 D PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF) I $L(MAGERR) S MAGRY(0)=MAGERR Q 67 ; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two. 68 S GIEN=$O(^MAG(2005," "),-1)+1 69 S DIEN=$O(^MAG(2005.1," "),-1)+1 70 S NEWIEN=$S(GIEN>DIEN:GIEN,1:DIEN) 71 LOCK L +^MAG(2005,NEWIEN):0 E S NEWIEN=NEWIEN+1 G LOCK ; lock it, or get next 72 I $D(^MAG(2005,NEWIEN)) L -^MAG(2005,NEWIEN) S NEWIEN=NEWIEN+1 G LOCK ; if it exists, get next 73 S MAGGIEN(1)=NEWIEN 74 D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE") 75 ; 76 ; ERROR: QUIT 77 I '$G(MAGGIEN(1)) D S MAGRY(0)=MAGERR Q 78 . S MAGERR="0^ERROR Creating new Image File Entry " 79 . I $D(DIERR) D RTRNERR^MAGGSIU1(.MAGERR) 80 . D CLEAN 81 ; 82 S MAGGDA=MAGGIEN(1) 83 ; 84 D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA) 85 ; 86 ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT 87 ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename 88 I MAGGRP D Q 89 . D UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA) 90 . S MAGRY(0)=MAGGDA_U 91 . D CLEAN 92 . Q 93 ; ENTRY in Image File has been made, if any errors from here on 94 ; then we have to delete the image entry. 95 ; New Index Field Check. If this entry doesn't have the Index fields introduced 96 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values. 97 ;-This is being deferred to a later patch. 98 ;-I '$D(^MAG(2005,MAGGDA,40)) D 99 ;-. D ONE^MAGSCNVI(MAGGDA) 100 ;-. D ACTION^MAGGTAU("DFTINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA) 101 ; 102 ; Now generate the Image FileName. This is passed back to the calling app, 103 ; and the calling app is responsible for renaming/copying the Image File to 104 ; this new name. 105 I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) 106 E D I $L(MAGERR) S MAGRY(0)=MAGERR Q 107 . N MAGXFDA 108 . S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGACT("EXT"))) I 'X D Q 109 . . S MAGERR=X 110 . . D KILLENT^MAGGSIU1(MAGGDA) 111 . . D CLEAN 112 . ; 113 . S MAGGFNM=$P(X,U,2),Y=MAGGDA_"," 114 . S MAGXFDA(2005,Y,1)=MAGGFNM 115 . D UPDATE^DIE("","MAGXFDA","","MAGGXE") 116 . ; in case of an error 117 . I $D(DIERR) D Q 118 . . D RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE) 119 . . D KILLENT^MAGGSIU1(MAGGDA) 120 . . D CLEAN 121 ; 122 ; 123 ; 124 ; IF This image is a member of a Group, Update the Group Entry with new child. 125 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q 126 . D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA) 127 . I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN 128 ; 129 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE. 130 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation 131 ; 132 ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG] 133 ; i.e 487^C:\IMAGE\^DC000487.TIF 134 ; The calling routine is responsible for renaming/naming the file 135 ; to the returned DRIVE:\DIR\FILENAME.EXT 136 ; 137 ; Modified 4/23/98 to include hierarchial directory structure -- PMK 138 S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 139 ; For now, BIG files are in same directory as FullRes (or PACS) file 140 S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 141 ; If BIG file also, add it's Drive, Hash, Filename to end of Return string. 142 I $G(MAGACT("BIG")) D 143 . S X=$P(MAGGFNM,".",1)_".BIG" 144 . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X 145 ; 146 CLEAN ; Called as tag 147 D CLEAN^DILF 148 L -^MAG(2005,NEWIEN) 149 Q
Note:
See TracChangeset
for help on using the changeset viewer.
