- MAGDRPCG ;WOIFO/PMK - Imaging RPCs ; Dec 06, 2021@10:34:52
- ;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
- ;; 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. |
- ;; +---------------------------------------------------------------+
- ;;
- ;
- GETLRDFN(OUT,DFN,LRSSLIST) ; RPC = MAG DICOM GET LAB PAT LRDFN
- N LRDFN
- I '$D(DFN) S OUT="-1,DFN required" Q
- I DFN'?1N.N S OUT="-2,DFN must be a numeric value, not """_DFN_"""" Q
- I '$D(^DPT(DFN)) S OUT="-3,Patient with DFN """_DFN_""" is not defined" Q
- I '$D(LRSSLIST) S OUT="-4,List of LRSS values is required" Q
- S LRDFN=$$GET1^DIQ(2,DFN,63)
- I LRDFN="" S OUT="-5,Patient has no Laboratory studies"
- E D
- . N HIT,I,MSG,N
- . S HIT=0,MSG="-6,Patient has no Anatomic Pathology ",N=$O(LRSSLIST(""),-1)
- . F I=1:1 Q:'$D(LRSSLIST(I)) D Q:HIT
- . . S LRSS=LRSSLIST(I) I $D(^LR(LRDFN,LRSS)) S HIT=1 Q
- . . S MSG=MSG_LRSS
- . . I I=1 S MSG=MSG_$S(N=2:" or ",N=3:", ",1:"")
- . . I I=2 S MSG=MSG_$S(N=3:", or ",1:"")
- . . Q
- . I 'HIT S OUT=MSG_" studies"
- . E S OUT=LRDFN
- . Q
- Q
- ;
- GETDFN(OUT,LRDFN) ; RPC = MAG DICOM GET LAB PAT DFN
- N FILENAME
- I '$D(LRDFN) S OUT="-1,LRDFN required" Q
- I LRDFN'?1N.N S OUT="-2,LRDFN must be a numeric value, not """_LRDFN_"""" Q
- I '$D(^LR(LRDFN)) S OUT="-3,Patient with LRDFN """_LRDFN_""" is not defined in LAB file (#63)" Q
- ; check for PATIENT file (#2)
- S FILENAME=$$GET1^DIQ(63,LRDFN,.02)
- I FILENAME'="PATIENT" D Q
- . S OUT="-4,Patient with LRDFN """_LRDFN_""" is in the """_FILENAME_""" file, not the PATIENT file (#2)"
- . Q
- S OUT=$$GET1^DIQ(63,LRDFN,.03,"I")
- Q
- ;
- PATIENT(OUT,SORTORDER,LRDFN,LRSSLIST,BEGDATE,ENDDATE) ; RPC = MAG DICOM GET LAB BY PAT
- N DIRECTION,DONE,HIT,I,LRI,LRSS,NOUT,STARTDATE,STOPDATE
- K OUT
- I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
- I '$D(LRDFN) S OUT="-2,LRDFN required and may not be null" Q
- I '$D(LRSSLIST) S OUT="-3,List of LRSS values is required" Q
- I '$D(BEGDATE) S OUT="-4,BEGDATE required and may not be null" Q
- I '$D(ENDDATE) S OUT="-5,ENDDATE required and may not be null" Q
- ;
- I SORTORDER="ASCENDING" D
- . S DIRECTION=1
- . S STARTDATE=$$REVDATE(BEGDATE),STOPDATE=$$REVDATE(ENDDATE)
- . Q
- E I SORTORDER="DESCENDING" D
- . S DIRECTION=-1
- . S STARTDATE=$$REVDATE(ENDDATE),STOPDATE=$$REVDATE(BEGDATE)
- . Q
- E S OUT="-6,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
- ;
- S NOUT=1
- ;
- S HIT=0 F I=1:1 Q:'$D(LRSSLIST(I)) S LRSS=LRSSLIST(I) I $D(^LR(LRDFN,LRSS)) D
- . S HIT=1,DONE=0,LRI=STARTDATE ; $O thru reverse dates
- . F S LRI=$O(^LR(LRDFN,LRSS,LRI),-DIRECTION) Q:'LRI Q:DONE D
- . . I DIRECTION=1,LRI<STOPDATE S DONE=1 Q
- . . I DIRECTION=-1,LRI>STOPDATE S DONE=1 Q
- . . D LOOKUP1(LRDFN,LRSS,LRI)
- . . Q
- . Q
- I NOUT=1 D
- . I 'HIT S OUT(1)="-7,Patient has no Anatomic Pathology (CY, EM, or SR) studies"
- . E S OUT(1)="-8,Patient has no Anatomic Pathology (CY, EM, or SR) images"
- . Q
- I '$D(OUT(1)) S OUT(1)=NOUT-1 ; allow error messages to be passed back in OUT(1)
- Q
- ;
- LOOKUP(OUT,LRDFN,LRSS,LRI) ; RPC = MAG DICOM GET LAB IMAGES
- N NOUT
- K OUT
- I '$D(LRDFN) S OUT="-1,LRDFN required and may not be null" Q
- I '$D(LRSS) S OUT="-2,LRSS required" Q
- I '$D(LRI) S OUT="-3,LRI required and may not be null" Q
- ;
- S NOUT=1
- ;
- D LOOKUP1(LRDFN,LRSS,LRI)
- ;
- I NOUT=1 D
- . S OUT(1)="-4,Patient has no Anatomic Pathology (CY, EM, or SR) images"
- . Q
- I '$D(OUT(1)) S OUT(1)=NOUT-1 ; allow error messages to be passed back in OUT(1)
- Q
- ;
- LOOKUP1(LRDFN,LRSS,LRI) ; lookup an anatomic pathology image
- ; Images can be assocated with the TIU External Data file (#8925.91),
- ; or DICOM LAB TEMP LIST file (#2006.5838), or stored in the new
- ; SOP Class database IMAGE STUDY file (#2005.62) -- check all three
- N ACNUMB,NODE0X,NODE0Y,PARENTFILE
- S NODE0X=$G(^LR(LRDFN,LRSS,0)) Q:NODE0X=""
- S PARENTFILE=+$P(NODE0X,"^",2) Q:'PARENTFILE
- S NODE0Y=^LR(LRDFN,LRSS,LRI,0),ACNUMB=$P(NODE0Y,"^",6)
- ; W !,"ACNUMB = ",ACNUMB
- D TIU(LRDFN,LRSS,LRI,ACNUMB) ; check the TIU External Data file (#8925.91)
- D LABTEMP(PARENTFILE,LRDFN,LRSS,LRI,ACNUMB) ; check the DICOM LAB TEMP LIST file (#2006.5838)
- D NEWSOP(LRSS,LRI,ACNUMB) ; check the new SOP Class database IMAGE STUDY file (#2005.62)
- Q
- ;
- TIU(LRDFN,LRSS,LRI,ACNUMB) ; check for images assocated with the TIU External Data file (#8925.91)
- N MAGIEN,NODE0,TIU892591IEN,TIUIEN
- I '$D(^LR(LRDFN,LRSS,LRI,.05,"C")) Q ; there is no TIU pointer
- S TIUIEN=0
- F S TIUIEN=$O(^LR(LRDFN,LRSS,LRI,.05,"C",TIUIEN)) Q:'TIUIEN D
- . S TIU892591IEN=""
- . F S TIU892591IEN=$O(^TIU(8925.91,"B",TIUIEN,TIU892591IEN)) Q:TIU892591IEN="" D
- . . S NODE0=^TIU(8925.91,TIU892591IEN,0)
- . . S MAGIEN=$P(NODE0,"^",2)
- . . S NOUT=NOUT+1,OUT(NOUT)=MAGIEN_"^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- . . Q
- . Q
- Q
- ;
- LABTEMP(PARENTFILE,LRDFN,LRSS,LRI,ACNUMB) ; check for images assocated with the DICOM LAB TEMP LIST file (#2006.5838)
- N MAG20065838IEN,MAGIEN,NODE0
- S MAG20065838IEN=0
- S MAG20065838IEN=$O(^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,MAG20065838IEN)) Q:'MAG20065838IEN D
- . S NODE0=$G(^MAG(2006.5838,MAG20065838IEN,0)) Q:NODE0=""
- . S MAGIEN=$P(NODE0,"^",4)
- . S NOUT=NOUT+1,OUT(NOUT)=MAGIEN_"^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- . Q
- Q
- ;
- NEWSOP(LRSS,LRI,ACNUMB) ; check for images in the new SOP Class database IMAGE STUDY file (#2005.62)
- N MAGV200562
- S MAGV200562=0
- S MAGV200562=$O(^MAGV(2005.62,"D",ACNUMB,MAGV200562)) Q:'MAGV200562 D
- . S NOUT=NOUT+1,OUT(NOUT)="New SOP Class DB^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- . Q
- Q
- ;
- DATE(OUT,SUBSCRIPTLEVEL,SORTORDER,LRSS,DATE,LRDFN,LRI) ; RPC = MAG DICOM GET LAB BY DATE
- N DIRECTION,LRO
- K OUT
- I '$D(SUBSCRIPTLEVEL) S OUT="-1,SUBSCRIPT LEVEL required" Q
- I '$D(SORTORDER) S OUT="-2,SORTORDER required" Q
- I '$D(LRSS) S OUT="-3,LRSS required" Q
- I '$D(DATE) S OUT="-4,DATE required and may not be null" Q
- I '$D(LRDFN) S OUT="-5,LRDFN required and may not be null" Q
- I '$D(LRI) S OUT="-6,LRI required and may not be null" Q
- ;
- I SUBSCRIPTLEVEL'=1,SUBSCRIPTLEVEL'=2,SUBSCRIPTLEVEL'=3 S OUT="-7,SUBSCRIPT LEVEL must be either 1, 2, or 3, not """_SUBSCRIPTLEVEL_"""" q
- ;
- I SORTORDER="ASCENDING" D
- . S DIRECTION=1
- . Q
- E I SORTORDER="DESCENDING" D
- . S DIRECTION=-1
- . S:DATE=0 DATE="" S:LRDFN=0 LRDFN="" S:LRI=0 LRI="" ; needed for reverse $O
- . Q
- E S OUT="-8,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
- ;
- S LRO="A"_LRSS
- ;
- ; ^LR(LRO,DATE,LRDFN,LRI)=""
- ;
- I SUBSCRIPTLEVEL=1 S OUT=$O(^LR(LRO,DATE),DIRECTION)
- E I SUBSCRIPTLEVEL=2 S OUT=$O(^LR(LRO,DATE,LRDFN),DIRECTION)
- E I SUBSCRIPTLEVEL=3 S OUT=$O(^LR(LRO,DATE,LRDFN,LRI),DIRECTION)
- ; I SUBSCRIPTLEVEL=3,LRI W !,"LR(""",LRO,""",",DATE,",",LRDFN,",",LRI,")"
- ; W !,"LR(""",LRO,""",",DATE,",",LRDFN,",",LRI,")"
- Q
- ;
- NXTLRDFN(OUT,SORTORDER,LRDFN,LRSSLIST) ; RPC = MAG DICOM GET LAB NEXT LRDFN
- N DIRECTION,HIT,I,LRSS
- I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
- I $G(LRDFN)="" S OUT="-2,LRDFN required and may not be null" Q
- I LRDFN'?1N.N S OUT="-3,LRDFN must be a numeric value, not ""_LRDFN_""" Q
- I SORTORDER="ASCENDING" D
- . S DIRECTION=1
- . Q
- E I SORTORDER="DESCENDING" D
- . S DIRECTION=-1
- . I LRDFN=0 S LRDFN=" " ; reverse $O origin
- . Q
- E S OUT="-4,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
- ;
- I '$D(LRSSLIST) S OUT="-5,List of LRSS values is required" Q
- K OUT
- S HIT=0 F S LRDFN=+$O(^LR(LRDFN),DIRECTION) Q:LRDFN=0 D Q:HIT
- . F I=1:1 Q:'$D(LRSSLIST(I)) S LRSS=LRSSLIST(I) I $D(^LR(LRDFN,LRSS)) S HIT=1 Q
- . Q
- S OUT=+LRDFN
- ;
- Q
- ;
- REVDATE(DATE) ; convert a LAB date to a FM date and vice versa
- Q 9999999-DATE ; unlike radiology which uses 9999999.9999
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPCG 8633 printed Jan 18, 2025@03:02:48 Page 2
- MAGDRPCG ;WOIFO/PMK - Imaging RPCs ; Dec 06, 2021@10:34:52
- +1 ;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
- +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 ;
- GETLRDFN(OUT,DFN,LRSSLIST) ; RPC = MAG DICOM GET LAB PAT LRDFN
- +1 NEW LRDFN
- +2 IF '$DATA(DFN)
- SET OUT="-1,DFN required"
- QUIT
- +3 IF DFN'?1N.N
- SET OUT="-2,DFN must be a numeric value, not """_DFN_""""
- QUIT
- +4 IF '$DATA(^DPT(DFN))
- SET OUT="-3,Patient with DFN """_DFN_""" is not defined"
- QUIT
- +5 IF '$DATA(LRSSLIST)
- SET OUT="-4,List of LRSS values is required"
- QUIT
- +6 SET LRDFN=$$GET1^DIQ(2,DFN,63)
- +7 IF LRDFN=""
- SET OUT="-5,Patient has no Laboratory studies"
- +8 IF '$TEST
- Begin DoDot:1
- +9 NEW HIT,I,MSG,N
- +10 SET HIT=0
- SET MSG="-6,Patient has no Anatomic Pathology "
- SET N=$ORDER(LRSSLIST(""),-1)
- +11 FOR I=1:1
- if '$DATA(LRSSLIST(I))
- QUIT
- Begin DoDot:2
- +12 SET LRSS=LRSSLIST(I)
- IF $DATA(^LR(LRDFN,LRSS))
- SET HIT=1
- QUIT
- +13 SET MSG=MSG_LRSS
- +14 IF I=1
- SET MSG=MSG_$SELECT(N=2:" or ",N=3:", ",1:"")
- +15 IF I=2
- SET MSG=MSG_$SELECT(N=3:", or ",1:"")
- +16 QUIT
- End DoDot:2
- if HIT
- QUIT
- +17 IF 'HIT
- SET OUT=MSG_" studies"
- +18 IF '$TEST
- SET OUT=LRDFN
- +19 QUIT
- End DoDot:1
- +20 QUIT
- +21 ;
- GETDFN(OUT,LRDFN) ; RPC = MAG DICOM GET LAB PAT DFN
- +1 NEW FILENAME
- +2 IF '$DATA(LRDFN)
- SET OUT="-1,LRDFN required"
- QUIT
- +3 IF LRDFN'?1N.N
- SET OUT="-2,LRDFN must be a numeric value, not """_LRDFN_""""
- QUIT
- +4 IF '$DATA(^LR(LRDFN))
- SET OUT="-3,Patient with LRDFN """_LRDFN_""" is not defined in LAB file (#63)"
- QUIT
- +5 ; check for PATIENT file (#2)
- +6 SET FILENAME=$$GET1^DIQ(63,LRDFN,.02)
- +7 IF FILENAME'="PATIENT"
- Begin DoDot:1
- +8 SET OUT="-4,Patient with LRDFN """_LRDFN_""" is in the """_FILENAME_""" file, not the PATIENT file (#2)"
- +9 QUIT
- End DoDot:1
- QUIT
- +10 SET OUT=$$GET1^DIQ(63,LRDFN,.03,"I")
- +11 QUIT
- +12 ;
- PATIENT(OUT,SORTORDER,LRDFN,LRSSLIST,BEGDATE,ENDDATE) ; RPC = MAG DICOM GET LAB BY PAT
- +1 NEW DIRECTION,DONE,HIT,I,LRI,LRSS,NOUT,STARTDATE,STOPDATE
- +2 KILL OUT
- +3 IF '$DATA(SORTORDER)
- SET OUT="-1,SORTORDER required"
- QUIT
- +4 IF '$DATA(LRDFN)
- SET OUT="-2,LRDFN required and may not be null"
- QUIT
- +5 IF '$DATA(LRSSLIST)
- SET OUT="-3,List of LRSS values is required"
- QUIT
- +6 IF '$DATA(BEGDATE)
- SET OUT="-4,BEGDATE required and may not be null"
- QUIT
- +7 IF '$DATA(ENDDATE)
- SET OUT="-5,ENDDATE required and may not be null"
- QUIT
- +8 ;
- +9 IF SORTORDER="ASCENDING"
- Begin DoDot:1
- +10 SET DIRECTION=1
- +11 SET STARTDATE=$$REVDATE(BEGDATE)
- SET STOPDATE=$$REVDATE(ENDDATE)
- +12 QUIT
- End DoDot:1
- +13 IF '$TEST
- IF SORTORDER="DESCENDING"
- Begin DoDot:1
- +14 SET DIRECTION=-1
- +15 SET STARTDATE=$$REVDATE(ENDDATE)
- SET STOPDATE=$$REVDATE(BEGDATE)
- +16 QUIT
- End DoDot:1
- +17 IF '$TEST
- SET OUT="-6,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_""""
- QUIT
- +18 ;
- +19 SET NOUT=1
- +20 ;
- +21 SET HIT=0
- FOR I=1:1
- if '$DATA(LRSSLIST(I))
- QUIT
- SET LRSS=LRSSLIST(I)
- IF $DATA(^LR(LRDFN,LRSS))
- Begin DoDot:1
- +22 ; $O thru reverse dates
- SET HIT=1
- SET DONE=0
- SET LRI=STARTDATE
- +23 FOR
- SET LRI=$ORDER(^LR(LRDFN,LRSS,LRI),-DIRECTION)
- if 'LRI
- QUIT
- if DONE
- QUIT
- Begin DoDot:2
- +24 IF DIRECTION=1
- IF LRI<STOPDATE
- SET DONE=1
- QUIT
- +25 IF DIRECTION=-1
- IF LRI>STOPDATE
- SET DONE=1
- QUIT
- +26 DO LOOKUP1(LRDFN,LRSS,LRI)
- +27 QUIT
- End DoDot:2
- +28 QUIT
- End DoDot:1
- +29 IF NOUT=1
- Begin DoDot:1
- +30 IF 'HIT
- SET OUT(1)="-7,Patient has no Anatomic Pathology (CY, EM, or SR) studies"
- +31 IF '$TEST
- SET OUT(1)="-8,Patient has no Anatomic Pathology (CY, EM, or SR) images"
- +32 QUIT
- End DoDot:1
- +33 ; allow error messages to be passed back in OUT(1)
- IF '$DATA(OUT(1))
- SET OUT(1)=NOUT-1
- +34 QUIT
- +35 ;
- LOOKUP(OUT,LRDFN,LRSS,LRI) ; RPC = MAG DICOM GET LAB IMAGES
- +1 NEW NOUT
- +2 KILL OUT
- +3 IF '$DATA(LRDFN)
- SET OUT="-1,LRDFN required and may not be null"
- QUIT
- +4 IF '$DATA(LRSS)
- SET OUT="-2,LRSS required"
- QUIT
- +5 IF '$DATA(LRI)
- SET OUT="-3,LRI required and may not be null"
- QUIT
- +6 ;
- +7 SET NOUT=1
- +8 ;
- +9 DO LOOKUP1(LRDFN,LRSS,LRI)
- +10 ;
- +11 IF NOUT=1
- Begin DoDot:1
- +12 SET OUT(1)="-4,Patient has no Anatomic Pathology (CY, EM, or SR) images"
- +13 QUIT
- End DoDot:1
- +14 ; allow error messages to be passed back in OUT(1)
- IF '$DATA(OUT(1))
- SET OUT(1)=NOUT-1
- +15 QUIT
- +16 ;
- LOOKUP1(LRDFN,LRSS,LRI) ; lookup an anatomic pathology image
- +1 ; Images can be assocated with the TIU External Data file (#8925.91),
- +2 ; or DICOM LAB TEMP LIST file (#2006.5838), or stored in the new
- +3 ; SOP Class database IMAGE STUDY file (#2005.62) -- check all three
- +4 NEW ACNUMB,NODE0X,NODE0Y,PARENTFILE
- +5 SET NODE0X=$GET(^LR(LRDFN,LRSS,0))
- if NODE0X=""
- QUIT
- +6 SET PARENTFILE=+$PIECE(NODE0X,"^",2)
- if 'PARENTFILE
- QUIT
- +7 SET NODE0Y=^LR(LRDFN,LRSS,LRI,0)
- SET ACNUMB=$PIECE(NODE0Y,"^",6)
- +8 ; W !,"ACNUMB = ",ACNUMB
- +9 ; check the TIU External Data file (#8925.91)
- DO TIU(LRDFN,LRSS,LRI,ACNUMB)
- +10 ; check the DICOM LAB TEMP LIST file (#2006.5838)
- DO LABTEMP(PARENTFILE,LRDFN,LRSS,LRI,ACNUMB)
- +11 ; check the new SOP Class database IMAGE STUDY file (#2005.62)
- DO NEWSOP(LRSS,LRI,ACNUMB)
- +12 QUIT
- +13 ;
- TIU(LRDFN,LRSS,LRI,ACNUMB) ; check for images assocated with the TIU External Data file (#8925.91)
- +1 NEW MAGIEN,NODE0,TIU892591IEN,TIUIEN
- +2 ; there is no TIU pointer
- IF '$DATA(^LR(LRDFN,LRSS,LRI,.05,"C"))
- QUIT
- +3 SET TIUIEN=0
- +4 FOR
- SET TIUIEN=$ORDER(^LR(LRDFN,LRSS,LRI,.05,"C",TIUIEN))
- if 'TIUIEN
- QUIT
- Begin DoDot:1
- +5 SET TIU892591IEN=""
- +6 FOR
- SET TIU892591IEN=$ORDER(^TIU(8925.91,"B",TIUIEN,TIU892591IEN))
- if TIU892591IEN=""
- QUIT
- Begin DoDot:2
- +7 SET NODE0=^TIU(8925.91,TIU892591IEN,0)
- +8 SET MAGIEN=$PIECE(NODE0,"^",2)
- +9 SET NOUT=NOUT+1
- SET OUT(NOUT)=MAGIEN_"^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- +10 QUIT
- End DoDot:2
- +11 QUIT
- End DoDot:1
- +12 QUIT
- +13 ;
- LABTEMP(PARENTFILE,LRDFN,LRSS,LRI,ACNUMB) ; check for images assocated with the DICOM LAB TEMP LIST file (#2006.5838)
- +1 NEW MAG20065838IEN,MAGIEN,NODE0
- +2 SET MAG20065838IEN=0
- +3 SET MAG20065838IEN=$ORDER(^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,MAG20065838IEN))
- if 'MAG20065838IEN
- QUIT
- Begin DoDot:1
- +4 SET NODE0=$GET(^MAG(2006.5838,MAG20065838IEN,0))
- if NODE0=""
- QUIT
- +5 SET MAGIEN=$PIECE(NODE0,"^",4)
- +6 SET NOUT=NOUT+1
- SET OUT(NOUT)=MAGIEN_"^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- +7 QUIT
- End DoDot:1
- +8 QUIT
- +9 ;
- NEWSOP(LRSS,LRI,ACNUMB) ; check for images in the new SOP Class database IMAGE STUDY file (#2005.62)
- +1 NEW MAGV200562
- +2 SET MAGV200562=0
- +3 SET MAGV200562=$ORDER(^MAGV(2005.62,"D",ACNUMB,MAGV200562))
- if 'MAGV200562
- QUIT
- Begin DoDot:1
- +4 SET NOUT=NOUT+1
- SET OUT(NOUT)="New SOP Class DB^"_ACNUMB_"^"_$$REVDATE(LRI)_"^"_LRSS_"^"_LRI
- +5 QUIT
- End DoDot:1
- +6 QUIT
- +7 ;
- DATE(OUT,SUBSCRIPTLEVEL,SORTORDER,LRSS,DATE,LRDFN,LRI) ; RPC = MAG DICOM GET LAB BY DATE
- +1 NEW DIRECTION,LRO
- +2 KILL OUT
- +3 IF '$DATA(SUBSCRIPTLEVEL)
- SET OUT="-1,SUBSCRIPT LEVEL required"
- QUIT
- +4 IF '$DATA(SORTORDER)
- SET OUT="-2,SORTORDER required"
- QUIT
- +5 IF '$DATA(LRSS)
- SET OUT="-3,LRSS required"
- QUIT
- +6 IF '$DATA(DATE)
- SET OUT="-4,DATE required and may not be null"
- QUIT
- +7 IF '$DATA(LRDFN)
- SET OUT="-5,LRDFN required and may not be null"
- QUIT
- +8 IF '$DATA(LRI)
- SET OUT="-6,LRI required and may not be null"
- QUIT
- +9 ;
- +10 IF SUBSCRIPTLEVEL'=1
- IF SUBSCRIPTLEVEL'=2
- IF SUBSCRIPTLEVEL'=3
- SET OUT="-7,SUBSCRIPT LEVEL must be either 1, 2, or 3, not """_SUBSCRIPTLEVEL_""""
- QUIT
- +11 ;
- +12 IF SORTORDER="ASCENDING"
- Begin DoDot:1
- +13 SET DIRECTION=1
- +14 QUIT
- End DoDot:1
- +15 IF '$TEST
- IF SORTORDER="DESCENDING"
- Begin DoDot:1
- +16 SET DIRECTION=-1
- +17 ; needed for reverse $O
- if DATE=0
- SET DATE=""
- if LRDFN=0
- SET LRDFN=""
- if LRI=0
- SET LRI=""
- +18 QUIT
- End DoDot:1
- +19 IF '$TEST
- SET OUT="-8,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_""""
- QUIT
- +20 ;
- +21 SET LRO="A"_LRSS
- +22 ;
- +23 ; ^LR(LRO,DATE,LRDFN,LRI)=""
- +24 ;
- +25 IF SUBSCRIPTLEVEL=1
- SET OUT=$ORDER(^LR(LRO,DATE),DIRECTION)
- +26 IF '$TEST
- IF SUBSCRIPTLEVEL=2
- SET OUT=$ORDER(^LR(LRO,DATE,LRDFN),DIRECTION)
- +27 IF '$TEST
- IF SUBSCRIPTLEVEL=3
- SET OUT=$ORDER(^LR(LRO,DATE,LRDFN,LRI),DIRECTION)
- +28 ; I SUBSCRIPTLEVEL=3,LRI W !,"LR(""",LRO,""",",DATE,",",LRDFN,",",LRI,")"
- +29 ; W !,"LR(""",LRO,""",",DATE,",",LRDFN,",",LRI,")"
- +30 QUIT
- +31 ;
- NXTLRDFN(OUT,SORTORDER,LRDFN,LRSSLIST) ; RPC = MAG DICOM GET LAB NEXT LRDFN
- +1 NEW DIRECTION,HIT,I,LRSS
- +2 IF '$DATA(SORTORDER)
- SET OUT="-1,SORTORDER required"
- QUIT
- +3 IF $GET(LRDFN)=""
- SET OUT="-2,LRDFN required and may not be null"
- QUIT
- +4 IF LRDFN'?1N.N
- SET OUT="-3,LRDFN must be a numeric value, not ""_LRDFN_"""
- QUIT
- +5 IF SORTORDER="ASCENDING"
- Begin DoDot:1
- +6 SET DIRECTION=1
- +7 QUIT
- End DoDot:1
- +8 IF '$TEST
- IF SORTORDER="DESCENDING"
- Begin DoDot:1
- +9 SET DIRECTION=-1
- +10 ; reverse $O origin
- IF LRDFN=0
- SET LRDFN=" "
- +11 QUIT
- End DoDot:1
- +12 IF '$TEST
- SET OUT="-4,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_""""
- QUIT
- +13 ;
- +14 IF '$DATA(LRSSLIST)
- SET OUT="-5,List of LRSS values is required"
- QUIT
- +15 KILL OUT
- +16 SET HIT=0
- FOR
- SET LRDFN=+$ORDER(^LR(LRDFN),DIRECTION)
- if LRDFN=0
- QUIT
- Begin DoDot:1
- +17 FOR I=1:1
- if '$DATA(LRSSLIST(I))
- QUIT
- SET LRSS=LRSSLIST(I)
- IF $DATA(^LR(LRDFN,LRSS))
- SET HIT=1
- QUIT
- +18 QUIT
- End DoDot:1
- if HIT
- QUIT
- +19 SET OUT=+LRDFN
- +20 ;
- +21 QUIT
- +22 ;
- REVDATE(DATE) ; convert a LAB date to a FM date and vice versa
- +1 ; unlike radiology which uses 9999999.9999
- QUIT 9999999-DATE