Routine: MAGDRA2

MAGDRA2 ;WOIFO/LB,JSL,SAF - Routine for DICOM fix ; 13 Jul 2011 10:22 AM

 ;;3.0;IMAGING;**10,11,51,54,49,123**;Mar 19, 2002;Build 67;Jul 24, 2012

 ;; 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.                     |

 ;; +---------------------------------------------------------------+

;;

 ; Routine to create the MAGDY variable needed by MAGDLB1 routine when

 ; manually correcting DICOM FIX files.

EN ;

 ; MAGDY variable to be created during this execution.

 N MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGPID

 S MAGBEG=1070101,MAGEND=$$DT^XLFDT

READ ;

 S (MAGDFN,MAGX)=$$READ^MAGDRA3

 Q:MAGX="^"

 S MAGDFN=+MAGDFN

 I 'MAGDFN W !,"Entry not found, enter a ""^"" to quit." G READ

 I MAGX["~" G ONE  ;Lookup was on case number and successful

 S MAGXX=$$FIND1^DIC(70,"","","`"_MAGDFN)   ;Radiology patient

 I MAGDFN=MAGXX D

 . S INFO=$$PTINFO Q:$D(MAGERR)

 . S MAGNME=$P(INFO,"^"),MAGPID=$P(INFO,"^",2)

 . K ^TMP($J,"RAE1")  ;Re-established by EN1^RA07PC1 -DBIA available

 . ; Set the beginning and ending date.

 . D EN1^RAO7PC1(MAGDFN,MAGBEG,MAGEND,500)

 . D:$D(^TMP($J,"RAE1")) LOOP^MAGDRA1

. Q

 E  D  G:MAGX'="^" READ

 . W !,"No Radiology information found for the supplied answer.",$C(7)

. Q

PTINFO() ;

 N INFO,MAGOUT

 I '$D(MAGDFN) Q ""

 I $$ISIHS^MAGSPID() D  Q INFO  ;P123 - MOD for IHS patients with Health Record Numbers (i.e. Chawktaw)

 . N DFN S DFN=MAGDFN,INFO="" D DEM^VADPT

 . I $G(VA("PID"))'="" S INFO=$G(VADM(1))_"^"_$TR(VA("PID"),"-")

 . E  S INFO=$G(VADM(1))_"^"_$P($G(VADM(2)),"^")

. 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

 Q ""

LCASE(MAGDT,MAGCASE) ; return the accession number

 N ACNUMB,ARESULT

 S ACNUMB=$TR($TR($$FMTE^XLFDT(MAGDT,"2FD")," ","0"),"/","")_"-"_MAGCASE

 I $$USESSAN^RAHLRU1(),$$ACCFIND^RAAPI(ACNUMB,.ARESULT)>0 D  ; ICR 5600

 . ; lookup site-specific accession number

 . N ACNUMB1,RADFN,RADTI,RACNI

 . S RADFN=$P(ARESULT(1),"^",1),RADTI=$P(ARESULT(1),"^",2)

 . S RACNI=$P(ARESULT(1),"^",3)

 . S ACNUMB1=$$GET1^DIQ(70.03,(RACNI_","_RADTI_","_RADFN),31)

 . I ACNUMB1'="" S ACNUMB=ACNUMB1

. Q

 Q ACNUMB

IMG(MAGRPT) ;

 N INFO,MAGOUT,MAGERR

 I 'MAGRPT Q ""

 D GETS^DIQ(74,MAGRPT,"2005*","I","MAGOUT","MAGERR")

 I $D(MAGERR) Q ""

 I $D(MAGOUT(74.02005)) Q " i"

 Q ""

PROC(MAGPRC) ;

 Q $$FIND1^DIC(71,,"XB",MAGPRC)

ONE ;

 ;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.

 S MAGDFN=$P(MAGX,"~"),INFO=$$PTINFO

 S MAGNME=$P(INFO,"^"),MAGPID=$P(INFO,"^",2)

 S RIEN=$P(MAGX,"~",2)_","_$P(MAGX,"~",1)

 S BEG=9999999.9999-$P(MAGX,"~",2),END=$$FMADD^XLFDT(BEG,2)

 K ^TMP($J,"RAE1")

 D EN1^RAO7PC1(MAGDFN,BEG,END,20)

 S RAENTRY=$P(MAGX,"~",2)_"-"_$P(MAGX,"~",3)

 Q:'$D(^TMP($J,"RAE1"))

 Q:'$D(^TMP($J,"RAE1",MAGDFN,RAENTRY))

 S DATA=^TMP($J,"RAE1",MAGDFN,RAENTRY)

 S MAGDATE=$P(RAENTRY,"-"),CDATE=9999999.9999-MAGDATE

 S MAGDATE=$TR($$FMTE^XLFDT(CDATE,"2FD")," ","0")

 S MAGPRC=$P(DATA,"^"),CASE=$P(DATA,"^",2),STAT=$P(DATA,"^",6)

 S MAGEXST=$P(STAT,"~",2),MAGLOC=$P(DATA,"^",7)

 S (MAGRPT,RARPT)=$P(DATA,"^",5)

 S (MAGDTI,RADTI)=$P(RAENTRY,"-")

 S (MAGCNI,RACNI)=$P(RAENTRY,"-",2),RADFN=MAGDFN

 S MAGCASE=$$LCASE(CDATE,CASE),MAGPIEN=$$PROC(MAGPRC)

 ; RADTI, RADFN, RACNI variables needed for EN1^RAUTL20

 D EN1^RAUTL20

 S (PSET,MAGPSET)=""

 S PSET=$S(RAMEMLOW:"+",RAPRTSET:".",1:"")

 I PSET=".",RACNI>1 D

 . N OLDENTRY S OLDENTRY=$P(RAENTRY,"-")_"-"

 . S OLDENTRY=$O(^TMP($J,"RAE1",MAGDFN,OLDENTRY)) I $L(OLDENTRY) D

 . . S MAGCASE=$P(^TMP($J,"RAE1",MAGDFN,OLDENTRY),"^",2)

 . . S CDATE=$P(RAENTRY,"-")

 . . S CDATE=9999999.9999-CDATE

 . . S MAGCASE=$$LCASE^MAGDRA2(CDATE,MAGCASE),RACNI=$P(OLDENTRY,"-",2)

 . . S MAGPST=CASE_" is part of this printset."

 . . Q

. Q

 I $D(RAPRTSET) S PP=$S(MAGCNI>1:".",MAGCNI=1:"+",1:"")

 S MAGCNI=RACNI

 W !,"PATIENT: ",MAGNME,?51,$$PIDLABEL^MAGSPID(),": ",MAGPID

 W !,"Case No.",?15,"Procedure",?42,"Location",?64,"Exam Date"

 W !,"________",?15,"_________",?42,"________________",?64,"________"

 W !,$G(PP),CASE,$$IMG(MAGRPT),?15,MAGPRC,?42,MAGLOC,?64,MAGDATE

 W !,"Exam status: ",MAGEXST," "," ",$G(MAGPST)

 D MAGDY

MAGDY ;

 S MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGPID_"^"_MAGCASE_"^"_MAGPRC_"^"_MAGDTI

 S MAGDY=MAGDY_"^"_MAGCNI_"^"_MAGPIEN_"^"_$G(MAGPST)_"^"

 K MAGNME,MAGPID,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRA2   5699     printed  Feb 18, 2025@23:27:41                                                                                                                                                                                                     Page 2

MAGDRA2   ;WOIFO/LB,JSL,SAF - Routine for DICOM fix ; 13 Jul 2011 10:22 AM

 +1       ;;3.0;IMAGING;**10,11,51,54,49,123**;Mar 19, 2002;Build 67;Jul 24, 2012

 +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      ; Routine to create the MAGDY variable needed by MAGDLB1 routine when

 +19      ; manually correcting DICOM FIX files.

EN        ;

 +1       ; MAGDY variable to be created during this execution.

 +2        NEW MAGBEG,MAGEND,MAGDFN,MAGOUT,MAGX,MAGXX,INFO,MAGNME,MAGPID

 +3        SET MAGBEG=1070101

           SET MAGEND=$$DT^XLFDT

READ      ;

 +1        SET (MAGDFN,MAGX)=$$READ^MAGDRA3

 +2        if MAGX="^"

               QUIT

 +3        SET MAGDFN=+MAGDFN

 +4        IF 'MAGDFN

               WRITE !,"Entry not found, enter a ""^"" to quit."

               GOTO READ

 +5       ;

 +6       ;Lookup was on case number and successful

           IF MAGX["~"

               GOTO ONE

 +7       ;Radiology patient

           SET MAGXX=$$FIND1^DIC(70,"","","`"_MAGDFN)

 +8       ;

 +9        IF MAGDFN=MAGXX

               Begin DoDot:1

 +10               SET INFO=$$PTINFO

                   if $DATA(MAGERR)

                       QUIT

 +11               SET MAGNME=$PIECE(INFO,"^")

                   SET MAGPID=$PIECE(INFO,"^",2)

 +12      ;Re-established by EN1^RA07PC1 -DBIA available

                   KILL ^TMP($JOB,"RAE1")

 +13      ; Set the beginning and ending date.

 +14               DO EN1^RAO7PC1(MAGDFN,MAGBEG,MAGEND,500)

 +15               if $DATA(^TMP($JOB,"RAE1"))

                       DO LOOP^MAGDRA1

 +16               QUIT

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18               WRITE !,"No Radiology information found for the supplied answer.",$CHAR(7)

 +19               QUIT

               End DoDot:1

               if MAGX'="^"

                   GOTO READ

 +20       QUIT

 +21      ;

PTINFO()  ;

 +1        NEW INFO,MAGOUT

 +2        IF '$DATA(MAGDFN)

               QUIT ""

 +3       ;P123 - MOD for IHS patients with Health Record Numbers (i.e. Chawktaw)

           IF $$ISIHS^MAGSPID()

               Begin DoDot:1

 +4                NEW DFN

                   SET DFN=MAGDFN

                   SET INFO=""

                   DO DEM^VADPT

 +5                IF $GET(VA("PID"))'=""

                       SET INFO=$GET(VADM(1))_"^"_$TRANSLATE(VA("PID"),"-")

 +6               IF '$TEST

                       SET INFO=$GET(VADM(1))_"^"_$PIECE($GET(VADM(2)),"^")

 +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"))

 +13               QUIT

               End DoDot:1

               QUIT INFO

 +14       QUIT ""

 +15      ;

LCASE(MAGDT,MAGCASE) ; return the accession number

 +1        NEW ACNUMB,ARESULT

 +2        SET ACNUMB=$TRANSLATE($TRANSLATE($$FMTE^XLFDT(MAGDT,"2FD")," ","0"),"/","")_"-"_MAGCASE

 +3       ; ICR 5600

           IF $$USESSAN^RAHLRU1()

               IF $$ACCFIND^RAAPI(ACNUMB,.ARESULT)>0

                   Begin DoDot:1

 +4       ; lookup site-specific accession number

 +5                    NEW ACNUMB1,RADFN,RADTI,RACNI

 +6                    SET RADFN=$PIECE(ARESULT(1),"^",1)

                       SET RADTI=$PIECE(ARESULT(1),"^",2)

 +7                    SET RACNI=$PIECE(ARESULT(1),"^",3)

 +8                    SET ACNUMB1=$$GET1^DIQ(70.03,(RACNI_","_RADTI_","_RADFN),31)

 +9                    IF ACNUMB1'=""

                           SET ACNUMB=ACNUMB1

 +10                   QUIT

                   End DoDot:1

 +11       QUIT ACNUMB

 +12      ;

IMG(MAGRPT) ;

 +1        NEW INFO,MAGOUT,MAGERR

 +2        IF 'MAGRPT

               QUIT ""

 +3        DO GETS^DIQ(74,MAGRPT,"2005*","I","MAGOUT","MAGERR")

 +4        IF $DATA(MAGERR)

               QUIT ""

 +5        IF $DATA(MAGOUT(74.02005))

               QUIT " i"

 +6        QUIT ""

 +7       ;

PROC(MAGPRC) ;

 +1        QUIT $$FIND1^DIC(71,,"XB",MAGPRC)

 +2       ;

ONE       ;

 +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        SET MAGDFN=$PIECE(MAGX,"~")

           SET INFO=$$PTINFO

 +9        SET MAGNME=$PIECE(INFO,"^")

           SET MAGPID=$PIECE(INFO,"^",2)

 +10       SET RIEN=$PIECE(MAGX,"~",2)_","_$PIECE(MAGX,"~",1)

 +11       SET BEG=9999999.9999-$PIECE(MAGX,"~",2)

           SET END=$$FMADD^XLFDT(BEG,2)

 +12       KILL ^TMP($JOB,"RAE1")

 +13       DO EN1^RAO7PC1(MAGDFN,BEG,END,20)

 +14       SET RAENTRY=$PIECE(MAGX,"~",2)_"-"_$PIECE(MAGX,"~",3)

 +15       if '$DATA(^TMP($JOB,"RAE1"))

               QUIT

 +16       if '$DATA(^TMP($JOB,"RAE1",MAGDFN,RAENTRY))

               QUIT

 +17       SET DATA=^TMP($JOB,"RAE1",MAGDFN,RAENTRY)

 +18       SET MAGDATE=$PIECE(RAENTRY,"-")

           SET CDATE=9999999.9999-MAGDATE

 +19       SET MAGDATE=$TRANSLATE($$FMTE^XLFDT(CDATE,"2FD")," ","0")

 +20       SET MAGPRC=$PIECE(DATA,"^")

           SET CASE=$PIECE(DATA,"^",2)

           SET STAT=$PIECE(DATA,"^",6)

 +21       SET MAGEXST=$PIECE(STAT,"~",2)

           SET MAGLOC=$PIECE(DATA,"^",7)

 +22       SET (MAGRPT,RARPT)=$PIECE(DATA,"^",5)

 +23       SET (MAGDTI,RADTI)=$PIECE(RAENTRY,"-")

 +24       SET (MAGCNI,RACNI)=$PIECE(RAENTRY,"-",2)

           SET RADFN=MAGDFN

 +25       SET MAGCASE=$$LCASE(CDATE,CASE)

           SET MAGPIEN=$$PROC(MAGPRC)

 +26      ; RADTI, RADFN, RACNI variables needed for EN1^RAUTL20

 +27       DO EN1^RAUTL20

 +28       SET (PSET,MAGPSET)=""

 +29       SET PSET=$SELECT(RAMEMLOW:"+",RAPRTSET:".",1:"")

 +30       IF PSET="."

               IF RACNI>1

                   Begin DoDot:1

 +31                   NEW OLDENTRY

                       SET OLDENTRY=$PIECE(RAENTRY,"-")_"-"

 +32                   SET OLDENTRY=$ORDER(^TMP($JOB,"RAE1",MAGDFN,OLDENTRY))

                       IF $LENGTH(OLDENTRY)

                           Begin DoDot:2

 +33                           SET MAGCASE=$PIECE(^TMP($JOB,"RAE1",MAGDFN,OLDENTRY),"^",2)

 +34                           SET CDATE=$PIECE(RAENTRY,"-")

 +35                           SET CDATE=9999999.9999-CDATE

 +36                           SET MAGCASE=$$LCASE^MAGDRA2(CDATE,MAGCASE)

                               SET RACNI=$PIECE(OLDENTRY,"-",2)

 +37                           SET MAGPST=CASE_" is part of this printset."

 +38                           QUIT

                           End DoDot:2

 +39                   QUIT

                   End DoDot:1

 +40       IF $DATA(RAPRTSET)

               SET PP=$SELECT(MAGCNI>1:".",MAGCNI=1:"+",1:"")

 +41       SET MAGCNI=RACNI

 +42       WRITE !,"PATIENT: ",MAGNME,?51,$$PIDLABEL^MAGSPID(),": ",MAGPID

 +43       WRITE !,"Case No.",?15,"Procedure",?42,"Location",?64,"Exam Date"

 +44       WRITE !,"________",?15,"_________",?42,"________________",?64,"________"

 +45       WRITE !,$GET(PP),CASE,$$IMG(MAGRPT),?15,MAGPRC,?42,MAGLOC,?64,MAGDATE

 +46       WRITE !,"Exam status: ",MAGEXST," "," ",$GET(MAGPST)

 +47       DO MAGDY

 +48       QUIT

 +49      ;

MAGDY     ;

 +1        SET MAGDY=MAGDFN_"^"_MAGNME_"^"_MAGPID_"^"_MAGCASE_"^"_MAGPRC_"^"_MAGDTI

 +2        SET MAGDY=MAGDY_"^"_MAGCNI_"^"_MAGPIEN_"^"_$GET(MAGPST)_"^"

 +3        KILL MAGNME,MAGPID,MAGCASE,MAGPRC,MAGDTI,MAGCNI,MAGPIEN,MAPST

 +4        QUIT

 +5       ;

MAGDRA2.m