MAGDCCS2 ;WOIFO/MLH - DICOM Correct - Clinical Specialties - subroutines ; Apr 27, 2022@12:03:33
;;3.0;IMAGING;**10,11,30,54,123,138,278**;Mar 19, 2002;Build 138
;; Per VA Directive 6402, 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
; Routine to create the MAGDY variable needed by MAGDCCS routine when
; manually correcting DICOM FIX files.
EN ;
; MAGDY variable to be created during this execution.
N D,DIC,DO,DUOUT,DZ,MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGPID,Y
S MAGBEG=1070101,MAGEND=$$DT^XLFDT
W !,"*** Select a request/consult with whose ***"
W !,"*** TIU note to associate this image ***"
S DIC="^GMR(123,",DIC(0)="AEMNZ" ;P278 JSJ add 'M' to flags
S DIC("A")="Enter patient or request/consultation: "
S D="F",DZ="??"
S DIC("W")="W "" REQ/CON #"",Y"
S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,1)" ; TO SERVICE
S DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,.02)" ; PATIENT NAME
;
D ^DIC ;P278 JSJ change from IX^DIC to ^DIC
Q:$D(DUOUT)
Q:'$D(Y(0)) ;
I "^DISCONTINUED^CANCELLED^"[("^"_$$GET1^DIQ(123,+Y,8)_"^") D Q
. W !!,"This consult has been cancelled and cannot be selected." H 2
. Q
S (MAGDFN,MAGX)=$P(Y(0),U,2)_"~"_Y
;
D ONE ; Lookup was on req/con number and successful
Q
;
PTINFO() ;
N INFO,MAGOUT,MAGERR
I '$D(MAGDFN) Q ""
I $$ISIHS^MAGSPID() D Q INFO ;P123 - MOD for IHS patients with multiple chart numbers (i.e. Chawktaw)
. N DFN,VA,VADM
. S DFN=MAGDFN,INFO="" D DEM^VADPT
. I $G(VA("PID"))'="" S INFO=$G(VADM(1))_"^"_$TR(VA("PID"),"-")
. Q
D GETS^DIQ(2,MAGDFN,".01;.09","E","MAGOUT","MAGERR")
I $D(MAGERR) Q ""
I $D(MAGOUT) D Q INFO
. S INFO=$G(MAGOUT(2,MAGDFN_",",.01,"E"))
. S INFO=INFO_"^"_$G(MAGOUT(2,MAGDFN_",",.09,"E"))
Q ""
;
ONE ; Process the single entry that was selected.
; MAGDFN,MAGX variables expected from EN
I 'MAGDFN,'+MAGX Q
N BEG,CASE,CDATE,CS,DATA,END,FLDS,INFO,MAGCASE,MAGCNI,MAGDATE,MAGDTI
N MAGEXST,MAGLOC,MAGNME,MAGOUT,MAGPIEN,MAGPRC,MAGPSET,MAGPST,MAGRPT
N PP,PSET,RAENTRY,RAMEMLOW,RAPRTSET,RIEN,STAT,X,X1,X2,XX
N RARPT,RADFN,RADTI,RACNI ;<--Variables needed for EN1^RAUTL20
; RAUTL20 used to retrieve if case is part of a print set.
N MAGRCARY ; array of req/con data from file 123
N MAGIENS ; internal entry number for MAGRCARY
;
S MAGDFN=$P(MAGX,"~"),INFO=$$PTINFO
S MAGNME=$P(INFO,"^"),MAGPID=$P(INFO,"^",2)
S MAGCASE=$P($P(MAGX,"~",2),U)
S (MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAGLOC,MAGDATE,MAGEXST,MAGPST)=""
K MAGRCARY D GETS^DIQ(123,MAGCASE,"*","EI","MAGRCARY")
;
S MAGIENS=$O(MAGRCARY(123,""))
S MAGPRC=MAGRCARY(123,MAGIENS,4,"E") ; procedure
S MAGLOC=MAGRCARY(123,MAGIENS,1,"E") ; to service
S MAGDATE=MAGRCARY(123,MAGIENS,.01,"E") ; request date
S MAGPST=MAGRCARY(123,MAGIENS,8,"E") ; procedure status
W !,"PATIENT: ",MAGNME,?51,$$PIDLABEL^MAGSPID(),": ",MAGPID
W !,"Req/Con No.",?13,"Procedure",?38,"To Service",?58,"Req Date"
W !,"-----------",?13,"---------",?38,"----------------",?58,"--------"
W !,MAGCASE,?13,MAGPRC,?38,MAGLOC,?58,MAGDATE
W !,"Exam status: ",MAGEXST," "," ",$G(MAGPST)
D MAGDY
Q
;
MAGDY ;
K MAGDY
S MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGPID_"^"_$$GMRCACN^MAGDFCNV(MAGCASE)
S MAGDY=MAGDY_"^"_MAGPRC_"^"_MAGDTI_"^"_MAGCNI_"^"_MAGPIEN_"^"_$G(MAGPST)_"^"
K MAGNME,MAGPID,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDCCS2 4290 printed Sep 23, 2025@19:35:56 Page 2
MAGDCCS2 ;WOIFO/MLH - DICOM Correct - Clinical Specialties - subroutines ; Apr 27, 2022@12:03:33
+1 ;;3.0;IMAGING;**10,11,30,54,123,138,278**;Mar 19, 2002;Build 138
+2 ;; Per VA Directive 6402, 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 ; Routine to create the MAGDY variable needed by MAGDCCS routine when
+19 ; manually correcting DICOM FIX files.
EN ;
+1 ; MAGDY variable to be created during this execution.
+2 NEW D,DIC,DO,DUOUT,DZ,MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGPID,Y
+3 SET MAGBEG=1070101
SET MAGEND=$$DT^XLFDT
+4 WRITE !,"*** Select a request/consult with whose ***"
+5 WRITE !,"*** TIU note to associate this image ***"
+6 ;P278 JSJ add 'M' to flags
SET DIC="^GMR(123,"
SET DIC(0)="AEMNZ"
+7 SET DIC("A")="Enter patient or request/consultation: "
+8 SET D="F"
SET DZ="??"
+9 SET DIC("W")="W "" REQ/CON #"",Y"
+10 ; TO SERVICE
SET DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,1)"
+11 ; PATIENT NAME
SET DIC("W")=DIC("W")_","" "",$$GET1^DIQ(123,Y,.02)"
+12 ;
+13 ;P278 JSJ change from IX^DIC to ^DIC
DO ^DIC
+14 if $DATA(DUOUT)
QUIT
+15 ;
if '$DATA(Y(0))
QUIT
+16 IF "^DISCONTINUED^CANCELLED^"[("^"_$$GET1^DIQ(123,+Y,8)_"^")
Begin DoDot:1
+17 WRITE !!,"This consult has been cancelled and cannot be selected."
HANG 2
+18 QUIT
End DoDot:1
QUIT
+19 SET (MAGDFN,MAGX)=$PIECE(Y(0),U,2)_"~"_Y
+20 ;
+21 ; Lookup was on req/con number and successful
DO ONE
+22 QUIT
+23 ;
PTINFO() ;
+1 NEW INFO,MAGOUT,MAGERR
+2 IF '$DATA(MAGDFN)
QUIT ""
+3 ;P123 - MOD for IHS patients with multiple chart numbers (i.e. Chawktaw)
IF $$ISIHS^MAGSPID()
Begin DoDot:1
+4 NEW DFN,VA,VADM
+5 SET DFN=MAGDFN
SET INFO=""
DO DEM^VADPT
+6 IF $GET(VA("PID"))'=""
SET INFO=$GET(VADM(1))_"^"_$TRANSLATE(VA("PID"),"-")
+7 QUIT
End DoDot:1
QUIT INFO
+8 DO GETS^DIQ(2,MAGDFN,".01;.09","E","MAGOUT","MAGERR")
+9 IF $DATA(MAGERR)
QUIT ""
+10 IF $DATA(MAGOUT)
Begin DoDot:1
+11 SET INFO=$GET(MAGOUT(2,MAGDFN_",",.01,"E"))
+12 SET INFO=INFO_"^"_$GET(MAGOUT(2,MAGDFN_",",.09,"E"))
End DoDot:1
QUIT INFO
+13 QUIT ""
+14 ;
ONE ; Process the single entry that was selected.
+1 ; MAGDFN,MAGX variables expected from EN
+2 IF 'MAGDFN
IF '+MAGX
QUIT
+3 NEW BEG,CASE,CDATE,CS,DATA,END,FLDS,INFO,MAGCASE,MAGCNI,MAGDATE,MAGDTI
+4 NEW MAGEXST,MAGLOC,MAGNME,MAGOUT,MAGPIEN,MAGPRC,MAGPSET,MAGPST,MAGRPT
+5 NEW PP,PSET,RAENTRY,RAMEMLOW,RAPRTSET,RIEN,STAT,X,X1,X2,XX
+6 ;<--Variables needed for EN1^RAUTL20
NEW RARPT,RADFN,RADTI,RACNI
+7 ; RAUTL20 used to retrieve if case is part of a print set.
+8 ; array of req/con data from file 123
NEW MAGRCARY
+9 ; internal entry number for MAGRCARY
NEW MAGIENS
+10 ;
+11 SET MAGDFN=$PIECE(MAGX,"~")
SET INFO=$$PTINFO
+12 SET MAGNME=$PIECE(INFO,"^")
SET MAGPID=$PIECE(INFO,"^",2)
+13 SET MAGCASE=$PIECE($PIECE(MAGX,"~",2),U)
+14 SET (MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAGLOC,MAGDATE,MAGEXST,MAGPST)=""
+15 KILL MAGRCARY
DO GETS^DIQ(123,MAGCASE,"*","EI","MAGRCARY")
+16 ;
+17 SET MAGIENS=$ORDER(MAGRCARY(123,""))
+18 ; procedure
SET MAGPRC=MAGRCARY(123,MAGIENS,4,"E")
+19 ; to service
SET MAGLOC=MAGRCARY(123,MAGIENS,1,"E")
+20 ; request date
SET MAGDATE=MAGRCARY(123,MAGIENS,.01,"E")
+21 ; procedure status
SET MAGPST=MAGRCARY(123,MAGIENS,8,"E")
+22 WRITE !,"PATIENT: ",MAGNME,?51,$$PIDLABEL^MAGSPID(),": ",MAGPID
+23 WRITE !,"Req/Con No.",?13,"Procedure",?38,"To Service",?58,"Req Date"
+24 WRITE !,"-----------",?13,"---------",?38,"----------------",?58,"--------"
+25 WRITE !,MAGCASE,?13,MAGPRC,?38,MAGLOC,?58,MAGDATE
+26 WRITE !,"Exam status: ",MAGEXST," "," ",$GET(MAGPST)
+27 DO MAGDY
+28 QUIT
+29 ;
MAGDY ;
+1 KILL MAGDY
+2 SET MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGPID_"^"_$$GMRCACN^MAGDFCNV(MAGCASE)
+3 SET MAGDY=MAGDY_"^"_MAGPRC_"^"_MAGDTI_"^"_MAGCNI_"^"_MAGPIEN_"^"_$GET(MAGPST)_"^"
+4 KILL MAGNME,MAGPID,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST
+5 QUIT
