MAGXCVC ;WOIFO/SEB,MLH - Image Index Conversion Commit ; 05/18/2007 11:23
;;3.0;IMAGING;**17,25,31,54**;03-July-2009;;Build 1424
;; 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
;
; Entry point for the commit image indices option (MAG IMAGE INDEX COMMIT indices)
COMMIT N START,END,FLAG,TMF,STATUS
N ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK ; -- TaskMan variables
N INPUT ; -------------------------------- user input holder
;
S STATUS=$G(^XTMP("MAG30P25","STATUS"))
L +MAGTMP("IMAGE INDEX GENERATE"):0 E D G COMMITX
. W !,"Image index generation still in progress. Please try again later."
. Q
L +MAGTMP("IMAGE INDEX COMMIT"):0 E D G COMMITX
. W !,"Image index commit still in progress. Please try again later."
. Q
I '$D(^XTMP("MAGIXCVGEN")) D G COMMITX
. W !,"You must generate the image indices before running this option."
. Q
S (START,END)=0,FLAG=""
D BOUNDS^MAGXCVP(.START,.END) I START="^" G COMMITX
D RECREATE^MAGXCVP(.FLAG) I FLAG="^" G COMMITX
R !!,"Commit new index entries? N // ",INPUT:DTIME
I INPUT="" S INPUT="N"
S INPUT=$$UCASE^MAGXCVP($E(INPUT))
I INPUT'="Y" W !,"OK, entries not committed." G COMMITX
D TASKMAN^MAGXCVP(.TMF) I TMF="^" G COMMITX
S ZTSK=0 I TMF="" D COM1(START,END,FLAG,0) G COMMITX
S ZTRTN="COMTM^MAGXCVC",ZTDESC="COMMIT IMAGE INDEX VALUES",ZTDTH=TMF,ZTIO=""
S ZTSAVE("START")=START,ZTSAVE("END")=END,ZTSAVE("FLAG")=FLAG
D ^%ZTLOAD
W !!,"Image index commitment has been queued as task #"_ZTSK_"."
;
COMMITX ; Clean up locks from COMMIT initial processing.
L -MAGTMP("IMAGE INDEX GENERATE")
L -MAGTMP("IMAGE INDEX COMMIT")
Q
;
; TaskMan entry point for committing image indices
COMTM D COM1(START,END,FLAG,1)
Q
;
COM1(START,END,FLAG,QUEUED) N MAGIEN,CT,INDXDATA,INDX,STARTDT,ENDDT,SUMMARY,STOP,HISTORY,RESULT
N PREVLOG ; ------ log entry of a previous committal
N PREV0 ; -------- beginning MAGIEN of previous range
N PREVF ; -------- ending MAGIEN of previous range
N RANGE ; -------- array containing the current range being committed
N T0 ; ----------- internal index of ^TMP($J,"PREVRNG") for range checks
;
L +MAGTMP("IMAGE INDEX COMMIT"):900 E Q ; don't let more than one commit run at once!
K ^XTMP("MAG30P25","SUMMARY") S $P(^XTMP("MAG30P25","STATUS"),U,13,14)=4_U_ZTSK
S STARTDT=$$HTE^XLFDT($H,1)
S START=+$G(START),END=+$G(END),STOP=0
I END=0 S END=+$P($G(^MAG(2005,0)),U,3)
S MAGIEN=START-1 I MAGIEN=-1 S MAGIEN=0
S $P(^XTMP("MAG30P25","STATUS"),U,7,11)=DUZ_U_START_U_STARTDT_U_U
I 'QUEUED W !!
; Now run the entries that are ready to commit.
;
K RANGE
F CT=0:1 S MAGIEN=$O(^XTMP("MAGIXCVGEN",MAGIEN)) Q:MAGIEN>END!(+MAGIEN'=MAGIEN) D I STOP Q
. D COM2(MAGIEN,CT,FLAG,QUEUED)
. S $P(^XTMP("MAG30P25","STATUS"),U,12)=MAGIEN
. I QUEUED,$$S^%ZTLOAD S STOP=1,$P(^XTMP("MAG30P25","STATUS"),U,13)=5
. Q
S ENDDT=$$HTE^XLFDT($H,1)
S $P(^XTMP("MAG30P25","STATUS"),U,10,11)=$S(STOP:MAGIEN,1:END)_U_ENDDT
S ^XTMP("MAG30P25","SUMMARY")=$P(^XTMP("MAG30P25","STATUS"),U,8,11)
S HISTORY=$G(^XTMP("MAG30P25","HISTORY"))+1,^XTMP("MAG30P25","HISTORY")=HISTORY
S ^XTMP("MAG30P25","HISTORY",HISTORY)=$P(^XTMP("MAG30P25","STATUS"),U,8,11)
I 'STOP D ; end-of-processing cleanup
. S $P(^XTMP("MAG30P25","STATUS"),U,13)=6
. D ENTRY^MAGLOG("P17CV",$G(DUZ),START,$T(+0),"","",START_"_"_END)
. D NOTIFY^MAGXCVP(.RESULT,2,STARTDT,ENDDT,START,END,FLAG)
. Q
L -MAGTMP("IMAGE INDEX COMMIT")
Q
;
COM2(MAGIEN,CT,FREC,QUEUED) N INDXDATA,SUMMARY
N FQUIT ; -------- quit flag
N PREV0 ; -------- beginning MAGIEN of previous range
;
I 'QUEUED,CT#100=0 W MAGIEN
I 'QUEUED,CT#10=0 W "."
;Patch 8 has been installed (NOOP MLH 12/6/02)
;or "recreate previously calculated indices" question answered no.
I $TR($G(^MAG(2005,MAGIEN,40)),"^")]"" D
. S FQUIT=1 ; Assume they may not recreate.
. I $E($G(FREC))="N" Q ; "Recreate previously calculated indices" question answered no.
. ; Don't allow committal unless the previous calculation was done by us.
. I $D(^MAGIXCVT(2006.96,MAGIEN)) K FQUIT ; ok
. Q
Q:$G(FQUIT)
;
S INDXDATA="" D COMIEN(MAGIEN,.INDXDATA)
K ^XTMP("MAGIXCVGEN",MAGIEN)
I INDXDATA="" S INDXDATA="(none)"
S SUMMARY=$G(^XTMP("MAG30P25","SUMMARY",INDXDATA))
I SUMMARY="" S ^XTMP("MAG30P25","SUMMARY",INDXDATA)=1_U_MAGIEN_U_MAGIEN
E S ^XTMP("MAG30P25","SUMMARY",INDXDATA)=(SUMMARY+1)_U_$P(SUMMARY,U,2)_U_MAGIEN
S ^XTMP("MAG30P25","SUMMARY",INDXDATA,MAGIEN)=""
S ^MAGIXCVT(2006.96,MAGIEN)=1 ; flag as converted by index generation
Q
;
COMIEN(MAGIEN,INDXDATA) ; Commit indices for one image (IEN=MAGIEN), return indices in INDXDATA
N VAL40 ; --- values on the 40 node
N IX40 ; ---- index to pieces of the 40 node
;
S INDXDATA=$G(INDXDATA)
I INDXDATA="" S INDXDATA=$P($G(^XTMP("MAGIXCVGEN",MAGIEN)),U,2,7)
I INDXDATA="" D GENIEN^MAGXCVI(MAGIEN,.INDXDATA)
F Q:$E(INDXDATA,$L(INDXDATA))'=U S INDXDATA=$E(INDXDATA,1,$L(INDXDATA)-1)
I INDXDATA]"" D
. S ^MAG(2005,MAGIEN,40)=INDXDATA
. Q
E D
. K ^MAG(2005,MAGIEN,40)
. Q
Q
;
; Direct edit of image index fields (#40-44) in the image file (#2005).
IMAGE N I,DIC,DIE,DA,DR,X,Y,MAGIEN,MAGDFN,MAGTMP,BEFORE,AFTER
W ! S DIC=2005,DIC(0)="AEQ" D ^DIC I Y=-1 Q
S DIE=DIC,DR="[MAG IMAGE INDEX EDIT]",(MAGIEN,DA)=$P(Y,U)
S MAGDFN=$P($G(^MAG(2005,MAGIEN,0)),"^",7)
K MAGTMP
D GETS^DIQ(2005,MAGIEN_",","40:45","I","MAGTMP")
S BEFORE="" F I=40:1:45 S:BEFORE'="" BEFORE=BEFORE_"|" S BEFORE=BEFORE_MAGTMP(2005,MAGIEN_",",I,"I")
D ^DIE
K MAGTMP
D GETS^DIQ(2005,MAGIEN_",","40:45","I","MAGTMP")
S AFTER="" F I=40:1:45 S:AFTER'="" AFTER=AFTER_"|" S AFTER=AFTER_MAGTMP(2005,MAGIEN_",",I,"I")
D ENTRY^MAGLOG("INDXCHG",$G(DUZ),$G(MAGIEN),"BEFORE: "_BEFORE_" "_"AFTER: "_AFTER,$G(MAGDFN),1)
G IMAGE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGXCVC 6760 printed Sep 23, 2025@19:46:56 Page 2
MAGXCVC ;WOIFO/SEB,MLH - Image Index Conversion Commit ; 05/18/2007 11:23
+1 ;;3.0;IMAGING;**17,25,31,54**;03-July-2009;;Build 1424
+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
+18 ;
+19 ; Entry point for the commit image indices option (MAG IMAGE INDEX COMMIT indices)
COMMIT NEW START,END,FLAG,TMF,STATUS
+1 ; -- TaskMan variables
NEW ZTDTH,ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK
+2 ; -------------------------------- user input holder
NEW INPUT
+3 ;
+4 SET STATUS=$GET(^XTMP("MAG30P25","STATUS"))
+5 LOCK +MAGTMP("IMAGE INDEX GENERATE"):0
IF '$TEST
Begin DoDot:1
+6 WRITE !,"Image index generation still in progress. Please try again later."
+7 QUIT
End DoDot:1
GOTO COMMITX
+8 LOCK +MAGTMP("IMAGE INDEX COMMIT"):0
IF '$TEST
Begin DoDot:1
+9 WRITE !,"Image index commit still in progress. Please try again later."
+10 QUIT
End DoDot:1
GOTO COMMITX
+11 IF '$DATA(^XTMP("MAGIXCVGEN"))
Begin DoDot:1
+12 WRITE !,"You must generate the image indices before running this option."
+13 QUIT
End DoDot:1
GOTO COMMITX
+14 SET (START,END)=0
SET FLAG=""
+15 DO BOUNDS^MAGXCVP(.START,.END)
IF START="^"
GOTO COMMITX
+16 DO RECREATE^MAGXCVP(.FLAG)
IF FLAG="^"
GOTO COMMITX
+17 READ !!,"Commit new index entries? N // ",INPUT:DTIME
+18 IF INPUT=""
SET INPUT="N"
+19 SET INPUT=$$UCASE^MAGXCVP($EXTRACT(INPUT))
+20 IF INPUT'="Y"
WRITE !,"OK, entries not committed."
GOTO COMMITX
+21 DO TASKMAN^MAGXCVP(.TMF)
IF TMF="^"
GOTO COMMITX
+22 SET ZTSK=0
IF TMF=""
DO COM1(START,END,FLAG,0)
GOTO COMMITX
+23 SET ZTRTN="COMTM^MAGXCVC"
SET ZTDESC="COMMIT IMAGE INDEX VALUES"
SET ZTDTH=TMF
SET ZTIO=""
+24 SET ZTSAVE("START")=START
SET ZTSAVE("END")=END
SET ZTSAVE("FLAG")=FLAG
+25 DO ^%ZTLOAD
+26 WRITE !!,"Image index commitment has been queued as task #"_ZTSK_"."
+27 ;
COMMITX ; Clean up locks from COMMIT initial processing.
+1 LOCK -MAGTMP("IMAGE INDEX GENERATE")
+2 LOCK -MAGTMP("IMAGE INDEX COMMIT")
+3 QUIT
+4 ;
+5 ; TaskMan entry point for committing image indices
COMTM DO COM1(START,END,FLAG,1)
+1 QUIT
+2 ;
COM1(START,END,FLAG,QUEUED) NEW MAGIEN,CT,INDXDATA,INDX,STARTDT,ENDDT,SUMMARY,STOP,HISTORY,RESULT
+1 ; ------ log entry of a previous committal
NEW PREVLOG
+2 ; -------- beginning MAGIEN of previous range
NEW PREV0
+3 ; -------- ending MAGIEN of previous range
NEW PREVF
+4 ; -------- array containing the current range being committed
NEW RANGE
+5 ; ----------- internal index of ^TMP($J,"PREVRNG") for range checks
NEW T0
+6 ;
+7 ; don't let more than one commit run at once!
LOCK +MAGTMP("IMAGE INDEX COMMIT"):900
IF '$TEST
QUIT
+8 KILL ^XTMP("MAG30P25","SUMMARY")
SET $PIECE(^XTMP("MAG30P25","STATUS"),U,13,14)=4_U_ZTSK
+9 SET STARTDT=$$HTE^XLFDT($HOROLOG,1)
+10 SET START=+$GET(START)
SET END=+$GET(END)
SET STOP=0
+11 IF END=0
SET END=+$PIECE($GET(^MAG(2005,0)),U,3)
+12 SET MAGIEN=START-1
IF MAGIEN=-1
SET MAGIEN=0
+13 SET $PIECE(^XTMP("MAG30P25","STATUS"),U,7,11)=DUZ_U_START_U_STARTDT_U_U
+14 IF 'QUEUED
WRITE !!
+15 ; Now run the entries that are ready to commit.
+16 ;
+17 KILL RANGE
+18 FOR CT=0:1
SET MAGIEN=$ORDER(^XTMP("MAGIXCVGEN",MAGIEN))
if MAGIEN>END!(+MAGIEN'=MAGIEN)
QUIT
Begin DoDot:1
+19 DO COM2(MAGIEN,CT,FLAG,QUEUED)
+20 SET $PIECE(^XTMP("MAG30P25","STATUS"),U,12)=MAGIEN
+21 IF QUEUED
IF $$S^%ZTLOAD
SET STOP=1
SET $PIECE(^XTMP("MAG30P25","STATUS"),U,13)=5
+22 QUIT
End DoDot:1
IF STOP
QUIT
+23 SET ENDDT=$$HTE^XLFDT($HOROLOG,1)
+24 SET $PIECE(^XTMP("MAG30P25","STATUS"),U,10,11)=$SELECT(STOP:MAGIEN,1:END)_U_ENDDT
+25 SET ^XTMP("MAG30P25","SUMMARY")=$PIECE(^XTMP("MAG30P25","STATUS"),U,8,11)
+26 SET HISTORY=$GET(^XTMP("MAG30P25","HISTORY"))+1
SET ^XTMP("MAG30P25","HISTORY")=HISTORY
+27 SET ^XTMP("MAG30P25","HISTORY",HISTORY)=$PIECE(^XTMP("MAG30P25","STATUS"),U,8,11)
+28 ; end-of-processing cleanup
IF 'STOP
Begin DoDot:1
+29 SET $PIECE(^XTMP("MAG30P25","STATUS"),U,13)=6
+30 DO ENTRY^MAGLOG("P17CV",$GET(DUZ),START,$TEXT(+0),"","",START_"_"_END)
+31 DO NOTIFY^MAGXCVP(.RESULT,2,STARTDT,ENDDT,START,END,FLAG)
+32 QUIT
End DoDot:1
+33 LOCK -MAGTMP("IMAGE INDEX COMMIT")
+34 QUIT
+35 ;
COM2(MAGIEN,CT,FREC,QUEUED) NEW INDXDATA,SUMMARY
+1 ; -------- quit flag
NEW FQUIT
+2 ; -------- beginning MAGIEN of previous range
NEW PREV0
+3 ;
+4 IF 'QUEUED
IF CT#100=0
WRITE MAGIEN
+5 IF 'QUEUED
IF CT#10=0
WRITE "."
+6 ;Patch 8 has been installed (NOOP MLH 12/6/02)
+7 ;or "recreate previously calculated indices" question answered no.
+8 IF $TRANSLATE($GET(^MAG(2005,MAGIEN,40)),"^")]""
Begin DoDot:1
+9 ; Assume they may not recreate.
SET FQUIT=1
+10 ; "Recreate previously calculated indices" question answered no.
IF $EXTRACT($GET(FREC))="N"
QUIT
+11 ; Don't allow committal unless the previous calculation was done by us.
+12 ; ok
IF $DATA(^MAGIXCVT(2006.96,MAGIEN))
KILL FQUIT
+13 QUIT
End DoDot:1
+14 if $GET(FQUIT)
QUIT
+15 ;
+16 SET INDXDATA=""
DO COMIEN(MAGIEN,.INDXDATA)
+17 KILL ^XTMP("MAGIXCVGEN",MAGIEN)
+18 IF INDXDATA=""
SET INDXDATA="(none)"
+19 SET SUMMARY=$GET(^XTMP("MAG30P25","SUMMARY",INDXDATA))
+20 IF SUMMARY=""
SET ^XTMP("MAG30P25","SUMMARY",INDXDATA)=1_U_MAGIEN_U_MAGIEN
+21 IF '$TEST
SET ^XTMP("MAG30P25","SUMMARY",INDXDATA)=(SUMMARY+1)_U_$PIECE(SUMMARY,U,2)_U_MAGIEN
+22 SET ^XTMP("MAG30P25","SUMMARY",INDXDATA,MAGIEN)=""
+23 ; flag as converted by index generation
SET ^MAGIXCVT(2006.96,MAGIEN)=1
+24 QUIT
+25 ;
COMIEN(MAGIEN,INDXDATA) ; Commit indices for one image (IEN=MAGIEN), return indices in INDXDATA
+1 ; --- values on the 40 node
NEW VAL40
+2 ; ---- index to pieces of the 40 node
NEW IX40
+3 ;
+4 SET INDXDATA=$GET(INDXDATA)
+5 IF INDXDATA=""
SET INDXDATA=$PIECE($GET(^XTMP("MAGIXCVGEN",MAGIEN)),U,2,7)
+6 IF INDXDATA=""
DO GENIEN^MAGXCVI(MAGIEN,.INDXDATA)
+7 FOR
if $EXTRACT(INDXDATA,$LENGTH(INDXDATA))'=U
QUIT
SET INDXDATA=$EXTRACT(INDXDATA,1,$LENGTH(INDXDATA)-1)
+8 IF INDXDATA]""
Begin DoDot:1
+9 SET ^MAG(2005,MAGIEN,40)=INDXDATA
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 KILL ^MAG(2005,MAGIEN,40)
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
+16 ; Direct edit of image index fields (#40-44) in the image file (#2005).
IMAGE NEW I,DIC,DIE,DA,DR,X,Y,MAGIEN,MAGDFN,MAGTMP,BEFORE,AFTER
+1 WRITE !
SET DIC=2005
SET DIC(0)="AEQ"
DO ^DIC
IF Y=-1
QUIT
+2 SET DIE=DIC
SET DR="[MAG IMAGE INDEX EDIT]"
SET (MAGIEN,DA)=$PIECE(Y,U)
+3 SET MAGDFN=$PIECE($GET(^MAG(2005,MAGIEN,0)),"^",7)
+4 KILL MAGTMP
+5 DO GETS^DIQ(2005,MAGIEN_",","40:45","I","MAGTMP")
+6 SET BEFORE=""
FOR I=40:1:45
if BEFORE'=""
SET BEFORE=BEFORE_"|"
SET BEFORE=BEFORE_MAGTMP(2005,MAGIEN_",",I,"I")
+7 DO ^DIE
+8 KILL MAGTMP
+9 DO GETS^DIQ(2005,MAGIEN_",","40:45","I","MAGTMP")
+10 SET AFTER=""
FOR I=40:1:45
if AFTER'=""
SET AFTER=AFTER_"|"
SET AFTER=AFTER_MAGTMP(2005,MAGIEN_",",I,"I")
+11 DO ENTRY^MAGLOG("INDXCHG",$GET(DUZ),$GET(MAGIEN),"BEFORE: "_BEFORE_" "_"AFTER: "_AFTER,$GET(MAGDFN),1)
+12 GOTO IMAGE
+13 ;
