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

MAGDOD01.m

Go to the documentation of this file. 
  1. MAGDOD01 ;WOIFO/EdM - VistA DOD Exchange Utilities ; 29 Apr 2008 10:56 AM
  1.  ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
  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.  ;
  1. STOREUID(OUT,IMAGE,SERIES,SNUM,INUM,IMGUID,STUID,DOCDAT) ; RPC = MAG STORE TEXT FILE DETAILS
  1.  N D0,D1,FM,I,IMG,LI,LS,X,XI,XS
  1.  I '$$KEY() S OUT="-13,No permission to call this Remote Procedure" Q
  1.  S FM=""
  1.  I '$G(IMAGE) S OUT="-5,No valid image number specified." Q
  1.  D CHK^MAGGSQI(.X,IMAGE) I +$G(X(0))'=1 D  Q
  1.  . S OUT=IMAGE_"-14,Questionable Integrity"
  1.  . Q
  1.  K X
  1.  S:$G(^MAG(2005,IMAGE,0))'="" FM=2005
  1.  S:$G(^MAG(2005.1,IMAGE,0))'="" FM=2005.1
  1.  I FM="" S OUT="-1,No such image """_IMAGE_"""." Q
  1.  S OUT=-13,(D0,D1)=0,(IMG,LS,LI,XS,XI)=""
  1.  D:$TR($G(SNUM)_$G(INUM),0)'=""
  1.  . S D0=+$P(^MAG(FM,IMAGE,0),"^",10) Q:'D0
  1.  . S I=0 F  S I=$O(^MAG(FM,D0,1,I)) Q:'I  D  Q:D1
  1.  . . S X=$G(^MAG(FM,D0,1,I,0)) Q:+X'=IMAGE
  1.  . . S D1=I,IMG=$P(X,"^",1),(LS,XS)=$P(X,"^",2),(LI,XI)=$P(X,"^",3)
  1.  . . Q
  1.  . S:'D0 OUT=OUT_", image is not part of series ("_SNUM_"/"_INUM_")"
  1.  . S:'D1 OUT=OUT_", image is not in series "_D0_" ("_SNUM_"/"_INUM_")"
  1.  . Q
  1.  D:$G(SERIES)'=""
  1.  . S X=$G(^MAG(FM,IMAGE,"SERIESUID")) Q:X=SERIES
  1.  . I X'="" S OUT=OUT_", cannot enter Series Instance UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New:     "_SERIES Q
  1.  . S ^MAG(FM,IMAGE,"SERIESUID")=SERIES
  1.  . S ^MAG(FM,"SERIESUID",SERIES,IMAGE)=""
  1.  . Q
  1.  D:$G(SNUM)'=""
  1.  . Q:LS=SNUM
  1.  . I LS'="" S OUT=OUT_", cannot enter Series Number """_LS_"""'="""_SNUM_"""." Q
  1.  . S $P(^MAG(FM,D0,1,D1,0),"^",2)=SNUM
  1.  . I IMG'="",LS'="",LI'="" K ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
  1.  . S XS=SNUM
  1.  . Q
  1.  D:$G(INUM)'=""
  1.  . Q:LI=INUM
  1.  . I LI'="" S OUT=OUT_", cannot enter Instance Number"""_LI_"""'="""_INUM_"""." Q
  1.  . S $P(^MAG(FM,D0,1,D1,0),"^",3)=INUM
  1.  . I IMG'="",LS'="",LI'="" K ^MAG(FM,D0,1,"ADCM",LS,LI,IMG,D1)
  1.  . S XI=INUM
  1.  . Q
  1.  I IMG'="",XS'="",XI'="" S ^MAG(FM,D0,1,"ADCM",XS,XI,IMG,D1)=""
  1.  D:$G(IMGUID)'=""
  1.  . S X=$P($G(^MAG(FM,IMAGE,"PACS")),"^",1)
  1.  . Q:X=IMGUID
  1.  . I X'="",X'=IMGUID S OUT=OUT_", cannot enter Instance UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New:     "_IMGUID Q
  1.  . S $P(^MAG(FM,IMAGE,"PACS"),"^",1)=IMGUID
  1.  . S ^MAG(FM,"P",IMGUID,IMAGE)=""
  1.  . Q
  1.  D:$G(STUID)'=""
  1.  . N PARENT
  1.  . S PARENT=$P($G(^MAG(FM,IMAGE,0)),"^",10)
  1.  . I 'PARENT S OUT=OUT_", cannot find parent for image "_IMAGE Q
  1.  . S X=$P($G(^MAG(FM,PARENT,"PACS")),"^",1)
  1.  . Q:X=STUID
  1.  . I X'="",X'=STUID S OUT=OUT_", cannot enter Study UID"_$C(13,10)_"Current: "_X_$C(13,10)_"New:     "_STUID Q
  1.  . S $P(^MAG(FM,PARENT,"PACS"),"^",1)=STUID
  1.  . S ^MAG(FM,"P",STUID,PARENT)=""
  1.  . Q
  1.  D:$G(DOCDAT)'=""  ;//110 CREATION DATE
  1.  . N PARENT,CHILD
  1.  . S PARENT=+$P($G(^MAG(FM,IMAGE,0)),"^",10) D:PARENT
  1.  . . I $P($G(^MAG(FM,PARENT,100)),"^",6)="" D
  1.  . . . S CHILD=$O(^MAG(FM,PARENT,1,0)) Q:'CHILD
  1.  . . . S X=$G(^MAG(FM,PARENT,1,CHILD,0)) Q:+X'=IMAGE
  1.  . . . S $P(^MAG(FM,PARENT,100),"^",6)=DOCDAT  ;set parent
  1.  . . . Q
  1.  . . Q
  1.  . S X=$P($G(^MAG(FM,IMAGE,100)),"^",6)
  1.  . Q:X=DOCDAT
  1.  . I X'="",X'=DOCDAT S OUT=OUT_", cannot enter Document Date"_$C(13,10)_"Current: "_X_$C(13,10)_"New:     "_DOCDAT Q
  1.  . S $P(^MAG(FM,IMAGE,100),"^",6)=DOCDAT  ;set child
  1.  . Q
  1.  S:OUT=-13 OUT="0,OK"
  1.  Q
  1.  ;
  1. SCANIMG(OUT,ACTION,IMAGE,DIR) ; RPC = MAG SCAN IMAGE TEXT FILES
  1.  N F1,F2,F3,X
  1.  I '$$KEY() S OUT="-13,No permission to call this Remote Procedure" Q
  1.  S ACTION=$G(ACTION)
  1.  I ACTION="Init" D  Q
  1.  . S X=$G(^MAGDICOM(2006.563,1,"SCAN")) S:X="" X=" ^-1"
  1.  . S OUT=X
  1.  . Q
  1.  I ACTION="Restart" D  Q
  1.  . S (^MAGDICOM(2006.563,1,"SCAN"),OUT)=" ^-1"
  1.  . Q
  1.  I ACTION="Scan" D  Q
  1.  . S DIR=$S($G(DIR)<0:-1,1:1)
  1.  . S IMAGE=+$G(IMAGE) I 'IMAGE,DIR<0 S IMAGE=" "
  1.  . S ^MAGDICOM(2006.563,1,"SCAN")=IMAGE_"^"_DIR
  1.  . S IMAGE=$O(^MAG(2005,IMAGE),DIR)
  1.  . I 'IMAGE S OUT="-1,Done" Q
  1.  . D FILEFIND^MAGDFB(IMAGE,"TEXT",0,0,.F1,.F2,.F3)
  1.  . S OUT=IMAGE_","_F2_","_$$NEARFMT^MAGUF(IMAGE)
  1.  . Q
  1.  S OUT="-13,Cannot perform requested action: """_ACTION_"""."
  1.  Q
  1.  ;
  1. FINDFIL(OUT,IMAGE) ; RPC = MAG FIND IMAGE TEXT FILE
  1.  N F1,F2,F3,IEN
  1.  N FM ; ------- file on which the image record exists (2005 or 2005.1)
  1.  N IM0 ; ------ zero node of this image record (not parent)
  1.  N CANUPD ; --- flag indicating that there are fields to be updated on the record
  1.  N PDLIM ; ---- primary delimiter
  1.  S PDLIM="|"
  1.  I '$$KEY() S $P(OUT,PDLIM,2)="-12,No permission to call this Remote Procedure" Q
  1.  I IMAGE="" S $P(OUT,PDLIM,2)="-21,Image file name must be specified" Q
  1.  I IMAGE?.E1C.E S $P(OUT,PDLIM,2)="-22,Invalid filename format (no control characters allowed)" Q
  1.  S FM=2005,IEN=$O(^MAG(FM,"F",IMAGE,"")) ; scan active image records
  1.  I 'IEN S FM=2005.1,IEN=$O(^MAG(FM,"F",IMAGE,""))
  1.  I 'IEN S $P(OUT,PDLIM,2)="-23,Image filename not found on VistA" Q
  1.  D FILEFIND^MAGDFB(IEN,"TEXT",0,0,.F1,.F2,.F3)
  1.  S OUT=IEN_PDLIM_F2_PDLIM_$$NEARFMT^MAGUF(IEN)
  1.  S IM0=$G(^MAG(FM,IEN,0))
  1.  ; check for dupes and integrity problems
  1.  S:$P(IM0,"^",12) $P(OUT,PDLIM,4)="D" ; dupe
  1.  S:$P(IM0,"^",11) $P(OUT,PDLIM,5)="IQ" ; integrity
  1.  ; can this record be updated?
  1.  S CANUPD=0 ; assume all updatable fields are populated, so not
  1.  D  ; check to see if there are any updatable fields
  1.  . N PARENT ; --- parent record of the study of which this image is a member
  1.  . D  Q:CANUPD  ; check Series Instance UID
  1.  . . I $P($G(^MAG(FM,IEN,"SERIESUID")),"^",1)="" S CANUPD=1
  1.  . . Q
  1.  . D  Q:CANUPD  ; check Image Instance UID
  1.  . . I $P($G(^MAG(FM,IEN,"PACS")),"^",1)="" S CANUPD=1
  1.  . . Q
  1.  . S PARENT=$P($G(^MAG(FM,IEN,0)),"^",10)
  1.  . D:PARENT  ; check attributes of parent study
  1.  . . D  Q:CANUPD  ; check Study Instance UID
  1.  . . . I $P($G(^MAG(FM,PARENT,"PACS")),"^",1)="" S CANUPD=1
  1.  . . . Q
  1.  . . D  Q:CANUPD  ; check Document Date
  1.  . . . I $P($G(^MAG(FM,PARENT,100)),"^",6)="" S CANUPD=1
  1.  . . . Q
  1.  . . D  Q:CANUPD  ; check DICOM series and image number
  1.  . . . N CHILD ; ---- what child this image is of the parent
  1.  . . . N I ; -------- scratch loop index
  1.  . . . S CHILD=0
  1.  . . . F  S CHILD=$O(^MAG(FM,PARENT,1,CHILD)) Q:'CHILD  I $P($G(^(CHILD,0)),"^",1)=IEN Q
  1.  . . . Q:'CHILD  ; image not found in study
  1.  . . . F I=2,3 I $P($G(^MAG(FM,PARENT,1,CHILD,0)),"^",I)="" S CANUPD=1 Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  S $P(OUT,PDLIM,6)=CANUPD
  1.  Q
  1. KEY() N KEY,PRIV
  1.  S KEY(1)="MAG DOD FIX"
  1.  D OWNSKEY^XUSRB(.PRIV,.KEY)
  1.  Q PRIV(1)
  1.  ;