source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDLB5.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1MAGDLB5 ;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
19MOVE ;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
29ADD ;
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
34REMOVE(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
42UPDT(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
Note: See TracBrowser for help on using the repository browser.