MAGDLB5 ;WOIFO/LB - XREF code for DICOM ; 02/17/2004 07:18
;;3.0;IMAGING;**11**;14-April-2004
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
MOVE ;Called from MAGDIR1 to move the failed entry into file 2006.575
;(Waiting for Peter's code to use FM instead of Direct sets.)
N CASECD,CNT,DA,DR,DIC,REASON,X,Y S CNT=0
I '$D(FROMPATH) W !,"FROMPATH is missing" Q
Q:'$D(FROMPATH) ;This variable should be around when called
S X=FROMPATH,DIC="^MAGD(2006.575," D FILE^DICN
I Y<1 W !,"Couldn't add an entry in file ^MAG(2006.575" Q
S REASON=$P(PIDCHECK,",",2)
S CASECD=$TR(CASECODE,"^","~")
S DA=+Y,DR="[MAGD-ENTRY]",DIE=DIC
ADD ;
L +^MAGD(2006.575,DA) I $T D ^DIE L -^MAGD(2006.575,DA) Q
S CNT=CNT+1 H 2 G:CNT<3 ADD ;HANG 2 SECS AND TRY TWICE
W !,"Couldn't update the MAGD(2006.575 file."
Q
REMOVE(ENTRY) ;Called to delete entry once processed.
N DA,DIK
Q:'$D(ENTRY)
I 'ENTRY W !,"ENTRY variable is missing" Q
Q:'$D(^MAGD(2006.575,ENTRY,0)) ;MISSING ENTRY
;I '$P($G(^MAGD(2006.575,ENTRY,"FIXD")),"^") W !,"Entry has not been corrected." Q
S DA=+ENTRY,DIK="^MAGD(2006.575," D ^DIK
Q
UPDT(ENTRY) ;Called to update entry.
Q:'$D(ENTRY)!'ENTRY
Q:'$D(^MAGD(2006.575,ENTRY,0))
N DIE,DR,DA,DIC,GWLOC,MACHID
S DIE="^MAGD(2006.575,",DR="[MAGD-UPDT]"
S DA=ENTRY
D ^DIE
I '$L(^MAGD(2006.575,ENTRY,"FIXD")) W !,"Entry not updated" Q
S MACHID=$P(^MAGD(2006.575,ENTRY,1),"^",4),GWLOC=$P(^(1),"^",5)
I GWLOC D Q
. S ^MAGD(2006.575,"AFX",GWLOC,MACHID,ENTRY)=""
. Q
E S ^MAGD(2006.575,"AFX",MACHID,ENTRY)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDLB5 2527 printed Dec 13, 2024@02:00:36 Page 2
MAGDLB5 ;WOIFO/LB - XREF code for DICOM ; 02/17/2004 07:18
+1 ;;3.0;IMAGING;**11**;14-April-2004
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
MOVE ;Called from MAGDIR1 to move the failed entry into file 2006.575
+1 ;(Waiting for Peter's code to use FM instead of Direct sets.)
+2 NEW CASECD,CNT,DA,DR,DIC,REASON,X,Y
SET CNT=0
+3 IF '$DATA(FROMPATH)
WRITE !,"FROMPATH is missing"
QUIT
+4 ;This variable should be around when called
if '$DATA(FROMPATH)
QUIT
+5 SET X=FROMPATH
SET DIC="^MAGD(2006.575,"
DO FILE^DICN
+6 IF Y<1
WRITE !,"Couldn't add an entry in file ^MAG(2006.575"
QUIT
+7 SET REASON=$PIECE(PIDCHECK,",",2)
+8 SET CASECD=$TRANSLATE(CASECODE,"^","~")
+9 SET DA=+Y
SET DR="[MAGD-ENTRY]"
SET DIE=DIC
ADD ;
+1 LOCK +^MAGD(2006.575,DA)
IF $TEST
DO ^DIE
LOCK -^MAGD(2006.575,DA)
QUIT
+2 ;HANG 2 SECS AND TRY TWICE
SET CNT=CNT+1
HANG 2
if CNT<3
GOTO ADD
+3 WRITE !,"Couldn't update the MAGD(2006.575 file."
+4 QUIT
REMOVE(ENTRY) ;Called to delete entry once processed.
+1 NEW DA,DIK
+2 if '$DATA(ENTRY)
QUIT
+3 IF 'ENTRY
WRITE !,"ENTRY variable is missing"
QUIT
+4 ;MISSING ENTRY
if '$DATA(^MAGD(2006.575,ENTRY,0))
QUIT
+5 ;I '$P($G(^MAGD(2006.575,ENTRY,"FIXD")),"^") W !,"Entry has not been corrected." Q
+6 SET DA=+ENTRY
SET DIK="^MAGD(2006.575,"
DO ^DIK
+7 QUIT
UPDT(ENTRY) ;Called to update entry.
+1 if '$DATA(ENTRY)!'ENTRY
QUIT
+2 if '$DATA(^MAGD(2006.575,ENTRY,0))
QUIT
+3 NEW DIE,DR,DA,DIC,GWLOC,MACHID
+4 SET DIE="^MAGD(2006.575,"
SET DR="[MAGD-UPDT]"
+5 SET DA=ENTRY
+6 DO ^DIE
+7 IF '$LENGTH(^MAGD(2006.575,ENTRY,"FIXD"))
WRITE !,"Entry not updated"
QUIT
+8 SET MACHID=$PIECE(^MAGD(2006.575,ENTRY,1),"^",4)
SET GWLOC=$PIECE(^(1),"^",5)
+9 IF GWLOC
Begin DoDot:1
+10 SET ^MAGD(2006.575,"AFX",GWLOC,MACHID,ENTRY)=""
+11 QUIT
End DoDot:1
QUIT
+12 IF '$TEST
SET ^MAGD(2006.575,"AFX",MACHID,ENTRY)=""
+13 QUIT
