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

MAGDLB1.m

Go to the documentation of this file. 
  1. MAGDLB1 ;WOIFO/LB/JSL/SAF/NST/DAC/MLH - Routine to fix failed DICOM entries ; 11 Apr 2012 1:09 PM
  1.  ;;3.0;IMAGING;**11,30,54,123,118**;Mar 19, 2002;Build 4525;May 01, 2013
  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.  ;
  1. DISPLAY ;
  1.  S OUT=0
  1.  W !,"**************Processing entry**********"
  1.  W !!?2,"PATIENT: ",PAT,?50,$$PIDLABEL^MAGSPID(),": ",PID,!,"RADIOLOGY CASE #: ",CASENO  ;;P123
  1.  W !?2,"Equipment: ",MOD,?50,"Model: ",MODEL
  1.  W !?2,"Date Processed: ",DATE,?50,"Problem with: ",REASON
  1.  W !?2,"Comment: ",COMNT1
  1.  W !?2,"Correcting file on Image gateway server ID: ",MACHID,!?5,FILE
  1.  S MSG="Do you want to Correct this entry? "
  1.  Q
  1.  ;
  1. NEWCASE ;
  1.  S NEWDFN=$P(MAGDY,"^"),NEWNME=$P(MAGDY,"^",2),NEWPID=$P(MAGDY,"^",3)
  1.  S NEWCAS=$P(MAGDY,"^",4),NEWPROC=$P(MAGDY,"^",5),NEWDTI=$P(MAGDY,"^",6)
  1.  S NEWMUL=$P(MAGDY,"^",7),NEWPIEN=$P(MAGDY,"^",8),PP=$P(MAGDY,"^",9)
  1.  Q
  1.  ;
  1. ASK() ;
  1.  N ANS,ASK
  1.  ;
  1. ASK1 S ASK="Y/N/D/Q"
  1.  I $G(PREV)'=$G(MAGIEN),MAGTYPE="RAD" S ASK=ASK_"/P"
  1.  W !,$G(MSG),"("_ASK_")// " R ANS:600
  1.  I '$T!(ANS["^") Q "^"
  1.  I ANS="" Q "N"
  1.  I "YNDPQyndpq"'[$E(ANS) D  G ASK1
  1.  . W !,"Please respond with one of the following codes."
  1.  . W !,"Legend: Y=yes, N=no, D=delete, P=Previous entry, and Q=quit",!
  1.  S ANS=$TR(ANS,"yndpq","YNDPQ")
  1.  Q $E(ANS)
  1.  ;
  1. CHK ;remove any punctuation before doing comparison on SSN
  1.  ;stop on 1st check.
  1.  N OLD,I
  1.  S OLD="" F I=1:1:$L(PID) I $E(PID,I)?1AN S OLD=OLD_$E(PID,I)
  1.  I NEWPID'=OLD D  Q
  1.  . I $$ISIHS^MAGSPID() S MSG="Patient ID numbers do not match. Update? " Q  ;P123
  1.  . S MSG="Social Security numbers do not match. Update? "
  1.  I NEWNME'=PAT D  Q
  1.  . S MSG="Patient names do not match. Update? "
  1.  ;Finally the problem is with the case number...either no longer in "C"
  1.  ;xref or invalid number provided
  1.  S MSG="Radiology case number different. Update? "
  1.  Q
  1.  ;
  1. NEWDIS ;
  1.  W !?2,"****Please review the following: *****"
  1.  W !?2,"Previous name: ",PAT,!?2,"     New name: ",NEWNME
  1.  W !?2,"Previous ",$$PIDLABEL^MAGSPID(),": ",PID,!?2,"     New ",$$PIDLABEL^MAGSPID(),": ",NEWPID  ;P123
  1.  W !?2,"Previous case #: ",CASENO,!?2,"     New case #: ",NEWCAS
  1.  I $L($G(PP)) W !?15,"Case number selected: ",PP
  1.  ; Variable PP already has text message about being part of printset.
  1.  Q
  1.  ;
  1. UPDT ;
  1.  N GWLOC ; -- gateway location
  1.  N % ; ------ utility variable for FM calls
  1.  W !,"Will change the following: " D NEWDIS
  1.  W !,"Are you sure you want to correct this entry? " S %=2 D YN^DICN
  1.  I %=-1!(%=2) S OUT=1 Q
  1.  W !,"Updating the file."
  1.  S NEWDTIM=$TR(NEWDTI,"0123456789","9876543210")
  1.  S ^MAGD(2006.575,MAGIEN,"FIXD")="1^"_NEWDFN_"^"_NEWNME_"^"_NEWPID_"^"_NEWCAS_"^"_NEWDTI_"^"_NEWMUL_"^"_NEWDTIM W "."
  1.  S ^MAGD(2006.575,MAGIEN,"FIXPR")=NEWPIEN_"^"_NEWPROC W "."
  1.  ;Same as ^radpt(newdfn,"DT",newdti,"P",newmul,0) & ^RAMIS(71,newpien,0)
  1.  S MACHID=$S(MACHID="":"A",1:MACHID) ; server ID
  1.  S GWLOC=$P($G(^MAGD(2006.575,MAGIEN,1)),"^",5)
  1.  I GWLOC S ^MAGD(2006.575,"AFX",GWLOC,MACHID,MAGIEN)="" W "."
  1.  E  W !,"Gateway place not defined on image entry "_MAGIEN_", continuing.."
  1.  ;Xref to loop & process entries; processing will be minimal.
  1.  S MAGFIX(MAGIEN)="F"
  1.  Q
  1.  ;
  1. SETDEL ;Entry to be deleted
  1.  N GWLOC ; -- gateway location
  1.  D LOGERR I ANS="^" S OUT=1 Q
  1.  S GWLOC=$P($G(^MAGD(2006.575,MAGIEN,1)),"^",5)
  1.  I GWLOC S ^MAGD(2006.575,"AFX",GWLOC,MACHID,MAGIEN)="D" W "."
  1.  E  W !,"Gateway place not defined on this image entry "_MAGIEN_", continuing.."
  1.  S $P(^MAGD(2006.575,MAGIEN,0),"^",6)="1"
  1.  S ^MAGD(2006.575,MAGIEN,"FIXD")=1
  1.  S MAGFIX(MAGIEN)="D"
  1.  Q
  1.  ;
  1. LOGERR ;Need to record error
  1.  N DIR,DIRUT,DTOUT,ENTRY,I,MAGERR,MAGOUT,NOW,WHY,WHO,X,Y
  1.  W !! F I=1:1:80 W "*"
  1.  W !,"*** Will log in error log (file 2006.599). ****"
  1.  S NOW=$$NOW^XLFDT()
  1.  S DIR(0)="F^3:30"
  1.  S DIR("A")="Reason for deletion"
  1.  S DIR("A",1)="Please enter a reason for deleting."
  1.  S DIR("A",2)="For example: TEST PATIENT"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DTOUT))!(Y="") D  S ANS="^" Q
  1.  . W !,"Cannot delete if a reason is not provided."
  1.  . Q
  1.  S WHY=Y,WHO=$G(DUZ)
  1.  I WHO D 
  1.  . D GETS^DIQ(200,DUZ,".01","E","MAGOUT","MAGERR")
  1.  . Q:$D(MAGERR("DIERR"))
  1.  . S WHO=$G(MAGOUT(200,DUZ_",",.01,"E"))
  1.  I WHO="" S WHO="UNKNOWN"
  1.  I '$D(^MAGD(2006.599,0)) D
  1.  . S ^MAGD(2006.599,0)="Dicom Error Log^2006.599^^"
  1.  . Q
  1.  S ENTRY=$P(^MAGD(2006.599,0),"^",3)+1
  1.  S $P(^MAGD(2006.599,0),"^",3)=ENTRY
  1.  S $P(^MAGD(2006.599,0),"^",4)=$P(^MAGD(2006.599,0),"^",4)+1
  1.  S ^MAGD(2006.599,ENTRY,0)=NOW_"^"_WHY_"^"_FILE_"^"_MODEL
  1.  S ^MAGD(2006.599,ENTRY,1)=WHO_"^"_PAT_"^"_PID_"^"_CASENO_"^"_MACHID
  1.  S ^MAGD(2006.599,"B",NOW,ENTRY)=""
  1.  Q
  1.  ;
  1. SET ;
  1.  S MAGTYPE=$P(^MAGD(2006.575,MAGIEN,"TYPE"),"^")
  1.  Q:$P($G(^MAGD(2006.575,MAGIEN,"FIXD")),"^")  ; Already fixed.
  1.  ; Only process Radiology images...medicine images done by other rtns.
  1.  I MAGTYPE'["RAD" Q
  1.  S DATA=^MAGD(2006.575,MAGIEN,0)
  1.  S FILE=$P(^MAGD(2006.575,MAGIEN,0),"^")
  1.  S DATA1=^MAGD(2006.575,MAGIEN,1) ; Case no. info
  1.  S DATA2=$G(^MAGD(2006.575,MAGIEN,"AMFG")) ; Modality info
  1.  S PAT=$P(DATA,"^",4),PID=$P(DATA,"^",3),REASON=$P(DATA,"^",2)
  1.  S MOD=$P(DATA2,"^"),MODEL=$P(DATA2,"^",6)
  1.  S CASENO=$P(DATA1,"^",2),MACHID=$P(DATA1,"^",4)
  1.  S Y=$P(DATA1,"^",3) X ^DD("DD") S DATE=Y
  1.  S COMNT1=$G(^MAGD(2006.575,MAGIEN,"ACSTXT")) ; 1st line comment.
  1.  S MACHID=$P(DATA1,"^",4),GWLOC=$P(DATA2,"^",9)
  1.  S ANS="" D DISPLAY S ANS=$$ASK
  1.  I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 D SETPREV Q
  1.  I ANS="N" S OUT=1 D SETPREV Q
  1.  I ANS="P" D CHKPREV Q
  1.  I ANS="D" D SETDEL,SETPREV Q
  1.  Q:OUT
  1.  K MAGDY W !," Lookup by case number or patient name"
  1.  ;
  1.  ; Fall Through intended
  1. LOOK ;
  1.  ;D ^MAGDLB2 Q:'$D(MAGDY)  Q:MAGDY'[""
  1.  D EN^MAGDRA2 Q:'$D(MAGDY)  Q:MAGDY'[""
  1.  D NEWCASE,CHK,NEWDIS S ANS=$$ASK
  1.  I ANS="Q"!(ANS["^") S (OOUT,OUT)=1 D SETPREV Q
  1.  I ANS="D" D SETDEL,SETPREV Q
  1.  I ANS="P" D CHKPREV Q
  1.  I ANS="N" S OUT=1 D SETPREV Q
  1.  Q:OUT
  1.  D UPDT
  1.  I ANS="P" D CHKPREV Q
  1.  D SETMAG
  1.  Q
  1.  ;
  1. DATELOOP(START,STOP) ;Loop thru the "AD" cross reference
  1.  N MAGIEN,SUID,THEDT,FIRST,OOUT,MAGFIX,MDV
  1.  S KFIXALL=$$SECKEY^MAGDLB12
  1.  S THEDT=START-.1,(OOUT,FIRST)=0
  1.  F  S THEDT=$O(^MAGD(2006.575,"AD",THEDT)) Q:'THEDT!(THEDT>STOP)!(OOUT)  D
  1.  . S MAGIEN=0
  1.  . F  S MAGIEN=$O(^MAGD(2006.575,"AD",THEDT,MAGIEN)) Q:'MAGIEN  D
  1.  . . I '$D(^MAGD(2006.575,MAGIEN,0)) D  Q
  1.  . . . K ^MAGD(2006.575,"AD",THEDT,MAGIEN)
  1.  . . . Q
  1.  . . I $P($G(^MAGD(2006.575,MAGIEN,"TYPE")),U,1)'["RAD" Q
  1.  . . ; No security key, or gateway site other than this site
  1.  . . I 'KFIXALL,$P($G(^MAGD(2006.575,MAGIEN,1)),U,5)'=$G(DUZ(2)) Q
  1.  . . I 'FIRST S PREV=MAGIEN,FIRST=1
  1.  . . D SET
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. SETPREV ;
  1.  S PREV=MAGIEN,PREVS=$G(SUID)
  1.  Q
  1.  ;
  1. SETMAG ;
  1.  S FIRST=MAGIEN,FIRSTS=$G(SUID),MAGIEN=PREV,SUID=$G(PREVS)
  1.  S PREV=FIRST,PREVS=FIRSTS
  1.  Q
  1.  ;
  1. CHKPREV ;
  1.  S OUT=1 N STATUS
  1.  I '$D(MAGFIX(PREV)) D SETMAG G SET
  1.  S STATUS=$S($G(MAGFIX(PREV))="D":"deleted",1:"corrected")
  1.  W !,"Previous entry has been "_STATUS_".",$C(7)
  1.  G SET
  1.  Q
  1.  ;
  1. NAME(ENTRY) ;SITE NAME
  1.  N NAME,MAGOUT,MAGERR
  1.  I '$G(ENTRY) Q ""
  1.  D GETS^DIQ(4,ENTRY,".01","E","MAGOUT","MAGERR")
  1.  I $D(MAGERR("DIERR")) Q ""
  1.  S NAME=$G(MAGOUT(4,ENTRY_",",.01,"E"))
  1.  Q NAME
  1.  ;