MAGDQR06.m

MAGDQR06 ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve ; 03 Apr 2012 11:26 AM

 ;;3.0;IMAGING;**54,66,118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013

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

 ;

Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R  Accession Number

 ; sensitive/employee?

 I SENSEMP D  Q  ; yes, scrub

 . N WRKDT

 . S WRKDT=$$DT^XLFDT

 . S V(T)=$E(WRKDT,4,7)_$E(WRKDT,2,3)_"-0000"

 . Q

 ; no

 S V(T)=$G(^TMP("MAG",$J,"ACCESSION"))

 Q

 ;

Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R  Study ID

 ; sensitive/employee?

 I SENSEMP D  Q  ; yes, scrub

 . N I S I=$O(REQ(T,"")) S V(T)=$S(I:$S($G(REQ(T,I))]"":REQ(T,I),1:"0"),1:"0")

 . Q

 ; no

 S V(T)=$G(^TMP("MAG",$J,"ACCESSION"))

 S V(T)=$P(V(T),"-",$L(V(T),"-")) ; case # or consult # only

 Q

 ;

Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  SOP Classes in Study

 ; --- probably not supported --- ?

 ; ? ? ?

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Referring Physician's Name

 N IMGTYPE

 ; sensitive/employee?

 I SENSEMP D  Q  ; yes, scrub

 . S V(T)="IMAGPROVIDER,SENSITIVE"

 . Q

 ; no

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 D:IMGTYPE="R"

 . S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",14) ; IA # 1172

 . S V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 . Q

 D:IMGTYPE="C"

 . N G0

 . I MAGIEN="" S V(T)="" Q

 . S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q

 . S V(T)=$$GET1^DIQ(123,G0,10,"E") ; IA # 4110

 . Q

 ; MLH: do not match per WP 3/25/09

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Study Description

 ; sensitive/employee?

 I SENSEMP D  Q  ; yes, scrub

 . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")

 . Q

 ; no

 S V(T)=$$STYDESC2^MAGUE001(TYPE,MAGIEN)

 S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  >Code Value

 N IMGTYPE

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 D:IMGTYPE="R"

 . S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2) ; IA # 1172

 . S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174

 . S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference

 . S V("0008,1030",1,T)=$P(X,"^",2)

 . Q

 D:IMGTYPE="C"

 . N G0

 . I MAGIEN="" S V(T)="" Q

 . S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q

 . S V(T)=$$GET1^DIQ(123,G0,4,"I") ; IA # 4110

 . Q

 Q

 ;

Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  >Code Meaning

 N IMGTYPE

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 D:IMGTYPE="R"

 . N X

 . S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2) ; IA # 1172

 . S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174

 . S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference

 . S V("0008,1030",1,T)=$P(X,"^",3)

 . Q

 D:IMGTYPE="C"

 . N G0

 . I MAGIEN="" S V(T)="" Q

 . S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q

 . S V(T)=$$GET1^DIQ(123,G0,4,"E") ; IA # 4110

 . Q

 Q

 ;

Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Name of Physician(s) Reading Study

 I SENSEMP D  Q  ; yes, scrub

 . S V(T)="IMAGPROVIDER,SENSITIVE"

 . Q

 ; no

 N IMGTYPE

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 D:IMGTYPE="R"

 . N X

 . S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17) ; IA # 1172

 . S X=$P($G(^RARPT(+X,0)),"^",9) ; IA # 1171

 . S V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 . Q

 Q:IMGTYPE="C"

 ; MLH:  do not match per WP 3/25/09

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Admitting Diagnosis Description

 ; ? ? ?

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Additional Patient History

 ; sensitive/employee?

 I SENSEMP D  Q  ; yes, scrub

 . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")

 . Q

 ; no

 N D1,I,T0,X,IMGTYPE

 N IMGTYPE

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 Q:IMGTYPE="R"

 D:IMGTYPE="C"

 . S V(T)="",TIUIX=$$TIUIX(IMGTYPE,MAGIEN)

 . D:TIUIX

 . . S X=$P($G(^TIU(8925,TIUIX,15)),"^",2) ; Signed By field

 . . S:X X=$$GET1^DIQ(200,(+X)_",",.01)

 . . S V(T)=X

 . . Q

 . Q

 S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Patient Comments

 ; ? ? ?

 ; (there is a modality that passes the accession number in this field)

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Interpretation Author

 N X,IMGTYPE

 I SENSEMP D  Q  ; yes, scrub

 . S V(T)="IMAGPROVIDER,SENSITIVE"

 . Q

 ; no

 N IMGTYPE

 S IMGTYPE=TYPE

 D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful

 D:IMGTYPE="R"

 . S X=+$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",12) ; IA # 1172

 . S V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 . Q

 D:IMGTYPE="C"

 . N TIUIX

 . S V(T)="",TIUIX=$$TIUIX(IMGTYPE,MAGIEN)

 . D:TIUIX

 . . S X=$P($G(^TIU(8925,TIUIX,15)),"^",2) ; Signed By field

 . . S:X X=$$GET1^DIQ(200,(+X)_",",.01)

 . . S V(T)=X

 . . Q

 . Q

 ; MLH:  do not match per WP 3/25/09

 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 Q

 ;

GMRC(ACCNUM,IMAGE) ; Return consult number for image

 N X

 D  ; perform appropriate lookup for old / new database structure

 . N G0,T0

 . S G0=$$GMRCIEN^MAGDFCNV($G(ACCNUM)) I G0 S X=G0 Q

 . S TIUIX=$$TIUIX(TYPE,IMAGE) I 'TIUIX S X=0 Q

 . S X=$P($G(^TIU(8925,TIUIX,14)),"^",5) I X'[";GMR(123," S X=0 Q

 . S X=0 ; unresolvable IEN

 . Q

 Q +X

 ;

TIUIX(TYPE,STUDYIX) ; FUNCTION - find the TIU note index corresponding to a study's procedure

 ; perform appropriate lookup for old / new database structure

 D:TYPE'="N"  ; old structure

 . N X

 . S X=$G(^MAG(2005,STUDYIX,2))

 . S:$P(X,"^",6)=8925 TIUIX=+$P(X,"^",7)

 . Q

 D:TYPE="N"  ; new structure

 . N PROCIX

 . S PROCIX=$P($G(^MAGV(2005.62,STUDYIX,6)),"^",1) Q:'PROCIX

 . S:$P($G(^MAGV(2005.61,PROCIX,0)),"^",3)="TIU" TIUIX=$P(^(0),"^",1)

 . Q

 Q $G(TIUIX)

 ;

FINDTYP(IMGTYPE,MAGDFN,MAGIEN,MAGRORD,MAGINTERP) ; find type of image on new DB

 ; if found, will reset IMGTYPE for further processing

 N PROCIX,PROCREC,PROCTYP,PROCIDNT

 S PROCIX=$$PROCIX^MAGUE005(MAGIEN) Q:'PROCIX

 S PROCREC=$G(^MAGV(2005.61,PROCIX,0)) Q:PROCREC=""

 S PROCTYP=$P(PROCREC,"^",3),PROCIDNT=$P(PROCREC,"^",1)

 I PROCTYP="RAD" D  Q

 . N ACCARY,I

 . S I=$$ACCFIND^RAAPI(PROCIDNT,.ACCARY)

 . S I=""

 . F  S I=$O(ACCARY(I)) Q:'I  I $P(ACCARY(I),"^",1)=MAGDFN Q

 . I I S MAGRORD=$P(ACCARY(I),"^",2),MAGINTERP=$P(ACCARY(I),"^",3)

 . S IMGTYPE="R"

 . Q

 I PROCTYP="CON" D  Q

 . S IMGTYPE="C"

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGDQR06   8205     printed  Feb 18, 2025@23:27:21                                                                                                                                                                                                    Page 2

MAGDQR06  ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve ; 03 Apr 2012 11:26 AM

 +1       ;;3.0;IMAGING;**54,66,118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013

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

Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R  Accession Number

 +1       ; sensitive/employee?

 +2       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +3                NEW WRKDT

 +4                SET WRKDT=$$DT^XLFDT

 +5                SET V(T)=$EXTRACT(WRKDT,4,7)_$EXTRACT(WRKDT,2,3)_"-0000"

 +6                QUIT 

               End DoDot:1

               QUIT 

 +7       ; no

 +8        SET V(T)=$GET(^TMP("MAG",$JOB,"ACCESSION"))

 +9        QUIT 

 +10      ;

Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R  Study ID

 +1       ; sensitive/employee?

 +2       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +3                NEW I

                   SET I=$ORDER(REQ(T,""))

                   SET V(T)=$SELECT(I:$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"0"),1:"0")

 +4                QUIT 

               End DoDot:1

               QUIT 

 +5       ; no

 +6        SET V(T)=$GET(^TMP("MAG",$JOB,"ACCESSION"))

 +7       ; case # or consult # only

           SET V(T)=$PIECE(V(T),"-",$LENGTH(V(T),"-"))

 +8        QUIT 

 +9       ;

Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  SOP Classes in Study

 +1       ; --- probably not supported --- ?

 +2       ; ? ? ?

 +3       ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +4        QUIT 

 +5       ;

Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Referring Physician's Name

 +1        NEW IMGTYPE

 +2       ; sensitive/employee?

 +3       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +4                SET V(T)="IMAGPROVIDER,SENSITIVE"

 +5                QUIT 

               End DoDot:1

               QUIT 

 +6       ; no

 +7        SET IMGTYPE=TYPE

 +8       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +9        if IMGTYPE="R"

               Begin DoDot:1

 +10      ; IA # 1172

                   SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",14)

 +11               SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 +12               QUIT 

               End DoDot:1

 +13       if IMGTYPE="C"

               Begin DoDot:1

 +14               NEW G0

 +15               IF MAGIEN=""

                       SET V(T)=""

                       QUIT 

 +16               SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)

                   IF 'G0

                       SET V(T)=""

                       QUIT 

 +17      ; IA # 4110

                   SET V(T)=$$GET1^DIQ(123,G0,10,"E")

 +18               QUIT 

               End DoDot:1

 +19      ; MLH: do not match per WP 3/25/09

 +20      ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +21       QUIT 

 +22      ;

Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Study Description

 +1       ; sensitive/employee?

 +2       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +3                NEW I

                   SET I=$ORDER(REQ(T,""))

                   if I

                       SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")

 +4                QUIT 

               End DoDot:1

               QUIT 

 +5       ; no

 +6        SET V(T)=$$STYDESC2^MAGUE001(TYPE,MAGIEN)

 +7        if '$$COMPARE^MAGDQR03(T,V(T))

               SET OK=0

 +8        QUIT 

 +9       ;

Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  >Code Value

 +1        NEW IMGTYPE

 +2        SET IMGTYPE=TYPE

 +3       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +4        if IMGTYPE="R"

               Begin DoDot:1

 +5       ; IA # 1172

                   SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2)

 +6       ; IA # 1174

                   SET X=$PIECE($GET(^RAMIS(71,+X,0)),"^",9)

 +7       ; IA # 1995, supported reference

                   SET X=$$CPT^ICPTCOD(+X)

 +8                SET V("0008,1030",1,T)=$PIECE(X,"^",2)

 +9                QUIT 

               End DoDot:1

 +10       if IMGTYPE="C"

               Begin DoDot:1

 +11               NEW G0

 +12               IF MAGIEN=""

                       SET V(T)=""

                       QUIT 

 +13               SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)

                   IF 'G0

                       SET V(T)=""

                       QUIT 

 +14      ; IA # 4110

                   SET V(T)=$$GET1^DIQ(123,G0,4,"I")

 +15               QUIT 

               End DoDot:1

 +16       QUIT 

 +17      ;

Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  >Code Meaning

 +1        NEW IMGTYPE

 +2        SET IMGTYPE=TYPE

 +3       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +4        if IMGTYPE="R"

               Begin DoDot:1

 +5                NEW X

 +6       ; IA # 1172

                   SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2)

 +7       ; IA # 1174

                   SET X=$PIECE($GET(^RAMIS(71,+X,0)),"^",9)

 +8       ; IA # 1995, supported reference

                   SET X=$$CPT^ICPTCOD(+X)

 +9                SET V("0008,1030",1,T)=$PIECE(X,"^",3)

 +10               QUIT 

               End DoDot:1

 +11       if IMGTYPE="C"

               Begin DoDot:1

 +12               NEW G0

 +13               IF MAGIEN=""

                       SET V(T)=""

                       QUIT 

 +14               SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)

                   IF 'G0

                       SET V(T)=""

                       QUIT 

 +15      ; IA # 4110

                   SET V(T)=$$GET1^DIQ(123,G0,4,"E")

 +16               QUIT 

               End DoDot:1

 +17       QUIT 

 +18      ;

Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Name of Physician(s) Reading Study

 +1       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +2                SET V(T)="IMAGPROVIDER,SENSITIVE"

 +3                QUIT 

               End DoDot:1

               QUIT 

 +4       ; no

 +5        NEW IMGTYPE

 +6        SET IMGTYPE=TYPE

 +7       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +8        if IMGTYPE="R"

               Begin DoDot:1

 +9                NEW X

 +10      ; IA # 1172

                   SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17)

 +11      ; IA # 1171

                   SET X=$PIECE($GET(^RARPT(+X,0)),"^",9)

 +12               SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 +13               QUIT 

               End DoDot:1

 +14       if IMGTYPE="C"

               QUIT 

 +15      ; MLH:  do not match per WP 3/25/09

 +16      ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +17       QUIT 

 +18      ;

Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Admitting Diagnosis Description

 +1       ; ? ? ?

 +2       ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +3        QUIT 

 +4       ;

Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Additional Patient History

 +1       ; sensitive/employee?

 +2       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +3                NEW I

                   SET I=$ORDER(REQ(T,""))

                   if I

                       SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")

 +4                QUIT 

               End DoDot:1

               QUIT 

 +5       ; no

 +6        NEW D1,I,T0,X,IMGTYPE

 +7        NEW IMGTYPE

 +8        SET IMGTYPE=TYPE

 +9       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +10       if IMGTYPE="R"

               QUIT 

 +11       if IMGTYPE="C"

               Begin DoDot:1

 +12               SET V(T)=""

                   SET TIUIX=$$TIUIX(IMGTYPE,MAGIEN)

 +13               if TIUIX

                       Begin DoDot:2

 +14      ; Signed By field

                           SET X=$PIECE($GET(^TIU(8925,TIUIX,15)),"^",2)

 +15                       if X

                               SET X=$$GET1^DIQ(200,(+X)_",",.01)

 +16                       SET V(T)=X

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       if '$$COMPARE^MAGDQR03(T,V(T))

               SET OK=0

 +20       QUIT 

 +21      ;

Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Patient Comments

 +1       ; ? ? ?

 +2       ; (there is a modality that passes the accession number in this field)

 +3       ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +4        QUIT 

 +5       ;

U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O  Interpretation Author

 +1        NEW X,IMGTYPE

 +2       ; yes, scrub

           IF SENSEMP

               Begin DoDot:1

 +3                SET V(T)="IMAGPROVIDER,SENSITIVE"

 +4                QUIT 

               End DoDot:1

               QUIT 

 +5       ; no

 +6        NEW IMGTYPE

 +7        SET IMGTYPE=TYPE

 +8       ; will reset IMGTYPE if successful

           if IMGTYPE="N"

               DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)

 +9        if IMGTYPE="R"

               Begin DoDot:1

 +10      ; IA # 1172

                   SET X=+$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",12)

 +11               SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)

 +12               QUIT 

               End DoDot:1

 +13       if IMGTYPE="C"

               Begin DoDot:1

 +14               NEW TIUIX

 +15               SET V(T)=""

                   SET TIUIX=$$TIUIX(IMGTYPE,MAGIEN)

 +16               if TIUIX

                       Begin DoDot:2

 +17      ; Signed By field

                           SET X=$PIECE($GET(^TIU(8925,TIUIX,15)),"^",2)

 +18                       if X

                               SET X=$$GET1^DIQ(200,(+X)_",",.01)

 +19                       SET V(T)=X

 +20                       QUIT 

                       End DoDot:2

 +21               QUIT 

               End DoDot:1

 +22      ; MLH:  do not match per WP 3/25/09

 +23      ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0

 +24       QUIT 

 +25      ;

GMRC(ACCNUM,IMAGE) ; Return consult number for image

 +1        NEW X

 +2       ; perform appropriate lookup for old / new database structure

           Begin DoDot:1

 +3            NEW G0,T0

 +4            SET G0=$$GMRCIEN^MAGDFCNV($GET(ACCNUM))

               IF G0

                   SET X=G0

                   QUIT 

 +5            SET TIUIX=$$TIUIX(TYPE,IMAGE)

               IF 'TIUIX

                   SET X=0

                   QUIT 

 +6            SET X=$PIECE($GET(^TIU(8925,TIUIX,14)),"^",5)

               IF X'[";GMR(123,"

                   SET X=0

                   QUIT 

 +7       ; unresolvable IEN

               SET X=0

 +8            QUIT 

           End DoDot:1

 +9        QUIT +X

 +10      ;

TIUIX(TYPE,STUDYIX) ; FUNCTION - find the TIU note index corresponding to a study's procedure

 +1       ; perform appropriate lookup for old / new database structure

 +2       ; old structure

           if TYPE'="N"

               Begin DoDot:1

 +3                NEW X

 +4                SET X=$GET(^MAG(2005,STUDYIX,2))

 +5                if $PIECE(X,"^",6)=8925

                       SET TIUIX=+$PIECE(X,"^",7)

 +6                QUIT 

               End DoDot:1

 +7       ; new structure

           if TYPE="N"

               Begin DoDot:1

 +8                NEW PROCIX

 +9                SET PROCIX=$PIECE($GET(^MAGV(2005.62,STUDYIX,6)),"^",1)

                   if 'PROCIX

                       QUIT 

 +10               if $PIECE($GET(^MAGV(2005.61,PROCIX,0)),"^",3)="TIU"

                       SET TIUIX=$PIECE(^(0),"^",1)

 +11               QUIT 

               End DoDot:1

 +12       QUIT $GET(TIUIX)

 +13      ;

FINDTYP(IMGTYPE,MAGDFN,MAGIEN,MAGRORD,MAGINTERP) ; find type of image on new DB

 +1       ; if found, will reset IMGTYPE for further processing

 +2        NEW PROCIX,PROCREC,PROCTYP,PROCIDNT

 +3        SET PROCIX=$$PROCIX^MAGUE005(MAGIEN)

           if 'PROCIX

               QUIT 

 +4        SET PROCREC=$GET(^MAGV(2005.61,PROCIX,0))

           if PROCREC=""

               QUIT 

 +5        SET PROCTYP=$PIECE(PROCREC,"^",3)

           SET PROCIDNT=$PIECE(PROCREC,"^",1)

 +6        IF PROCTYP="RAD"

               Begin DoDot:1

 +7                NEW ACCARY,I

 +8                SET I=$$ACCFIND^RAAPI(PROCIDNT,.ACCARY)

 +9                SET I=""

 +10               FOR 

                       SET I=$ORDER(ACCARY(I))

                       if 'I

                           QUIT 

                       IF $PIECE(ACCARY(I),"^",1)=MAGDFN

                           QUIT 

 +11               IF I

                       SET MAGRORD=$PIECE(ACCARY(I),"^",2)

                       SET MAGINTERP=$PIECE(ACCARY(I),"^",3)

 +12               SET IMGTYPE="R"

 +13               QUIT 

               End DoDot:1

               QUIT 

 +14       IF PROCTYP="CON"

               Begin DoDot:1

 +15               SET IMGTYPE="C"

 +16               QUIT 

               End DoDot:1

               QUIT 

 +17       QUIT