BRADRAHL.m

BRADRAHL ;CMI/BJI/DAY - IHS Mods to MAGDRAHL Program to read a DICOM file [ 12/22/2011  1:31 PM ]

 ;;5.0;IHS Mods to VA radiology;**1004**;December 01, 2011

 ;

 ;IHS Modifications to the MAGDRAHL routine

 ;

 ; This routine is called from the RAAPI routine. MAGDRAHL does not

 ; exist unless the site is running Vista Imaging and has the most

 ; recent MAG patches.  This routine allows for non Vista sites

 ; to obtain a unique Study ID.

 ;

 ; This routine is invoked by RAHLR to create the HL7 ZDS segment with

 ; the Study Instance UID

 ;

 ; The following code creates a DICOM Study Instance UID from three

 ; Radiology Package variables: RADTI, RACNI, and ACNUMB

 ;

 ; Input:

 ;   RADTI -- internal subscript for the study in RADPT - reverse date/time  

 ;   RACNI -- internal subscript for the study in RADPT - counter

 ;   ACNUMB - external identifier for the study - [site number -] date-case number

 ;   

 ;

STUDYUID(RADTI,RACNI,ACNUMB) ; return the Study Instance UID

 ;

 N FLAG ;----- Flag to prevent multiple dots in a row or leading zeroes

 N I ;-------- Loop counter

 N RAW ;----- "Raw" STUDYUID

 N STATNUMB ;- Station number

 N STUDYUID ;- Resulting unique identifier

 ;

 ;Get the Station Number

 S STATNUMB=$E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)

 ;

 ;We will use the VA's UID Root

 ;S RAW=^MAGD(2006.15,1,"UID ROOT")_".1.4."_STATNUMB_"."_RADTI_"."_RACNI_"."_ACNUMB

 S RAW="1.2.840.113754"_".1.4."_STATNUMB_"."_RADTI_"."_RACNI_"."_ACNUMB

 ;

 S STUDYUID="",FLAG=0 F I=1:1:$L(RAW) D

 . N E

 . S E=$E(RAW,I)

 . S:E'?1AN E="."

 . I "123456789"[E S STUDYUID=STUDYUID_E,FLAG=1 Q

 . I E="0" S:$E(RAW,I+1)'?1AN FLAG=1 S:FLAG STUDYUID=STUDYUID_E Q

 . I E?1U S STUDYUID=STUDYUID_($A(E)),FLAG=1 Q

 . I E?1L S STUDYUID=STUDYUID_($A(E)-32),FLAG=1 Q

 . I E="." S:FLAG STUDYUID=STUDYUID_E S FLAG=0 Q

 . Q

 ;

 ; No trailing dots either

 F  Q:$E(STUDYUID,$L(STUDYUID))'="."  S STUDYUID=$E(STUDYUID,1,$L(STUDYUID)-1)

 I $L(STUDYUID)>64 S $EC=",U13-STUDY UID too long,"

 ;

 Q STUDYUID

 ;

 ;

ZDS(STUDYUID) ; returns the ZDS segment

 ;

 N HLECH1 ;--- HL7 component separator

 S HLECH1=$E(HLECH) ; HL7 component separator

 I $L(STUDYUID)>64 S $EC=",U13-STUDY UID too long,"

 Q "ZDS"_HLFS_STUDYUID_HLECH1_"VISTA"_HLECH1_"Application"_HLECH1_"DICOM"

 ;

BRADRAHL  ;CMI/BJI/DAY - IHS Mods to MAGDRAHL Program to read a DICOM file [ 12/22/2011  1:31 PM ]

 +1       ;;5.0;IHS Mods to VA radiology;**1004**;December 01, 2011

 +2       ;

 +3       ;IHS Modifications to the MAGDRAHL routine

 +4       ;

 +5       ; This routine is called from the RAAPI routine. MAGDRAHL does not

 +6       ; exist unless the site is running Vista Imaging and has the most

 +7       ; recent MAG patches.  This routine allows for non Vista sites

 +8       ; to obtain a unique Study ID.

 +9       ;

 +10      ; This routine is invoked by RAHLR to create the HL7 ZDS segment with

 +11      ; the Study Instance UID

 +12      ;

 +13      ; The following code creates a DICOM Study Instance UID from three

 +14      ; Radiology Package variables: RADTI, RACNI, and ACNUMB

 +15      ;

 +16      ; Input:

 +17      ;   RADTI -- internal subscript for the study in RADPT - reverse date/time  

 +18      ;   RACNI -- internal subscript for the study in RADPT - counter

 +19      ;   ACNUMB - external identifier for the study - [site number -] date-case number

 +20      ;   

 +21      ;

STUDYUID(RADTI,RACNI,ACNUMB) ; return the Study Instance UID

 +1       ;

 +2       ;----- Flag to prevent multiple dots in a row or leading zeroes

           NEW FLAG

 +3       ;-------- Loop counter

           NEW I

 +4       ;----- "Raw" STUDYUID

           NEW RAW

 +5       ;- Station number

           NEW STATNUMB

 +6       ;- Resulting unique identifier

           NEW STUDYUID

 +7       ;

 +8       ;Get the Station Number

 +9        SET STATNUMB=$EXTRACT($PIECE($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)

 +10      ;

 +11      ;We will use the VA's UID Root

 +12      ;S RAW=^MAGD(2006.15,1,"UID ROOT")_".1.4."_STATNUMB_"."_RADTI_"."_RACNI_"."_ACNUMB

 +13       SET RAW="1.2.840.113754"_".1.4."_STATNUMB_"."_RADTI_"."_RACNI_"."_ACNUMB

 +14      ;

 +15       SET STUDYUID=""

           SET FLAG=0

           FOR I=1:1:$LENGTH(RAW)

               Begin DoDot:1

 +16               NEW E

 +17               SET E=$EXTRACT(RAW,I)

 +18               IF E'?1AN

                       SET E="."

 +19               IF "123456789"[E

                       SET STUDYUID=STUDYUID_E

                       SET FLAG=1

                       QUIT 

 +20               IF E="0"

                       IF $EXTRACT(RAW,I+1)'?1AN

                           SET FLAG=1

                       IF FLAG

                           SET STUDYUID=STUDYUID_E

                       QUIT 

 +21               IF E?1U

                       SET STUDYUID=STUDYUID_($ASCII(E))

                       SET FLAG=1

                       QUIT 

 +22               IF E?1L

                       SET STUDYUID=STUDYUID_($ASCII(E)-32)

                       SET FLAG=1

                       QUIT 

 +23               IF E="."

                       IF FLAG

                           SET STUDYUID=STUDYUID_E

                       SET FLAG=0

                       QUIT 

 +24               QUIT 

               End DoDot:1

 +25      ;

 +26      ; No trailing dots either

 +27       FOR 

               IF $EXTRACT(STUDYUID,$LENGTH(STUDYUID))'="."

                   QUIT 

               SET STUDYUID=$EXTRACT(STUDYUID,1,$LENGTH(STUDYUID)-1)

 +28       IF $LENGTH(STUDYUID)>64

               SET $ECODE=",U13-STUDY UID too long,"

 +29      ;

 +30       QUIT STUDYUID

 +31      ;

 +32      ;

ZDS(STUDYUID) ; returns the ZDS segment

 +1       ;

 +2       ;--- HL7 component separator

           NEW HLECH1

 +3       ; HL7 component separator

           SET HLECH1=$EXTRACT(HLECH)

 +4        IF $LENGTH(STUDYUID)>64

               SET $ECODE=",U13-STUDY UID too long,"

 +5        QUIT "ZDS"_HLFS_STUDYUID_HLECH1_"VISTA"_HLECH1_"Application"_HLECH1_"DICOM"

 +6       ;