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

MAGDLBAA.m

Go to the documentation of this file.
  1. MAGDLBAA ;WOIFO/LB/JSL/SAF - Routine to move failed dicom images to ^MAG(2006.575 ; 05/18/2007 11:23
  1. ;;3.0;IMAGING;**11,51,54,53,123**;Mar 19, 2002;Build 67;Jul 24, 2012
  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. MOVE ;called from MAGDIR1 to move entries not matching Radiology case #.
  1. ;Not done thru FM because the system should be independent.
  1. ;These variable are needed to be defined before using this routine:
  1. ;PIDCHECK, FIRSTDCM, IMGSVC, MIDCM, MACHID,ACNUMB, CASENUMB, PNAMEDCM, PID
  1. ;MODALITY, CASETEXT
  1. N DATE,REASON,ENTRY,IEN,NIEN,ORIG,DCMPNME,CASE,CASENUM,PATIENT,RESULT
  1. S DATE=$$NOW^XLFDT()\1,RESULT=0
  1. ;
  1. ; if the entry already exists in file 2006.575, skip it
  1. S MACHID=$G(MACHID,"A")
  1. I $$EXIST(.RESULT,FROMPATH,MACHID,LOCATION) D Q
  1. . D REMOAFX(.RESULT,MACHID,LOCATION,STUDYUID)
  1. . Q
  1. ;
  1. ;ADD ENTRY
  1. L +^MAGD(2006.575,0):1E9 ; Background process MUST wait
  1. S X=$G(^MAGD(2006.575,0))
  1. S $P(X,"^",1,2)="DICOM FAILED IMAGES^2006.575"
  1. S IEN=$O(^MAGD(2006.575," "),-1)+1,$P(X,"^",3)=IEN
  1. S $P(X,"^",4)=$P(X,"^",4)+1 ; # entries
  1. S ^MAGD(2006.575,0)=X
  1. ;
  1. S REASON=$P(PIDCHECK,",",2)
  1. S PATIENT=LASTDCM_","_FIRSTDCM_$S($L(MIDCM)>0:" "_MIDCM,1:"")
  1. ; PNAMEDCM usually contains an "^" between last & first name
  1. ; CHANGE ^ TO ~
  1. S CASE=$TR(ACNUMB,"^","~"),CASENUM=$TR(CASENUMB,"^","~")
  1. S DCMPNME=$TR(PNAMEDCM,"^","~")
  1. S ^MAGD(2006.575,IEN,0)=FROMPATH_"^"_REASON_"^"_PID_"^"_PATIENT_"^"_DCMPNME
  1. S ^MAGD(2006.575,IEN,1)=CASE_"^"_CASENUM_"^"_DATE_"^"_MACHID_"^"_LOCATION
  1. S ^MAGD(2006.575,IEN,"AIUID")=$G(IMAGEUID)
  1. S ^MAGD(2006.575,IEN,"ASUID")=STUDYUID
  1. ;MOD for IHS multiple Chart ID (i.e. Chawktaw)
  1. S ^MAGD(2006.575,IEN,"AMFG")=$G(INSTNAME)_"^"_$G(ROWS)_"^"_$G(COLUMNS)_"^"_$G(OFFSET)_"^"_$G(MODIEN)_"^"_$G(MODALITY)_"^"_$$UP^MAGDFCNV($G(MFGR))_"^"_$$UP^MAGDFCNV($G(MODEL))_"^"_INSTLOC ;P123
  1. S ^MAGD(2006.575,IEN,"ACSTXT")=$G(CASETEXT)
  1. ; Image type can be RAD, MEDICINE, SURGERY, etc.
  1. S ^MAGD(2006.575,IEN,"TYPE")=$G(IMGSVC)
  1. ;Setting xrefs
  1. S ^MAGD(2006.575,"B",FROMPATH,IEN)=""
  1. ; Clean up---no longer need this cross reference
  1. K ^MAGD(2006.575,"D") ; Used for Consults only
  1. L -^MAGD(2006.575,0)
  1. ;
  1. ;The following xref ("F") will be set on the 1st entry having a unique
  1. ;STUDYUID. The remaining entries with the same # will be added
  1. ;to the RELATED IMAGES multiple field for the entry that set the
  1. ;F xref.
  1. S ORIG=0
  1. I '$D(^MAGD(2006.575,"F",LOCATION,STUDYUID)) D Q ; Quit if 1st entry
  1. . S ^MAGD(2006.575,"F",LOCATION,STUDYUID,IEN)=""
  1. . Q
  1. S ORIG=$O(^MAGD(2006.575,"F",LOCATION,STUDYUID,0))
  1. Q:'ORIG
  1. I ORIG'=IEN D
  1. . I '$D(^MAGD(2006.575,ORIG,"RLATE",0)) D
  1. . . S ^MAGD(2006.575,ORIG,"RLATE",0)="^2006.57526PA^^"
  1. . S NIEN=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3),NIEN=NIEN+1
  1. . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3)=NIEN ; #next ien entry
  1. . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)+1 ; #record for multiple field
  1. . S ^MAGD(2006.575,ORIG,"RLATE",NIEN,0)=IEN
  1. . S ^MAGD(2006.575,ORIG,"RLATE","B",IEN,NIEN)=""
  1. . Q
  1. Q
  1. ;
  1. EXIST(RESULT,PATH,MACHINE,SITE) ; if it exist don't add it.
  1. N IEN,NODE1
  1. S RESULT=0
  1. I $D(^MAGD(2006.575,"B",PATH)) D
  1. . S IEN=$O(^MAGD(2006.575,"B",PATH,"")) I 'IEN S RESULT=0 Q
  1. . I '$D(^MAGD(2006.575,+IEN)) S RESULT=0 Q
  1. . S NODE1=$G(^MAGD(2006.575,IEN,1))
  1. . I $P(NODE1,"^",4)'=MACHINE S RESULT=0 Q
  1. . I $P(NODE1,"^",5)'=SITE S RESULT=0 Q
  1. . S RESULT=IEN
  1. . Q
  1. Q RESULT
  1. REMOAFX(IEN,MACHINE,SITE,STUDY) ; Remove AFX cross reference.
  1. N PENTRY
  1. ;IEN is the result of the call to line tag EXIST.
  1. ; The AFX cross reference governs what needs processing.
  1. I $D(^MAGD(2006.575,"AFX",SITE,MACHINE,IEN)) D Q
  1. . S $P(^MAGD(2006.575,IEN,"FIXD"),"^")=0
  1. . K ^MAGD(2006.575,"AFX",SITE,MACHINE,IEN)
  1. . Q
  1. ;may be a child entry check the 'F' cross reference to find the parent.
  1. S PENTRY=$O(^MAGD(2006.575,"F",SITE,STUDY,0))
  1. Q:'$D(^MAGD(2006.575,+PENTRY,0))
  1. ;is it a child entry check the multiple 'b' cross reference
  1. I $D(^MAGD(2006.575,PENTRY,"RELATE",0)),$D(^MAGD(2006.575,PENTRY,"B",IEN)) D
  1. . I $D(^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY)) D
  1. . . K ^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY)
  1. . . S $P(^MAGD(2006.575,PENTRY,"FIXD"),"^")=0
  1. . . Q
  1. Q