- MAGDLBAA ;WOIFO/LB/JSL/SAF - Routine to move failed dicom images to ^MAG(2006.575 ; 05/18/2007 11:23
- ;;3.0;IMAGING;**11,51,54,53,123**;Mar 19, 2002;Build 67;Jul 24, 2012
- ;; Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | 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 entries not matching Radiology case #.
- ;Not done thru FM because the system should be independent.
- ;These variable are needed to be defined before using this routine:
- ;PIDCHECK, FIRSTDCM, IMGSVC, MIDCM, MACHID,ACNUMB, CASENUMB, PNAMEDCM, PID
- ;MODALITY, CASETEXT
- N DATE,REASON,ENTRY,IEN,NIEN,ORIG,DCMPNME,CASE,CASENUM,PATIENT,RESULT
- S DATE=$$NOW^XLFDT()\1,RESULT=0
- ;
- ; if the entry already exists in file 2006.575, skip it
- S MACHID=$G(MACHID,"A")
- I $$EXIST(.RESULT,FROMPATH,MACHID,LOCATION) D Q
- . D REMOAFX(.RESULT,MACHID,LOCATION,STUDYUID)
- . Q
- ;
- ;ADD ENTRY
- L +^MAGD(2006.575,0):1E9 ; Background process MUST wait
- S X=$G(^MAGD(2006.575,0))
- S $P(X,"^",1,2)="DICOM FAILED IMAGES^2006.575"
- S IEN=$O(^MAGD(2006.575," "),-1)+1,$P(X,"^",3)=IEN
- S $P(X,"^",4)=$P(X,"^",4)+1 ; # entries
- S ^MAGD(2006.575,0)=X
- ;
- S REASON=$P(PIDCHECK,",",2)
- S PATIENT=LASTDCM_","_FIRSTDCM_$S($L(MIDCM)>0:" "_MIDCM,1:"")
- ; PNAMEDCM usually contains an "^" between last & first name
- ; CHANGE ^ TO ~
- S CASE=$TR(ACNUMB,"^","~"),CASENUM=$TR(CASENUMB,"^","~")
- S DCMPNME=$TR(PNAMEDCM,"^","~")
- S ^MAGD(2006.575,IEN,0)=FROMPATH_"^"_REASON_"^"_PID_"^"_PATIENT_"^"_DCMPNME
- S ^MAGD(2006.575,IEN,1)=CASE_"^"_CASENUM_"^"_DATE_"^"_MACHID_"^"_LOCATION
- S ^MAGD(2006.575,IEN,"AIUID")=$G(IMAGEUID)
- S ^MAGD(2006.575,IEN,"ASUID")=STUDYUID
- ;MOD for IHS multiple Chart ID (i.e. Chawktaw)
- 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
- S ^MAGD(2006.575,IEN,"ACSTXT")=$G(CASETEXT)
- ; Image type can be RAD, MEDICINE, SURGERY, etc.
- S ^MAGD(2006.575,IEN,"TYPE")=$G(IMGSVC)
- ;Setting xrefs
- S ^MAGD(2006.575,"B",FROMPATH,IEN)=""
- ; Clean up---no longer need this cross reference
- K ^MAGD(2006.575,"D") ; Used for Consults only
- L -^MAGD(2006.575,0)
- ;
- ;The following xref ("F") will be set on the 1st entry having a unique
- ;STUDYUID. The remaining entries with the same # will be added
- ;to the RELATED IMAGES multiple field for the entry that set the
- ;F xref.
- S ORIG=0
- I '$D(^MAGD(2006.575,"F",LOCATION,STUDYUID)) D Q ; Quit if 1st entry
- . S ^MAGD(2006.575,"F",LOCATION,STUDYUID,IEN)=""
- . Q
- S ORIG=$O(^MAGD(2006.575,"F",LOCATION,STUDYUID,0))
- Q:'ORIG
- I ORIG'=IEN D
- . I '$D(^MAGD(2006.575,ORIG,"RLATE",0)) D
- . . S ^MAGD(2006.575,ORIG,"RLATE",0)="^2006.57526PA^^"
- . S NIEN=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3),NIEN=NIEN+1
- . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",3)=NIEN ; #next ien entry
- . S $P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)=$P(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)+1 ; #record for multiple field
- . S ^MAGD(2006.575,ORIG,"RLATE",NIEN,0)=IEN
- . S ^MAGD(2006.575,ORIG,"RLATE","B",IEN,NIEN)=""
- . Q
- Q
- ;
- EXIST(RESULT,PATH,MACHINE,SITE) ; if it exist don't add it.
- N IEN,NODE1
- S RESULT=0
- I $D(^MAGD(2006.575,"B",PATH)) D
- . S IEN=$O(^MAGD(2006.575,"B",PATH,"")) I 'IEN S RESULT=0 Q
- . I '$D(^MAGD(2006.575,+IEN)) S RESULT=0 Q
- . S NODE1=$G(^MAGD(2006.575,IEN,1))
- . I $P(NODE1,"^",4)'=MACHINE S RESULT=0 Q
- . I $P(NODE1,"^",5)'=SITE S RESULT=0 Q
- . S RESULT=IEN
- . Q
- Q RESULT
- REMOAFX(IEN,MACHINE,SITE,STUDY) ; Remove AFX cross reference.
- N PENTRY
- ;IEN is the result of the call to line tag EXIST.
- ; The AFX cross reference governs what needs processing.
- I $D(^MAGD(2006.575,"AFX",SITE,MACHINE,IEN)) D Q
- . S $P(^MAGD(2006.575,IEN,"FIXD"),"^")=0
- . K ^MAGD(2006.575,"AFX",SITE,MACHINE,IEN)
- . Q
- ;may be a child entry check the 'F' cross reference to find the parent.
- S PENTRY=$O(^MAGD(2006.575,"F",SITE,STUDY,0))
- Q:'$D(^MAGD(2006.575,+PENTRY,0))
- ;is it a child entry check the multiple 'b' cross reference
- I $D(^MAGD(2006.575,PENTRY,"RELATE",0)),$D(^MAGD(2006.575,PENTRY,"B",IEN)) D
- . I $D(^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY)) D
- . . K ^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY)
- . . S $P(^MAGD(2006.575,PENTRY,"FIXD"),"^")=0
- . . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDLBAA 5210 printed Feb 18, 2025@23:27:07 Page 2
- 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
- +2 ;; Per VHA Directive 2004-038, this routine should not be modified.
- +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 ;; | 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 entries not matching Radiology case #.
- +1 ;Not done thru FM because the system should be independent.
- +2 ;These variable are needed to be defined before using this routine:
- +3 ;PIDCHECK, FIRSTDCM, IMGSVC, MIDCM, MACHID,ACNUMB, CASENUMB, PNAMEDCM, PID
- +4 ;MODALITY, CASETEXT
- +5 NEW DATE,REASON,ENTRY,IEN,NIEN,ORIG,DCMPNME,CASE,CASENUM,PATIENT,RESULT
- +6 SET DATE=$$NOW^XLFDT()\1
- SET RESULT=0
- +7 ;
- +8 ; if the entry already exists in file 2006.575, skip it
- +9 SET MACHID=$GET(MACHID,"A")
- +10 IF $$EXIST(.RESULT,FROMPATH,MACHID,LOCATION)
- Begin DoDot:1
- +11 DO REMOAFX(.RESULT,MACHID,LOCATION,STUDYUID)
- +12 QUIT
- End DoDot:1
- QUIT
- +13 ;
- +14 ;ADD ENTRY
- +15 ; Background process MUST wait
- LOCK +^MAGD(2006.575,0):1E9
- +16 SET X=$GET(^MAGD(2006.575,0))
- +17 SET $PIECE(X,"^",1,2)="DICOM FAILED IMAGES^2006.575"
- +18 SET IEN=$ORDER(^MAGD(2006.575," "),-1)+1
- SET $PIECE(X,"^",3)=IEN
- +19 ; # entries
- SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
- +20 SET ^MAGD(2006.575,0)=X
- +21 ;
- +22 SET REASON=$PIECE(PIDCHECK,",",2)
- +23 SET PATIENT=LASTDCM_","_FIRSTDCM_$SELECT($LENGTH(MIDCM)>0:" "_MIDCM,1:"")
- +24 ; PNAMEDCM usually contains an "^" between last & first name
- +25 ; CHANGE ^ TO ~
- +26 SET CASE=$TRANSLATE(ACNUMB,"^","~")
- SET CASENUM=$TRANSLATE(CASENUMB,"^","~")
- +27 SET DCMPNME=$TRANSLATE(PNAMEDCM,"^","~")
- +28 SET ^MAGD(2006.575,IEN,0)=FROMPATH_"^"_REASON_"^"_PID_"^"_PATIENT_"^"_DCMPNME
- +29 SET ^MAGD(2006.575,IEN,1)=CASE_"^"_CASENUM_"^"_DATE_"^"_MACHID_"^"_LOCATION
- +30 SET ^MAGD(2006.575,IEN,"AIUID")=$GET(IMAGEUID)
- +31 SET ^MAGD(2006.575,IEN,"ASUID")=STUDYUID
- +32 ;MOD for IHS multiple Chart ID (i.e. Chawktaw)
- +33 ;P123
- SET ^MAGD(2006.575,IEN,"AMFG")=$GET(INSTNAME)_"^"_$GET(ROWS)_"^"_$GET(COLUMNS)_"^"_$GET(OFFSET)_"^"_$GET(MODIEN)_"^"_$GET(MODALITY)_"^"_$$UP^MAGDFCNV($GET(MFGR))_"^"_$$UP^MAGDFCNV($GET(MODEL))_"^"_INSTLOC
- +34 SET ^MAGD(2006.575,IEN,"ACSTXT")=$GET(CASETEXT)
- +35 ; Image type can be RAD, MEDICINE, SURGERY, etc.
- +36 SET ^MAGD(2006.575,IEN,"TYPE")=$GET(IMGSVC)
- +37 ;Setting xrefs
- +38 SET ^MAGD(2006.575,"B",FROMPATH,IEN)=""
- +39 ; Clean up---no longer need this cross reference
- +40 ; Used for Consults only
- KILL ^MAGD(2006.575,"D")
- +41 LOCK -^MAGD(2006.575,0)
- +42 ;
- +43 ;The following xref ("F") will be set on the 1st entry having a unique
- +44 ;STUDYUID. The remaining entries with the same # will be added
- +45 ;to the RELATED IMAGES multiple field for the entry that set the
- +46 ;F xref.
- +47 SET ORIG=0
- +48 ; Quit if 1st entry
- IF '$DATA(^MAGD(2006.575,"F",LOCATION,STUDYUID))
- Begin DoDot:1
- +49 SET ^MAGD(2006.575,"F",LOCATION,STUDYUID,IEN)=""
- +50 QUIT
- End DoDot:1
- QUIT
- +51 SET ORIG=$ORDER(^MAGD(2006.575,"F",LOCATION,STUDYUID,0))
- +52 if 'ORIG
- QUIT
- +53 IF ORIG'=IEN
- Begin DoDot:1
- +54 IF '$DATA(^MAGD(2006.575,ORIG,"RLATE",0))
- Begin DoDot:2
- +55 SET ^MAGD(2006.575,ORIG,"RLATE",0)="^2006.57526PA^^"
- End DoDot:2
- +56 SET NIEN=$PIECE(^MAGD(2006.575,ORIG,"RLATE",0),"^",3)
- SET NIEN=NIEN+1
- +57 ; #next ien entry
- SET $PIECE(^MAGD(2006.575,ORIG,"RLATE",0),"^",3)=NIEN
- +58 ; #record for multiple field
- SET $PIECE(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)=$PIECE(^MAGD(2006.575,ORIG,"RLATE",0),"^",4)+1
- +59 SET ^MAGD(2006.575,ORIG,"RLATE",NIEN,0)=IEN
- +60 SET ^MAGD(2006.575,ORIG,"RLATE","B",IEN,NIEN)=""
- +61 QUIT
- End DoDot:1
- +62 QUIT
- +63 ;
- EXIST(RESULT,PATH,MACHINE,SITE) ; if it exist don't add it.
- +1 NEW IEN,NODE1
- +2 SET RESULT=0
- +3 IF $DATA(^MAGD(2006.575,"B",PATH))
- Begin DoDot:1
- +4 SET IEN=$ORDER(^MAGD(2006.575,"B",PATH,""))
- IF 'IEN
- SET RESULT=0
- QUIT
- +5 IF '$DATA(^MAGD(2006.575,+IEN))
- SET RESULT=0
- QUIT
- +6 SET NODE1=$GET(^MAGD(2006.575,IEN,1))
- +7 IF $PIECE(NODE1,"^",4)'=MACHINE
- SET RESULT=0
- QUIT
- +8 IF $PIECE(NODE1,"^",5)'=SITE
- SET RESULT=0
- QUIT
- +9 SET RESULT=IEN
- +10 QUIT
- End DoDot:1
- +11 QUIT RESULT
- REMOAFX(IEN,MACHINE,SITE,STUDY) ; Remove AFX cross reference.
- +1 NEW PENTRY
- +2 ;IEN is the result of the call to line tag EXIST.
- +3 ; The AFX cross reference governs what needs processing.
- +4 IF $DATA(^MAGD(2006.575,"AFX",SITE,MACHINE,IEN))
- Begin DoDot:1
- +5 SET $PIECE(^MAGD(2006.575,IEN,"FIXD"),"^")=0
- +6 KILL ^MAGD(2006.575,"AFX",SITE,MACHINE,IEN)
- +7 QUIT
- End DoDot:1
- QUIT
- +8 ;may be a child entry check the 'F' cross reference to find the parent.
- +9 SET PENTRY=$ORDER(^MAGD(2006.575,"F",SITE,STUDY,0))
- +10 if '$DATA(^MAGD(2006.575,+PENTRY,0))
- QUIT
- +11 ;is it a child entry check the multiple 'b' cross reference
- +12 IF $DATA(^MAGD(2006.575,PENTRY,"RELATE",0))
- IF $DATA(^MAGD(2006.575,PENTRY,"B",IEN))
- Begin DoDot:1
- +13 IF $DATA(^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY))
- Begin DoDot:2
- +14 KILL ^MAGD(2006.575,"AFX",SITE,MACHINE,PENTRY)
- +15 SET $PIECE(^MAGD(2006.575,PENTRY,"FIXD"),"^")=0
- +16 QUIT
- End DoDot:2
- End DoDot:1
- +17 QUIT