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

MAGGTUX.m

Go to the documentation of this file. 
  1. MAGGTUX ;WIOFO/GEK/SG - Imaging utility to validate INDEX values. ; 2/5/09 1:58pm
  1.  ;;3.0;IMAGING;**59,93**;Dec 02, 2009;Build 163
  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.  ;; |                                                               |
  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. CHECK ; Check the entries, NO DATABASE changes.
  1.  D 1(0,"MAGGTUXC")
  1.  Q
  1. FIX ; Fix/Check INDEX values in Image File entries. 
  1.  D 1(1,"MAGGTUX")
  1.  Q
  1. 1(COMMIT,MAGN) ; Start here.
  1.  I '$D(DUZ) W !,"DUZ is undefined.   Quitting." Q
  1.  N DESC,ANS,ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK ; -- TaskMan variables
  1.  I 'COMMIT W !,"   **** Just Checking entries, no DataBase changes will occur. ****",!
  1.  W !,"Validate Image Index Terms:"
  1.  W !,"  The Image File is searched for invalid or missing index values."
  1.  W !,"  The Image Index Generate and Commit functions are used"
  1.  W !,"  to fix the incorrect Index values."
  1.  W !
  1.  W !,"For a summary of the index values that will be changed."
  1.  W !,"  use the menu option:   CHK  -  Check Image File for missing Index values"
  1.  W !," "
  1.  W !,"To Fix the invalid index values in the Image File (#2005)."
  1.  W !,"  use the menu option:   FIX  -  Fix missing Index values in Image File"
  1.  W !
  1.  I 'COMMIT W !,"   **** Just Checking entries, No DataBase changes will occur. ****",!
  1.  E  W !,"   **** Fixing invalid entries,  DataBase changes Will occur. ****",!
  1.  D TASKMAN^MAGXCVP(.ANS)
  1.  I "^"=ANS W !,"Canceled. " Q
  1.  S ZTSK=0 I ANS="" D START(COMMIT,MAGN,0) Q
  1.  S ZTRTN="TASK^MAGGTUX"
  1.  S DESC=$S(COMMIT:"FIX INVALID INDEX VALUES",1:"CHECK FOR INVALID INDEX VALUES")
  1.  S ZTDESC=DESC
  1.  S ZTDTH=ANS,ZTIO=""
  1.  S ZTSAVE("COMMIT")=COMMIT,ZTSAVE("MAGN")=MAGN,ZTSAVE("QUEUED")=1
  1.  D ^%ZTLOAD
  1.  W !,DESC_" Has been Queued as task# : "_ZTSK
  1.  Q
  1. TASK ;
  1.  D START(COMMIT,MAGN,QUEUED)
  1.  Q
  1. START(COMMIT,MAGN,QUEUED) ;Start here.
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
  1.  L +MAGTMP("VALIDATE INDEX TERMS"):0 E  D  Q
  1.  . I 'QUEUED W !,"Image Index Validate process is currently running.  Try later." Q
  1.  . S XMSUB="Image Index Validate wasn't started"
  1.  . S ^TMP($J,"MAGQ",1)="You attempted to Task the Index Validate process, but the"
  1.  . S ^TMP($J,"MAGQ",2)="Image Validate process is currently running.  Please try later."
  1.  . D MAILSHR^MAGQBUT1
  1.  . Q
  1.  N DOT,N0,N40,OL40,N2,MDFN,IXT,IXP,IXS,IXO,ST,ET,NORG,ISGRP,X,J,RADCT,RADCR,CDT,IEN,INDXD
  1.  N PKG,SD,TIM,TITLE,TIUDA,TTLDA,MRY,LNT,LNI,X1,STTIME,ENDTIME,ELSP,%H,%
  1.  N GRINT,NI,NOPAT,NOZ,INVG,CRCT,INVO,GRINI,NT,CT,CTALL,STOP,LN,GO1,GO0,ORG,OFX,NOMERG,OKMERG,FIX
  1.  S (GRINT,NI,NOPAT,NOZ,INVG,CRCT,INVO,GRINI,NT,CT,CTALL,STOP,LN,GO1,GO0,ORG,OFX,NOMERG,OKMERG,FIX)=0
  1.  ; Write 200 lines to screen.
  1.  S DOT=$P(($P(^MAG(2005,0),"^",4)/200),".",1)
  1.  S IEN="A"
  1.  ; if it was started and stopped, continue.
  1.  ; ^XTMP("MAGGTUX,0)=PurgeDate^CreateDate^LastIENChecked^HighestIENChecked^NumberChecked^Description
  1.  ; 
  1.  I $D(^XTMP(MAGN,0)) D INIT^MAGGTUX2
  1.  S STTIME=$$NOW^XLFDT
  1.  I 'QUEUED D  I STOP G END
  1.  . I 'COMMIT W !!,"Just Checking Index Terms, NO CHANGES to database. (Q to quit)"
  1.  . E  W !!,"Invalid entries will be fixed.  Database will be modified (Q to quit)"
  1.  . W !!,"   Press 'Q' at any time to QUIT.  It can be resumed later.",!
  1.  . W !,"Ready to Start   Y/N    N// " R X:30
  1.  . I "Nn"[X W !!,"Canceled." S STOP=1 Q
  1.  . W !,"Starting at "_$$FMTE^XLFDT(STTIME)
  1.  . Q
  1.  ;  Start.....
  1.  ;  Set XTMP Dates
  1.  I IEN="A" K ^XTMP(MAGN) S $P(^XTMP(MAGN,0),"^",4)=$O(^MAG(2005,IEN),-1) ; Keep the Highest IEN checked.
  1.  S X1=DT,X2=14 D C^%DTC S $P(^XTMP(MAGN,0),"^",1,2)=X_"^"_$$NOW^XLFDT
  1.  S $P(^XTMP(MAGN,0),"^",6)="Fix Invalid Index Nodes"
  1.  ; Set variables to check the CR - CT problem.
  1.  S RADCR=+$O(^MAG(2005.85,"B","COMPUTED RADIOGRAPHY",""))
  1.  S RADCT=+$O(^MAG(2005.85,"B","COMPUTED TOMOGRAPHY",""))
  1.  ;
  1.  D PRHDR
  1.  S ST=$P($H,",",2) ; Start Time
  1.  S TIM=$P(^MAG(2005,0),"^",4) ; Total Images
  1.  F  S IEN=$O(^MAG(2005,IEN),-1) Q:IEN=0  D  I STOP Q  ;G END
  1.  . R X:0 I X="Q" D  Q
  1.  . . S STOP=1
  1.  . . I 'QUEUED W ! D MES^XPDUTL(" Function interrupted. ")
  1.  . . Q
  1.  . S CTALL=CTALL+1
  1.  . Q:$$ISDEL^MAGGI11(IEN)
  1.  . S ISGRP=0
  1.  . S N0=$G(^MAG(2005,IEN,0))
  1.  . S N2=$G(^MAG(2005,IEN,2))
  1.  . S N40=$G(^MAG(2005,IEN,40))
  1.  . S MDFN=+$P(N0,"^",7)
  1.  . S IXT=$P(N40,"^",3),IXS=$P(N40,"^",5),IXP=$P(N40,"^",4),IXO=$P(N40,"^",6)
  1.  . S CT=CT+1
  1.  . I (CT=1)!(CT#DOT=0)!($O(^MAG(2005,IEN),-1)=0) D PRLINE
  1.  . ; Count NO Patient, No Zero Node
  1.  . I 'MDFN S NOPAT=NOPAT+1 Q
  1.  . I N0="" S NOZ=NOZ+1 Q
  1.  . ; Count Groups of 1, No change.
  1.  . I $P(N0,"^",6)=11 S ISGRP=1 I $P($G(^MAG(2005,IEN,1,0)),"^",4)=1 S GO1=GO1+1
  1.  . I ISGRP I $O(^MAG(2005,IEN,1,0))="" S GO0=GO0+1 Q
  1.  . ;
  1.  . ;  Chk ORIGIN (fld #45) had 'VA' not 'V'.
  1.  . I '("VNFD"[$P(N40,"^",6)) D CHK45^MAGGTUX2(.N40,IEN)
  1.  . ;
  1.  . ; Was a CR, CT mismapping, this will fix it.
  1.  . I RADCR=IXP D CHKCR^MAGGTUX2(.N40,IEN)
  1.  . ; 
  1.  . ; Validate the Proc/Event <-> Spec/SubSpec dependency
  1.  . ; Check TYPE is Clinical, All are Active.
  1.  . I IXT D VALIND^MAGGTUX2 Q  ;If image has TYPE, Check then Quit.
  1.  . ;
  1.  . ; Counting problems
  1.  . ; If no index values.
  1.  . I N40="" D
  1.  . . I $P(N0,"^",10) S GRINI=GRINI+1 ; GRoupImageNoIndex
  1.  . . E  S NI=NI+1 ; NoIndex
  1.  . . S LNI=IEN_"-"_$P(N2,"^",1)
  1.  . . Q
  1.  . ;
  1.  . ; If this case follows the Majority of invalid 40 Nodes
  1.  . ; i.e. PKG^^^^^V  PKG^^^^^VA then Kill and ReGenerate later
  1.  . I (N40'="") D
  1.  . . I $P(N0,"^",10) S GRINT=GRINT+1 ; Group Image with No Type
  1.  . . E  S NT=NT+1  ; NoType :  group or single
  1.  . . S ^XTMP(MAGN,"AAN40",N40)=$G(^XTMP(MAGN,"AAN40",N40))+1
  1.  . . S ^XTMP(MAGN,"AAN40",N40,"IEN")=IEN
  1.  . . S LNT=IEN_"-"_$P(N2,"^",1)
  1.  . . ; if 40 node is just default PKG and ORIGIN,  we kill and regenerate.
  1.  . . ; Don't kill N40 if Origin is F,D or N
  1.  . . I N40?.A1"^^^^^".E I "V"[$P(N40,"^",6) S N40=""
  1.  . . Q
  1.  . ;
  1.  . ; Use Patch 31 Utils to Generate Index values
  1.  . I N40="" D  Q
  1.  . . I COMMIT D
  1.  . . . ; GENERATE AND COMMIT INDEX VALUES.
  1.  . . . D GENIEN^MAGXCVI(IEN,.INDXD)
  1.  . . . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
  1.  . . . S ^MAG(2005,IEN,40)=INDXD
  1.  . . . S ^MAGIXCVT(2006.96,IEN)=2 ; status = 2 ( generate by Patch 59) 
  1.  . . . S FIX=FIX+1
  1.  . . . D ENTRY^MAGLOG("INDEX-ALL",DUZ,IEN,"TUX59",MDFN,1)
  1.  . . . Q
  1.  . . Q
  1.  . ;  40 node is missing TYPE
  1.  . ;   - has Spec and/or Proc 
  1.  . ;   - or Origin is not V.
  1.  . ; Compare old to new, only set missing pieces, (don't overwrite)
  1.  . ; If the merged 40 node doesn't pass VAL59G,
  1.  . ; Then revert to old Spec and Proc but keep Generated Type.
  1.  . ; 
  1.  . D GENIEN^MAGXCVI(IEN,.INDXD)
  1.  . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
  1.  . S OL40=N40
  1.  . ; We're not changing existing values of Spec,Proc or Origin 
  1.  . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
  1.  . ;  Validate the merged Spec and Proc dependency, may be invalid.
  1.  . D VALMERG^MAGGTUX2(OL40,.N40) ; 
  1.  . I '$D(^XTMP(MAGN,"AAN40",OL40,"CVT",INDXD)) S ^XTMP(MAGN,"AAN40",OL40,"CVT",INDXD)=N40
  1.  . I COMMIT D
  1.  . . S ^MAG(2005,IEN,40)=N40
  1.  . . S FIX=FIX+1
  1.  . . S ^MAGIXCVT(2006.96,IEN)=2 ; 2 is set of codes - converted by Patch 59 
  1.  . . D ENTRY^MAGLOG("INDEX-42",DUZ,IEN,"TUX59",MDFN,1)
  1.  . . Q
  1.  . Q
  1.  S ENDTIME=$$NOW^XLFDT
  1.  S %H=$P($H,",")_","_($P($H,",",2)-ST) D YMD^%DTC
  1.  S ELSP=$P($$FMTE^XLFDT(X_%),"@",2)
  1.  S ^XTMP(MAGN,0,"END")=$$FMTE^XLFDT(ENDTIME)_"^"_ELSP
  1.  S $P(^XTMP(MAGN,0),"^",3)=IEN ; last IEN Checked.
  1.  S $P(^XTMP(MAGN,0),"^",5)=$P(^XTMP(MAGN,0),"^",5)+CT
  1.  ;
  1.  S ^XTMP(MAGN,"AATCHK")=$G(^XTMP(MAGN,"AATCHK"))+CT
  1.  S ^XTMP(MAGN,"AANT")=NT
  1.  S ^XTMP(MAGN,"AANI")=NI
  1.  S ^XTMP(MAGN,"AAGRINT")=GRINT
  1.  S ^XTMP(MAGN,"AAGRINI")=GRINI
  1.  S ^XTMP(MAGN,"AAGO1")=GO1
  1.  S ^XTMP(MAGN,"AAGO0")=GO0
  1.  S ^XTMP(MAGN,"AAOFX")=OFX
  1.  S ^XTMP(MAGN,"AAINVG")=INVG
  1.  S ^XTMP(MAGN,"AAINVO")=INVO
  1.  S ^XTMP(MAGN,"AANOMERG")=NOMERG
  1.  S ^XTMP(MAGN,"AAOKMERG")=OKMERG
  1.  S ^XTMP(MAGN,"AACRCT")=CRCT
  1.  S ^XTMP(MAGN,"AAN40","no index")=GRINI+NI
  1.  S ^XTMP(MAGN,"AANOPAT")=NOPAT
  1.  S ^XTMP(MAGN,"AANOZ")=NOZ
  1.  S ^XTMP(MAGN,0,"NT")=$G(LNT)
  1.  S ^XTMP(MAGN,0,"NI")=$G(LNI)
  1.  I FIX S ^XTMP(MAGN,"AAFIX")=FIX
  1.  I 'QUEUED D DISPLAY^MAGGTUX1
  1.  D MAIL^MAGGTUX1
  1.  ; KILL LOCKS.
  1. END ;
  1.  L -MAGTMP("VALIDATE INDEX TERMS")
  1.  Q
  1. ERR ; 
  1.  L -MAGTMP("VALIDATE INDEX TERMS")
  1.  D @^%ZOSF("ERRTN")
  1.  Q
  1. EST() ;Estimate time remaining.
  1.  Q:'$G(ST) ""    ; we didn't start yet.
  1.  N ET,EST,PS             ; Elapsed Time, Estimate Time, Number Per Second.
  1.  S ET=$P($H,",",2)-ST I ET<2 Q "" ; Elapsed Time (seconds)
  1.  I (CTALL/ET)<1 Q ""
  1.  S PS=$P(CTALL/ET,".") ; number Per second
  1.  S EST=$P(((TIM-CTALL)/PS),".") ;remaining/ (num/sec) = seconds remaining
  1.  S %H=$P($H,",")_","_EST D YMD^%DTC
  1.  Q $P($$FMTE^XLFDT(X_%),"@",2)
  1.  ;
  1. PRLINE ; Print a line of current counts
  1.  Q:QUEUED
  1.  S CDT=$$FMTE^XLFDT($P($G(^MAG(2005,IEN,2)),"^",1),"2DF") ; Capture DaTe
  1.  W !,IEN,?10,CDT,?22,CT,?36,NT,?48,NI,?64,$$EST_" ..."
  1.  S LN=LN+1 I LN#10=0 D PRHDR
  1.  Q
  1. PRHDR ; Print a header and estimate of time.
  1.  ; For Test DataBase, put code to Hang here for 1 sec. (magslow)
  1.  Q:QUEUED
  1.  I 'COMMIT W !,"Just Checking Index Terms, NO CHANGES to database. (Q to quit)"
  1.  W !,"IEN       Saved       #checked   No Type     No Index values    est: "
  1.  Q
  1. REVIEW G REVIEW^MAGGTUX1
  1.  Q