| [613] | 1 | MAGDLB5 ;WOIFO/LB - XREF code for DICOM ; 02/17/2004  07:18
 | 
|---|
 | 2 |  ;;3.0;IMAGING;**11**;14-April-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 | MOVE ;Called from MAGDIR1 to move the failed entry into file 2006.575
 | 
|---|
 | 20 |  ;(Waiting for Peter's code to use FM instead of Direct sets.)
 | 
|---|
 | 21 |  N CASECD,CNT,DA,DR,DIC,REASON,X,Y S CNT=0
 | 
|---|
 | 22 |  I '$D(FROMPATH) W !,"FROMPATH is missing" Q
 | 
|---|
 | 23 |  Q:'$D(FROMPATH)     ;This variable should be around when called
 | 
|---|
 | 24 |  S X=FROMPATH,DIC="^MAGD(2006.575," D FILE^DICN
 | 
|---|
 | 25 |  I Y<1 W !,"Couldn't add an entry in file ^MAG(2006.575" Q
 | 
|---|
 | 26 |  S REASON=$P(PIDCHECK,",",2)
 | 
|---|
 | 27 |  S CASECD=$TR(CASECODE,"^","~")
 | 
|---|
 | 28 |  S DA=+Y,DR="[MAGD-ENTRY]",DIE=DIC
 | 
|---|
 | 29 | ADD ;
 | 
|---|
 | 30 |  L +^MAGD(2006.575,DA) I $T D ^DIE L -^MAGD(2006.575,DA) Q
 | 
|---|
 | 31 |  S CNT=CNT+1 H 2 G:CNT<3 ADD   ;HANG 2 SECS AND TRY TWICE
 | 
|---|
 | 32 |  W !,"Couldn't update the MAGD(2006.575 file."
 | 
|---|
 | 33 |  Q
 | 
|---|
 | 34 | REMOVE(ENTRY) ;Called to delete entry once processed.
 | 
|---|
 | 35 |  N DA,DIK
 | 
|---|
 | 36 |  Q:'$D(ENTRY)
 | 
|---|
 | 37 |  I 'ENTRY W !,"ENTRY variable is missing" Q
 | 
|---|
 | 38 |  Q:'$D(^MAGD(2006.575,ENTRY,0))     ;MISSING ENTRY
 | 
|---|
 | 39 |  ;I '$P($G(^MAGD(2006.575,ENTRY,"FIXD")),"^") W !,"Entry has not been corrected." Q
 | 
|---|
 | 40 |  S DA=+ENTRY,DIK="^MAGD(2006.575," D ^DIK
 | 
|---|
 | 41 |  Q
 | 
|---|
 | 42 | UPDT(ENTRY) ;Called to update entry.
 | 
|---|
 | 43 |  Q:'$D(ENTRY)!'ENTRY
 | 
|---|
 | 44 |  Q:'$D(^MAGD(2006.575,ENTRY,0))
 | 
|---|
 | 45 |  N DIE,DR,DA,DIC,GWLOC,MACHID
 | 
|---|
 | 46 |  S DIE="^MAGD(2006.575,",DR="[MAGD-UPDT]"
 | 
|---|
 | 47 |  S DA=ENTRY
 | 
|---|
 | 48 |  D ^DIE
 | 
|---|
 | 49 |  I '$L(^MAGD(2006.575,ENTRY,"FIXD")) W !,"Entry not updated" Q
 | 
|---|
 | 50 |  S MACHID=$P(^MAGD(2006.575,ENTRY,1),"^",4),GWLOC=$P(^(1),"^",5)
 | 
|---|
 | 51 |  I GWLOC D  Q
 | 
|---|
 | 52 |  . S ^MAGD(2006.575,"AFX",GWLOC,MACHID,ENTRY)=""
 | 
|---|
 | 53 |  . Q
 | 
|---|
 | 54 |  E  S ^MAGD(2006.575,"AFX",MACHID,ENTRY)=""
 | 
|---|
 | 55 |  Q
 | 
|---|