MAGGTUX2 ;WIOFO/GEK Imaging utility to validate INDEX values.
;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20
;;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
INIT ; If this is a continuation, initialize the variables.
;W !,"MAGN ",MAGN
I $P(^MAG(2005,0),"^",3)>$P(^XTMP(MAGN,0),"^",4) D
. W !,"There are new images since this utility was last run."
S IEN=$P($G(^XTMP(MAGN,0)),"^",3)+1 I IEN=1 D Q ; Already run, so start over.
. S IEN="A"
. W !!,"All Images were checked as of "_$$FMTE^XLFDT($P(^XTMP(MAGN,0),"^",2))
. W !
. W !,"For a summary of the last Check or Fix process use the menu option: "
. W !," ""REV Review a Summary of the last Fix or Check process."""
. W !," or continue to Re-Check the Image file."
W !,"Continue: where you left off, at IEN : ",IEN," Y/N //N :" R X:30
I "Nn"[$E(X) W !,"Starting over..." S IEN="A" Q
W !,"Continuing from IEN: ",IEN,!
S NT=$G(^XTMP(MAGN,"AANT"))
S NI=$G(^XTMP(MAGN,"AANI"))
S GRINT=$G(^XTMP(MAGN,"AAGRINT"))
S GRINI=$G(^XTMP(MAGN,"AAGRINI"))
S GO1=$G(^XTMP(MAGN,"AAGO1"))
S OFX=$G(^XTMP(MAGN,"AAOFX"))
S INVG=$G(^XTMP(MAGN,"AAINVG"))
S INVO=$G(^XTMP(MAGN,"AAINVO"))
S NOMERG=$G(^XTMP(MAGN,"AANOMERG"))
S OKMERG=$G(^XTMP(MAGN,"AAOKMERG"))
S FIX=$G(^XTMP(MAGN,"AAFIX"))
S CRCT=$G(^XTMP(MAGN,"AACRCT"))
Q
TRK2 ; Keep a Count of Short Desc, transpose to compact the list.
S SD=$P(N2,"^",4)
S SD=$TR(SD,"0123456789+-/\.,~`!@#$%^&*()_-={}[]|:;""'<>?","")
S SD=$TR(SD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
F Q:SD'[" " S SD=$P(SD," ",1)_" "_$P(SD," ",2,999)
S SD=$$TRIM^XLFSTR(SD,"LR")
S:SD="" SD="[NO SHORT DESC]"
S ^XTMP(MAGN,"MAIDSD",+IXT,+IXS,+IXP,"SD",SD)=$G(^XTMP(MAGN,"MAIDSD",+IXT,+IXS,+IXP,"SD",SD))+1
Q
CHKCR(N40,IEN) ; Image has Procedure/Event CR, see if it should be CT.
N INDXD
D GENIEN^MAGXCVI(IEN,.INDXD)
I $P(INDXD,"^",4)'=RADCT Q
S CRCT=CRCT+1
I COMMIT D
. S FIX=FIX+1
. S $P(^MAG(2005,IEN,40),"^",4)=RADCT
. D ENTRY^MAGLOG("INDEX-CR",DUZ,IEN,"TUX59",MDFN,1)
. Q
Q
CHK45(N40,IEN) ; Check the Origin Set of Codes.
; N40 passed by Ref, it may be changed in here.
N ORG,NORG
S ORG=$P(N40,"^",6)
I "VNFD"[ORG Q ; Valid
; get it's first Char.
S $P(N40,"^",6)=$S("VNFD"[$E(ORG):$E(ORG),1:"")
S OFX=OFX+1
I COMMIT D
. S FIX=FIX+1
. S ^MAG(2005,IEN,40)=N40
. D ENTRY^MAGLOG("INDEX-45",DUZ,IEN,"TUX59",MDFN,1)
. Q
Q
VALIND ;Validate the interdependency between Type, Spec, Proc/Event for Entries that have a TYpe.
K MRY I $$VALTUX2^MAGGTUX3(.MRY,IXT,IXS,IXP) Q ; Valid Type <-> Spec <-> Proc
; Keep list of Generated or User entered invalid Type<->Spec<->Proc
I $D(^MAGIXCVT(2006.96,IEN)) S ^XTMP(MAGN,"MAIDXG",+IXT,+IXS,+IXP)=$G(^XTMP(MAGN,"MAIDXG",+IXT,+IXS,+IXP))+1,INVG=INVG+1
E S ^XTMP(MAGN,"MAIDXO",+IXT,+IXS,+IXP)=$G(^XTMP(MAGN,"MAIDXO",+IXT,+IXS,+IXP))+1,INVO=INVO+1
D TRK2
Q
VALMERG(O40,N40) ; N40 Passed by Ref.
; if the merged Proc-Spec in New 40 Node (N40) are not valid,
; Then just take the TYPE, and revert back to old O40 Spec and Proc
K MRY
I $$VALTUX2^MAGGTUX3(.MRY,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S OKMERG=OKMERG+1 Q ; Merged values are valid
S NOMERG=NOMERG+1
S $P(N40,"^",4,5)=$P(O40,"^",4,5) ; Put the Spec and Proc back to original way.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTUX2 4339 printed Oct 16, 2024@18:04:21 Page 2
MAGGTUX2 ;WIOFO/GEK Imaging utility to validate INDEX values.
+1 ;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20
+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 ;; | |
+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 QUIT
INIT ; If this is a continuation, initialize the variables.
+1 ;W !,"MAGN ",MAGN
+2 IF $PIECE(^MAG(2005,0),"^",3)>$PIECE(^XTMP(MAGN,0),"^",4)
Begin DoDot:1
+3 WRITE !,"There are new images since this utility was last run."
End DoDot:1
+4 ; Already run, so start over.
SET IEN=$PIECE($GET(^XTMP(MAGN,0)),"^",3)+1
IF IEN=1
Begin DoDot:1
+5 SET IEN="A"
+6 WRITE !!,"All Images were checked as of "_$$FMTE^XLFDT($PIECE(^XTMP(MAGN,0),"^",2))
+7 WRITE !
+8 WRITE !,"For a summary of the last Check or Fix process use the menu option: "
+9 WRITE !," ""REV Review a Summary of the last Fix or Check process."""
+10 WRITE !," or continue to Re-Check the Image file."
End DoDot:1
QUIT
+11 WRITE !,"Continue: where you left off, at IEN : ",IEN," Y/N //N :"
READ X:30
+12 IF "Nn"[$EXTRACT(X)
WRITE !,"Starting over..."
SET IEN="A"
QUIT
+13 WRITE !,"Continuing from IEN: ",IEN,!
+14 SET NT=$GET(^XTMP(MAGN,"AANT"))
+15 SET NI=$GET(^XTMP(MAGN,"AANI"))
+16 SET GRINT=$GET(^XTMP(MAGN,"AAGRINT"))
+17 SET GRINI=$GET(^XTMP(MAGN,"AAGRINI"))
+18 SET GO1=$GET(^XTMP(MAGN,"AAGO1"))
+19 SET OFX=$GET(^XTMP(MAGN,"AAOFX"))
+20 SET INVG=$GET(^XTMP(MAGN,"AAINVG"))
+21 SET INVO=$GET(^XTMP(MAGN,"AAINVO"))
+22 SET NOMERG=$GET(^XTMP(MAGN,"AANOMERG"))
+23 SET OKMERG=$GET(^XTMP(MAGN,"AAOKMERG"))
+24 SET FIX=$GET(^XTMP(MAGN,"AAFIX"))
+25 SET CRCT=$GET(^XTMP(MAGN,"AACRCT"))
+26 QUIT
TRK2 ; Keep a Count of Short Desc, transpose to compact the list.
+1 SET SD=$PIECE(N2,"^",4)
+2 SET SD=$TRANSLATE(SD,"0123456789+-/\.,~`!@#$%^&*()_-={}[]|:;""'<>?","")
+3 SET SD=$TRANSLATE(SD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+4 FOR
if SD'[" "
QUIT
SET SD=$PIECE(SD," ",1)_" "_$PIECE(SD," ",2,999)
+5 SET SD=$$TRIM^XLFSTR(SD,"LR")
+6 if SD=""
SET SD="[NO SHORT DESC]"
+7 SET ^XTMP(MAGN,"MAIDSD",+IXT,+IXS,+IXP,"SD",SD)=$GET(^XTMP(MAGN,"MAIDSD",+IXT,+IXS,+IXP,"SD",SD))+1
+8 QUIT
CHKCR(N40,IEN) ; Image has Procedure/Event CR, see if it should be CT.
+1 NEW INDXD
+2 DO GENIEN^MAGXCVI(IEN,.INDXD)
+3 IF $PIECE(INDXD,"^",4)'=RADCT
QUIT
+4 SET CRCT=CRCT+1
+5 IF COMMIT
Begin DoDot:1
+6 SET FIX=FIX+1
+7 SET $PIECE(^MAG(2005,IEN,40),"^",4)=RADCT
+8 DO ENTRY^MAGLOG("INDEX-CR",DUZ,IEN,"TUX59",MDFN,1)
+9 QUIT
End DoDot:1
+10 QUIT
CHK45(N40,IEN) ; Check the Origin Set of Codes.
+1 ; N40 passed by Ref, it may be changed in here.
+2 NEW ORG,NORG
+3 SET ORG=$PIECE(N40,"^",6)
+4 ; Valid
IF "VNFD"[ORG
QUIT
+5 ; get it's first Char.
+6 SET $PIECE(N40,"^",6)=$SELECT("VNFD"[$EXTRACT(ORG):$EXTRACT(ORG),1:"")
+7 SET OFX=OFX+1
+8 IF COMMIT
Begin DoDot:1
+9 SET FIX=FIX+1
+10 SET ^MAG(2005,IEN,40)=N40
+11 DO ENTRY^MAGLOG("INDEX-45",DUZ,IEN,"TUX59",MDFN,1)
+12 QUIT
End DoDot:1
+13 QUIT
VALIND ;Validate the interdependency between Type, Spec, Proc/Event for Entries that have a TYpe.
+1 ; Valid Type <-> Spec <-> Proc
KILL MRY
IF $$VALTUX2^MAGGTUX3(.MRY,IXT,IXS,IXP)
QUIT
+2 ; Keep list of Generated or User entered invalid Type<->Spec<->Proc
+3 IF $DATA(^MAGIXCVT(2006.96,IEN))
SET ^XTMP(MAGN,"MAIDXG",+IXT,+IXS,+IXP)=$GET(^XTMP(MAGN,"MAIDXG",+IXT,+IXS,+IXP))+1
SET INVG=INVG+1
+4 IF '$TEST
SET ^XTMP(MAGN,"MAIDXO",+IXT,+IXS,+IXP)=$GET(^XTMP(MAGN,"MAIDXO",+IXT,+IXS,+IXP))+1
SET INVO=INVO+1
+5 DO TRK2
+6 QUIT
VALMERG(O40,N40) ; N40 Passed by Ref.
+1 ; if the merged Proc-Spec in New 40 Node (N40) are not valid,
+2 ; Then just take the TYPE, and revert back to old O40 Spec and Proc
+3 KILL MRY
+4 ; Merged values are valid
IF $$VALTUX2^MAGGTUX3(.MRY,$PIECE(N40,"^",3),$PIECE(N40,"^",5),$PIECE(N40,"^",4))
SET OKMERG=OKMERG+1
QUIT
+5 SET NOMERG=NOMERG+1
+6 ; Put the Spec and Proc back to original way.
SET $PIECE(N40,"^",4,5)=$PIECE(O40,"^",4,5)
+7 QUIT
