- MAGTP004 ;WOIFO/FG,MLH - TELEPATHOLOGY RPCS ; 25 Jun 2013 3:30 PM
- ;;3.0;IMAGING;**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 ;
- ;
- ;***** GET A LIST OF ALL UNRELEASED OR RELEASED REPORTS,
- ; FILTER BY BACK DAYS FOR UNRELEASED REPORTS,
- ; FILTER BY STATION NUMBER IF CONSULTATIONS ARE PRESENT FOR A CASE
- ; RPC: MAGTP GET ACTIVE
- ;
- ; .MAGRY Reference to a local or global variable where the results
- ; are returned to.
- ;
- ; FLAG Flag that controls execution:
- ;
- ; 0 Selects only unreleased reports.
- ;
- ; 1 Selected only released reports.
- ; One may go back in time by DAYS number
- ; of days (see next input)
- ;
- ; DAYS Number of days one may go back in time to
- ; retrieve data in case of released reports.
- ;
- ; STAT 1) If STATion ID is not null and in the Reading List
- ; in file (#2006.13) display the case if
- ; it has a consultation for an interpreting
- ; station number equal to STAT
- ; 2) If STAT is null, display all cases.
- ;
- ; Return Values
- ; =============
- ;
- ; If @MAGRY@(0) 1st '^'-piece is < 0, then an error
- ; occurred during execution of the procedure: [code]^^[error explanation]
- ;
- ; Otherwise, the output array is as follows:
- ;
- ; @MAGRY@(0) Description
- ; ^01: 0
- ; ^02: Total Number of Lines
- ; ^03: "Released Reports" or "Unreleased Reports"
- ;
- ; @MAGRY@(i) Description
- ; ^01: Case Number
- ; ^02: Reserved Entry (0/1 for Not Reserved/Reserved)
- ; ^03: Initials of who reserved the case in the LAB DATA file (#63)
- ; ^04: Patient's Name
- ; ^05: Patient's ID Number
- ; ^06: Priority
- ; ^07: Slide(s) Available
- ; ^08: Date/Time Specimen Taken
- ; ^09: Case Status
- ; ^10: Site Initials
- ; ^11: AP Section
- ; ^12: Year
- ; ^13: Accession Number
- ; ^14: ICN
- ; ^15: Specimen Count
- ; ^16: Reading Method
- ; ^17: Patient's Short ID
- ; ^18: Is there a Note? (Yes/No)
- ; ^19: Number of image(s)
- ; Notes
- ; =====
- ;
- ; The ^TMP("MAGTP",$J,"AC") global node is used by this procedure
- ; if the count (CT) gets too large (CT>100).
- ;
- GETAC(MAGRY,FLAG,DAYS,STAT) ; RPC [MAGTP GET ACTIVE]
- N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGUTERR"
- K MAGRY
- N SITE,MAGIEN,GBLRET,TYPE,SELFLAG
- ; Use indirection, work if an Array or a Global Array is returned
- S GBLRET=0
- S MAGRY="MAGRY"
- S SELFLAG=0
- ;
- ; If STATion ID is passed, check that it is in
- ; the Reading List in file (#2006.13)
- ;
- I $G(STAT)]"" D Q:$D(@MAGRY@(0))=1
- . S SITE=$$IEN^XUAF4(STAT) ; Supported IA #2171 ; Site Number
- . I SITE="" S @MAGRY@(0)="-3^^Invalid Site" Q
- . S MAGIEN=$O(^MAG(2006.13,1,5,"B",SITE,""))
- . I MAGIEN="" S @MAGRY@(0)="-2^^Site Not in Reading List" Q
- . ;
- . ; Check type of Reading Site:
- . ; If TYPE="CONSULTATION", select only the cases with their station number matching STAT
- . ;
- . S TYPE=$$GET1^DIQ(2006.135,MAGIEN_",1,",.02)
- . I TYPE="CONSULTATION" S SELFLAG=1
- . Q
- N CT,TODAY,REC,LRSS,YEAR,LRX,LRAA,LRAC
- N LRAN,LRSF,LRDFN,LRI,IEN,RDATE,RDADD
- N PNM,DFN,LRAC,OUTPUT,TEXT,ST,XDT,IN,XREC
- S FLAG=$G(FLAG,0) ; Default to unreleased
- S CT=0
- S TODAY=+$$NOW^XLFDT ; Present date for comparison
- ;; Search Accession/Case Worklist #2005.42 instead
- S ST=$S($G(FLAG)=1:"R",1:"U") ;READ - Released, UNREAD - Un released
- S XDT=0 F S XDT=$O(^MAG(2005.42,"C",ST,XDT)) Q:'XDT D
- . S IN=0 F S IN=$O(^MAG(2005.42,"C",ST,XDT,IN)) Q:'IN D
- . . S XREC=$G(^MAG(2005.42,IN,0)),LRAC=$P(XREC,U) Q:LRAC=""
- . . S LRSS=$P(LRAC," ")
- . . S LRSF=$S(LRSS="CY":63.09,LRSS="EM":63.02,1:63.08)
- . . S YEAR=DT\10000*10000,LRAA=$O(^LRO(68,"B",LRSS,0))
- . . S LRAN=+$P(LRAC," ",3) Q:'LRAN
- . . S LRDFN=$P($G(^LRO(68,LRAA,1,YEAR,1,LRAN,0)),"^",1) Q:'LRDFN
- . . S LRI=$P($G(^LRO(68,LRAA,1,YEAR,1,LRAN,3)),"^",5) Q:'LRI
- . . S IEN=LRI_","_LRDFN_","
- . . Q:'$$GET1^DIQ(LRSF,IEN,.01,"I") ; Skip bad entries
- . . S RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I") ; Release date if any
- . . Q:$S(RDATE:1,1:0)'=FLAG ; Unreleased/Released selection
- . . I FLAG D Q:(TODAY>RDADD)
- . . . S DAYS=$G(DAYS,90) ; Released only for last DAYS, default 90
- . . . S RDADD=$$FMADD^XLFDT(RDATE,DAYS) ; Calculate Release Date + DAYS
- . . . Q
- . . I SELFLAG Q:'$$ISCONSLT^MAGTP009(LRAC,SITE) ; Quit if no consultations for that case and site
- . . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
- . . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
- . . S REC=IN ;#2005.42 ien
- . . ;OUTPUT contains pieces ^02:^17 defined above in the @MAGRY@(i) description
- . . S OUTPUT=$$GETCASE^MAGTP009(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN)
- . . S CT=CT+1
- . . I (CT>100),'GBLRET D
- . . . D ARY2GLB^MAGTP009(.MAGRY)
- . . . S GBLRET=1
- . . . Q
- . . S @MAGRY@(CT)=LRAC_U_OUTPUT
- . . Q
- . Q
- ; Worklist Header
- S TEXT=$S(FLAG:"Released Reports",1:"Unreleased Reports")
- S @MAGRY@(0)="0^"_CT_U_TEXT
- Q ;end GETAC
- ;
- ;***** GET SPECIMEN, SMEAR/PREP/BLOCK AND STAIN/PROCEDURE/SLIDE
- ; INFO FOR A SPECIFIED CASE
- ; RPC: MAGTP GET SLIDES
- ;
- ; .MAGRY Reference to a local variable where the results
- ; are returned to.
- ;
- ; LRSS AP Section
- ;
- ; YEAR Accession Year (Two figures)
- ;
- ; LRAN Accession Number
- ;
- ; Return Values
- ; =============
- ;
- ; If MAGRY(0) 1st '^'-piece is 0, then an error
- ; occurred during execution of the procedure: 0^0^ ERROR explanation
- ;
- ; Otherwise, the output array is as follows:
- ;
- ; MAGRY(0) Description
- ; ^01: 1
- ; ^02: Total Number of Lines
- ; ^03: "Specimen"
- ; ^04: "Smear Prep"
- ; ^05: "Stain/Procedure"
- ; ^06: "# of Slides"
- ; ^07: "Last Stain Date"
- ;
- ; MAGRY(i) Description
- ; ^01: Specimen
- ; ^02: Smear Prep/Block Name
- ; ^03: Stain/Procedure/Slide Name
- ; ^04: Number of Stains/Procedures/Slides
- ; ^05: Date of Entry of the Last Stain/Procedure/Slide
- ;
- GETSD(MAGRY,LRSS,YEAR,LRAN) ; RPC [MAGTP GET SLIDES]
- K MAGRY
- N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
- N INPUT
- S INPUT=$$CONTEXT^MAGTP006(.MAGRY,LRSS,YEAR,LRAN) Q:'MAGRY(0)
- N MAGOUT,MAGERR
- N LRSF,IEN,SUBF,NIEN,CT,N,SPEC
- N J,NIENJ,NJ,START,SMEAR,SUBFJ,SUBFK
- N NIENJK,NJK,SLIDE,INDX,INDXJ,INDXJK,LAST
- S LRSF=$P(INPUT,","),IEN=$P(INPUT,",",2,4)
- ; Get all info for specimen(s), then sort through it
- D GETS^DIQ(LRSF,IEN,".012*","IE","MAGOUT","MAGERR")
- I $D(MAGERR) S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1) Q
- S SUBF=+$$GET1^DID(LRSF,.012,"","SPECIFIER") ; Subfields of Specimen
- S START=$O(^DD(SUBF,1),-1),J=START
- ;
- ; Extract subfields, sub-subfields
- ;
- F S J=$O(^DD(SUBF,J)) Q:J'>0 D
- . S SUBFJ(J)=+$$GET1^DID(SUBF,J_",","","SPECIFIER")
- . S SUBFK(J)=+$$GET1^DID(SUBFJ(J),"1,","","SPECIFIER")
- . Q
- ;
- ; NIEN may be ordered incorrectly, set index
- ;
- S NIEN=""
- F S NIEN=$O(MAGOUT(SUBF,NIEN)) Q:NIEN="" D
- . S INDX($P(NIEN,","))=""
- S CT=1,N=""
- F S N=$O(INDX(N)) Q:N="" D
- . S NIEN=N_","_IEN
- . S SPEC=MAGOUT(SUBF,NIEN,.01,"E")
- . S MAGRY(CT)=SPEC ; Record specimen
- . S J=START
- . F S J=$O(^DD(SUBF,J)) Q:J'>0 D
- . . K INDXJ ; Subnodes: Smear Prep/Block
- . . S NIENJ=""
- . . F S NIENJ=$O(MAGOUT(SUBFJ(J),NIENJ)) Q:NIENJ="" D
- . . . S:$P(NIENJ,",",2)=N INDXJ($P(NIENJ,",",1,2))=""
- . . Q:'$D(INDXJ) ; Quit if no subnodes
- . . S NJ=""
- . . F S NJ=$O(INDXJ(NJ)) Q:NJ="" D
- . . . S NIENJ=NJ_","_IEN
- . . . S SMEAR=MAGOUT(SUBFJ(J),NIENJ,.01,"E")
- . . . K INDXJK ; Sub-subnodes: Stain/Procedure/Slide
- . . . S NIENJK=""
- . . . F S NIENJK=$O(MAGOUT(SUBFK(J),NIENJK)) Q:NIENJK="" D
- . . . . S:$P(NIENJK,",",2,3)=NJ INDXJK($P(NIENJK,",",1,3))=""
- . . . Q:'$D(INDXJK) ; Quit if no sub-subnodes
- . . . S NJK=""
- . . . F S NJK=$O(INDXJK(NJK)) Q:NJK="" D
- . . . . S NIENJK=NJK_","_IEN
- . . . . S SLIDE=MAGOUT(SUBFK(J),NIENJK,.01,"E")
- . . . . S SLIDE=SLIDE_U_MAGOUT(SUBFK(J),NIENJK,.02,"E")
- . . . . S SLIDE=SLIDE_U_$TR($$FMTE^XLFDT(MAGOUT(SUBFK(J),NIENJK,.04,"I"),"5Z"),"@"," ")
- . . . . S MAGRY(CT)=SPEC_U_SMEAR_U_SLIDE
- . . . . S CT=CT+1
- . . . . Q
- . . . Q
- . . Q
- . ; If no slides for a specimen increase counter, output specimen only
- . S LAST=$O(MAGRY(""),-1)
- . S:$P(MAGRY(LAST),U,4)="" CT=CT+1
- . Q
- S MAGRY(0)="1^"_LAST_"^Specimen^Smear Prep^Stain/Procedure^# of Slides^Last Stain Date/Time"
- Q ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP004 10191 printed Feb 18, 2025@23:35:07 Page 2
- MAGTP004 ;WOIFO/FG,MLH - TELEPATHOLOGY RPCS ; 25 Jun 2013 3:30 PM
- +1 ;;3.0;IMAGING;**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 ;
- +19 ;***** GET A LIST OF ALL UNRELEASED OR RELEASED REPORTS,
- +20 ; FILTER BY BACK DAYS FOR UNRELEASED REPORTS,
- +21 ; FILTER BY STATION NUMBER IF CONSULTATIONS ARE PRESENT FOR A CASE
- +22 ; RPC: MAGTP GET ACTIVE
- +23 ;
- +24 ; .MAGRY Reference to a local or global variable where the results
- +25 ; are returned to.
- +26 ;
- +27 ; FLAG Flag that controls execution:
- +28 ;
- +29 ; 0 Selects only unreleased reports.
- +30 ;
- +31 ; 1 Selected only released reports.
- +32 ; One may go back in time by DAYS number
- +33 ; of days (see next input)
- +34 ;
- +35 ; DAYS Number of days one may go back in time to
- +36 ; retrieve data in case of released reports.
- +37 ;
- +38 ; STAT 1) If STATion ID is not null and in the Reading List
- +39 ; in file (#2006.13) display the case if
- +40 ; it has a consultation for an interpreting
- +41 ; station number equal to STAT
- +42 ; 2) If STAT is null, display all cases.
- +43 ;
- +44 ; Return Values
- +45 ; =============
- +46 ;
- +47 ; If @MAGRY@(0) 1st '^'-piece is < 0, then an error
- +48 ; occurred during execution of the procedure: [code]^^[error explanation]
- +49 ;
- +50 ; Otherwise, the output array is as follows:
- +51 ;
- +52 ; @MAGRY@(0) Description
- +53 ; ^01: 0
- +54 ; ^02: Total Number of Lines
- +55 ; ^03: "Released Reports" or "Unreleased Reports"
- +56 ;
- +57 ; @MAGRY@(i) Description
- +58 ; ^01: Case Number
- +59 ; ^02: Reserved Entry (0/1 for Not Reserved/Reserved)
- +60 ; ^03: Initials of who reserved the case in the LAB DATA file (#63)
- +61 ; ^04: Patient's Name
- +62 ; ^05: Patient's ID Number
- +63 ; ^06: Priority
- +64 ; ^07: Slide(s) Available
- +65 ; ^08: Date/Time Specimen Taken
- +66 ; ^09: Case Status
- +67 ; ^10: Site Initials
- +68 ; ^11: AP Section
- +69 ; ^12: Year
- +70 ; ^13: Accession Number
- +71 ; ^14: ICN
- +72 ; ^15: Specimen Count
- +73 ; ^16: Reading Method
- +74 ; ^17: Patient's Short ID
- +75 ; ^18: Is there a Note? (Yes/No)
- +76 ; ^19: Number of image(s)
- +77 ; Notes
- +78 ; =====
- +79 ;
- +80 ; The ^TMP("MAGTP",$J,"AC") global node is used by this procedure
- +81 ; if the count (CT) gets too large (CT>100).
- +82 ;
- GETAC(MAGRY,FLAG,DAYS,STAT) ; RPC [MAGTP GET ACTIVE]
- +1 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERRA^MAGUTERR"
- +2 KILL MAGRY
- +3 NEW SITE,MAGIEN,GBLRET,TYPE,SELFLAG
- +4 ; Use indirection, work if an Array or a Global Array is returned
- +5 SET GBLRET=0
- +6 SET MAGRY="MAGRY"
- +7 SET SELFLAG=0
- +8 ;
- +9 ; If STATion ID is passed, check that it is in
- +10 ; the Reading List in file (#2006.13)
- +11 ;
- +12 IF $GET(STAT)]""
- Begin DoDot:1
- +13 ; Supported IA #2171 ; Site Number
- SET SITE=$$IEN^XUAF4(STAT)
- +14 IF SITE=""
- SET @MAGRY@(0)="-3^^Invalid Site"
- QUIT
- +15 SET MAGIEN=$ORDER(^MAG(2006.13,1,5,"B",SITE,""))
- +16 IF MAGIEN=""
- SET @MAGRY@(0)="-2^^Site Not in Reading List"
- QUIT
- +17 ;
- +18 ; Check type of Reading Site:
- +19 ; If TYPE="CONSULTATION", select only the cases with their station number matching STAT
- +20 ;
- +21 SET TYPE=$$GET1^DIQ(2006.135,MAGIEN_",1,",.02)
- +22 IF TYPE="CONSULTATION"
- SET SELFLAG=1
- +23 QUIT
- End DoDot:1
- if $DATA(@MAGRY@(0))=1
- QUIT
- +24 NEW CT,TODAY,REC,LRSS,YEAR,LRX,LRAA,LRAC
- +25 NEW LRAN,LRSF,LRDFN,LRI,IEN,RDATE,RDADD
- +26 NEW PNM,DFN,LRAC,OUTPUT,TEXT,ST,XDT,IN,XREC
- +27 ; Default to unreleased
- SET FLAG=$GET(FLAG,0)
- +28 SET CT=0
- +29 ; Present date for comparison
- SET TODAY=+$$NOW^XLFDT
- +30 ;; Search Accession/Case Worklist #2005.42 instead
- +31 ;READ - Released, UNREAD - Un released
- SET ST=$SELECT($GET(FLAG)=1:"R",1:"U")
- +32 SET XDT=0
- FOR
- SET XDT=$ORDER(^MAG(2005.42,"C",ST,XDT))
- if 'XDT
- QUIT
- Begin DoDot:1
- +33 SET IN=0
- FOR
- SET IN=$ORDER(^MAG(2005.42,"C",ST,XDT,IN))
- if 'IN
- QUIT
- Begin DoDot:2
- +34 SET XREC=$GET(^MAG(2005.42,IN,0))
- SET LRAC=$PIECE(XREC,U)
- if LRAC=""
- QUIT
- +35 SET LRSS=$PIECE(LRAC," ")
- +36 SET LRSF=$SELECT(LRSS="CY":63.09,LRSS="EM":63.02,1:63.08)
- +37 SET YEAR=DT\10000*10000
- SET LRAA=$ORDER(^LRO(68,"B",LRSS,0))
- +38 SET LRAN=+$PIECE(LRAC," ",3)
- if 'LRAN
- QUIT
- +39 SET LRDFN=$PIECE($GET(^LRO(68,LRAA,1,YEAR,1,LRAN,0)),"^",1)
- if 'LRDFN
- QUIT
- +40 SET LRI=$PIECE($GET(^LRO(68,LRAA,1,YEAR,1,LRAN,3)),"^",5)
- if 'LRI
- QUIT
- +41 SET IEN=LRI_","_LRDFN_","
- +42 ; Skip bad entries
- if '$$GET1^DIQ(LRSF,IEN,.01,"I")
- QUIT
- +43 ; Release date if any
- SET RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I")
- +44 ; Unreleased/Released selection
- if $SELECT(RDATE
- QUIT
- +45 IF FLAG
- Begin DoDot:3
- +46 ; Released only for last DAYS, default 90
- SET DAYS=$GET(DAYS,90)
- +47 ; Calculate Release Date + DAYS
- SET RDADD=$$FMADD^XLFDT(RDATE,DAYS)
- +48 QUIT
- End DoDot:3
- if (TODAY>RDADD)
- QUIT
- +49 ; Quit if no consultations for that case and site
- IF SELFLAG
- if '$$ISCONSLT^MAGTP009(LRAC,SITE)
- QUIT
- +50 SET PNM=$$GET1^DIQ(63,LRDFN_",",".03")
- +51 SET DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
- +52 ;#2005.42 ien
- SET REC=IN
- +53 ;OUTPUT contains pieces ^02:^17 defined above in the @MAGRY@(i) description
- +54 SET OUTPUT=$$GETCASE^MAGTP009(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN)
- +55 SET CT=CT+1
- +56 IF (CT>100)
- IF 'GBLRET
- Begin DoDot:3
- +57 DO ARY2GLB^MAGTP009(.MAGRY)
- +58 SET GBLRET=1
- +59 QUIT
- End DoDot:3
- +60 SET @MAGRY@(CT)=LRAC_U_OUTPUT
- +61 QUIT
- End DoDot:2
- +62 QUIT
- End DoDot:1
- +63 ; Worklist Header
- +64 SET TEXT=$SELECT(FLAG:"Released Reports",1:"Unreleased Reports")
- +65 SET @MAGRY@(0)="0^"_CT_U_TEXT
- +66 ;end GETAC
- QUIT
- +67 ;
- +68 ;***** GET SPECIMEN, SMEAR/PREP/BLOCK AND STAIN/PROCEDURE/SLIDE
- +69 ; INFO FOR A SPECIFIED CASE
- +70 ; RPC: MAGTP GET SLIDES
- +71 ;
- +72 ; .MAGRY Reference to a local variable where the results
- +73 ; are returned to.
- +74 ;
- +75 ; LRSS AP Section
- +76 ;
- +77 ; YEAR Accession Year (Two figures)
- +78 ;
- +79 ; LRAN Accession Number
- +80 ;
- +81 ; Return Values
- +82 ; =============
- +83 ;
- +84 ; If MAGRY(0) 1st '^'-piece is 0, then an error
- +85 ; occurred during execution of the procedure: 0^0^ ERROR explanation
- +86 ;
- +87 ; Otherwise, the output array is as follows:
- +88 ;
- +89 ; MAGRY(0) Description
- +90 ; ^01: 1
- +91 ; ^02: Total Number of Lines
- +92 ; ^03: "Specimen"
- +93 ; ^04: "Smear Prep"
- +94 ; ^05: "Stain/Procedure"
- +95 ; ^06: "# of Slides"
- +96 ; ^07: "Last Stain Date"
- +97 ;
- +98 ; MAGRY(i) Description
- +99 ; ^01: Specimen
- +100 ; ^02: Smear Prep/Block Name
- +101 ; ^03: Stain/Procedure/Slide Name
- +102 ; ^04: Number of Stains/Procedures/Slides
- +103 ; ^05: Date of Entry of the Last Stain/Procedure/Slide
- +104 ;
- GETSD(MAGRY,LRSS,YEAR,LRAN) ; RPC [MAGTP GET SLIDES]
- +1 KILL MAGRY
- +2 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERRA^MAGGTERR"
- +3 NEW INPUT
- +4 SET INPUT=$$CONTEXT^MAGTP006(.MAGRY,LRSS,YEAR,LRAN)
- if 'MAGRY(0)
- QUIT
- +5 NEW MAGOUT,MAGERR
- +6 NEW LRSF,IEN,SUBF,NIEN,CT,N,SPEC
- +7 NEW J,NIENJ,NJ,START,SMEAR,SUBFJ,SUBFK
- +8 NEW NIENJK,NJK,SLIDE,INDX,INDXJ,INDXJK,LAST
- +9 SET LRSF=$PIECE(INPUT,",")
- SET IEN=$PIECE(INPUT,",",2,4)
- +10 ; Get all info for specimen(s), then sort through it
- +11 DO GETS^DIQ(LRSF,IEN,".012*","IE","MAGOUT","MAGERR")
- +12 IF $DATA(MAGERR)
- SET MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
- QUIT
- +13 ; Subfields of Specimen
- SET SUBF=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
- +14 SET START=$ORDER(^DD(SUBF,1),-1)
- SET J=START
- +15 ;
- +16 ; Extract subfields, sub-subfields
- +17 ;
- +18 FOR
- SET J=$ORDER(^DD(SUBF,J))
- if J'>0
- QUIT
- Begin DoDot:1
- +19 SET SUBFJ(J)=+$$GET1^DID(SUBF,J_",","","SPECIFIER")
- +20 SET SUBFK(J)=+$$GET1^DID(SUBFJ(J),"1,","","SPECIFIER")
- +21 QUIT
- End DoDot:1
- +22 ;
- +23 ; NIEN may be ordered incorrectly, set index
- +24 ;
- +25 SET NIEN=""
- +26 FOR
- SET NIEN=$ORDER(MAGOUT(SUBF,NIEN))
- if NIEN=""
- QUIT
- Begin DoDot:1
- +27 SET INDX($PIECE(NIEN,","))=""
- End DoDot:1
- +28 SET CT=1
- SET N=""
- +29 FOR
- SET N=$ORDER(INDX(N))
- if N=""
- QUIT
- Begin DoDot:1
- +30 SET NIEN=N_","_IEN
- +31 SET SPEC=MAGOUT(SUBF,NIEN,.01,"E")
- +32 ; Record specimen
- SET MAGRY(CT)=SPEC
- +33 SET J=START
- +34 FOR
- SET J=$ORDER(^DD(SUBF,J))
- if J'>0
- QUIT
- Begin DoDot:2
- +35 ; Subnodes: Smear Prep/Block
- KILL INDXJ
- +36 SET NIENJ=""
- +37 FOR
- SET NIENJ=$ORDER(MAGOUT(SUBFJ(J),NIENJ))
- if NIENJ=""
- QUIT
- Begin DoDot:3
- +38 if $PIECE(NIENJ,",",2)=N
- SET INDXJ($PIECE(NIENJ,",",1,2))=""
- End DoDot:3
- +39 ; Quit if no subnodes
- if '$DATA(INDXJ)
- QUIT
- +40 SET NJ=""
- +41 FOR
- SET NJ=$ORDER(INDXJ(NJ))
- if NJ=""
- QUIT
- Begin DoDot:3
- +42 SET NIENJ=NJ_","_IEN
- +43 SET SMEAR=MAGOUT(SUBFJ(J),NIENJ,.01,"E")
- +44 ; Sub-subnodes: Stain/Procedure/Slide
- KILL INDXJK
- +45 SET NIENJK=""
- +46 FOR
- SET NIENJK=$ORDER(MAGOUT(SUBFK(J),NIENJK))
- if NIENJK=""
- QUIT
- Begin DoDot:4
- +47 if $PIECE(NIENJK,",",2,3)=NJ
- SET INDXJK($PIECE(NIENJK,",",1,3))=""
- End DoDot:4
- +48 ; Quit if no sub-subnodes
- if '$DATA(INDXJK)
- QUIT
- +49 SET NJK=""
- +50 FOR
- SET NJK=$ORDER(INDXJK(NJK))
- if NJK=""
- QUIT
- Begin DoDot:4
- +51 SET NIENJK=NJK_","_IEN
- +52 SET SLIDE=MAGOUT(SUBFK(J),NIENJK,.01,"E")
- +53 SET SLIDE=SLIDE_U_MAGOUT(SUBFK(J),NIENJK,.02,"E")
- +54 SET SLIDE=SLIDE_U_$TRANSLATE($$FMTE^XLFDT(MAGOUT(SUBFK(J),NIENJK,.04,"I"),"5Z"),"@"," ")
- +55 SET MAGRY(CT)=SPEC_U_SMEAR_U_SLIDE
- +56 SET CT=CT+1
- +57 QUIT
- End DoDot:4
- +58 QUIT
- End DoDot:3
- +59 QUIT
- End DoDot:2
- +60 ; If no slides for a specimen increase counter, output specimen only
- +61 SET LAST=$ORDER(MAGRY(""),-1)
- +62 if $PIECE(MAGRY(LAST),U,4)=""
- SET CT=CT+1
- +63 QUIT
- End DoDot:1
- +64 SET MAGRY(0)="1^"_LAST_"^Specimen^Smear Prep^Stain/Procedure^# of Slides^Last Stain Date/Time"
- +65 ;
- QUIT
- +66 ;