Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGTP004

MAGTP004.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q ;
  1. ;
  1. ;***** GET A LIST OF ALL UNRELEASED OR RELEASED REPORTS,
  1. ; FILTER BY BACK DAYS FOR UNRELEASED REPORTS,
  1. ; FILTER BY STATION NUMBER IF CONSULTATIONS ARE PRESENT FOR A CASE
  1. ; RPC: MAGTP GET ACTIVE
  1. ;
  1. ; .MAGRY Reference to a local or global variable where the results
  1. ; are returned to.
  1. ;
  1. ; FLAG Flag that controls execution:
  1. ;
  1. ; 0 Selects only unreleased reports.
  1. ;
  1. ; 1 Selected only released reports.
  1. ; One may go back in time by DAYS number
  1. ; of days (see next input)
  1. ;
  1. ; DAYS Number of days one may go back in time to
  1. ; retrieve data in case of released reports.
  1. ;
  1. ; STAT 1) If STATion ID is not null and in the Reading List
  1. ; in file (#2006.13) display the case if
  1. ; it has a consultation for an interpreting
  1. ; station number equal to STAT
  1. ; 2) If STAT is null, display all cases.
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; If @MAGRY@(0) 1st '^'-piece is < 0, then an error
  1. ; occurred during execution of the procedure: [code]^^[error explanation]
  1. ;
  1. ; Otherwise, the output array is as follows:
  1. ;
  1. ; @MAGRY@(0) Description
  1. ; ^01: 0
  1. ; ^02: Total Number of Lines
  1. ; ^03: "Released Reports" or "Unreleased Reports"
  1. ;
  1. ; @MAGRY@(i) Description
  1. ; ^01: Case Number
  1. ; ^02: Reserved Entry (0/1 for Not Reserved/Reserved)
  1. ; ^03: Initials of who reserved the case in the LAB DATA file (#63)
  1. ; ^04: Patient's Name
  1. ; ^05: Patient's ID Number
  1. ; ^06: Priority
  1. ; ^07: Slide(s) Available
  1. ; ^08: Date/Time Specimen Taken
  1. ; ^09: Case Status
  1. ; ^10: Site Initials
  1. ; ^11: AP Section
  1. ; ^12: Year
  1. ; ^13: Accession Number
  1. ; ^14: ICN
  1. ; ^15: Specimen Count
  1. ; ^16: Reading Method
  1. ; ^17: Patient's Short ID
  1. ; ^18: Is there a Note? (Yes/No)
  1. ; ^19: Number of image(s)
  1. ; Notes
  1. ; =====
  1. ;
  1. ; The ^TMP("MAGTP",$J,"AC") global node is used by this procedure
  1. ; if the count (CT) gets too large (CT>100).
  1. ;
  1. GETAC(MAGRY,FLAG,DAYS,STAT) ; RPC [MAGTP GET ACTIVE]
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGUTERR"
  1. K MAGRY
  1. N SITE,MAGIEN,GBLRET,TYPE,SELFLAG
  1. ; Use indirection, work if an Array or a Global Array is returned
  1. S GBLRET=0
  1. S MAGRY="MAGRY"
  1. S SELFLAG=0
  1. ;
  1. ; If STATion ID is passed, check that it is in
  1. ; the Reading List in file (#2006.13)
  1. ;
  1. I $G(STAT)]"" D Q:$D(@MAGRY@(0))=1
  1. . S SITE=$$IEN^XUAF4(STAT) ; Supported IA #2171 ; Site Number
  1. . I SITE="" S @MAGRY@(0)="-3^^Invalid Site" Q
  1. . S MAGIEN=$O(^MAG(2006.13,1,5,"B",SITE,""))
  1. . I MAGIEN="" S @MAGRY@(0)="-2^^Site Not in Reading List" Q
  1. . ;
  1. . ; Check type of Reading Site:
  1. . ; If TYPE="CONSULTATION", select only the cases with their station number matching STAT
  1. . ;
  1. . S TYPE=$$GET1^DIQ(2006.135,MAGIEN_",1,",.02)
  1. . I TYPE="CONSULTATION" S SELFLAG=1
  1. . Q
  1. N CT,TODAY,REC,LRSS,YEAR,LRX,LRAA,LRAC
  1. N LRAN,LRSF,LRDFN,LRI,IEN,RDATE,RDADD
  1. N PNM,DFN,LRAC,OUTPUT,TEXT,ST,XDT,IN,XREC
  1. S FLAG=$G(FLAG,0) ; Default to unreleased
  1. S CT=0
  1. S TODAY=+$$NOW^XLFDT ; Present date for comparison
  1. ;; Search Accession/Case Worklist #2005.42 instead
  1. S ST=$S($G(FLAG)=1:"R",1:"U") ;READ - Released, UNREAD - Un released
  1. S XDT=0 F S XDT=$O(^MAG(2005.42,"C",ST,XDT)) Q:'XDT D
  1. . S IN=0 F S IN=$O(^MAG(2005.42,"C",ST,XDT,IN)) Q:'IN D
  1. . . S XREC=$G(^MAG(2005.42,IN,0)),LRAC=$P(XREC,U) Q:LRAC=""
  1. . . S LRSS=$P(LRAC," ")
  1. . . S LRSF=$S(LRSS="CY":63.09,LRSS="EM":63.02,1:63.08)
  1. . . S YEAR=DT\10000*10000,LRAA=$O(^LRO(68,"B",LRSS,0))
  1. . . S LRAN=+$P(LRAC," ",3) Q:'LRAN
  1. . . S LRDFN=$P($G(^LRO(68,LRAA,1,YEAR,1,LRAN,0)),"^",1) Q:'LRDFN
  1. . . S LRI=$P($G(^LRO(68,LRAA,1,YEAR,1,LRAN,3)),"^",5) Q:'LRI
  1. . . S IEN=LRI_","_LRDFN_","
  1. . . Q:'$$GET1^DIQ(LRSF,IEN,.01,"I") ; Skip bad entries
  1. . . S RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I") ; Release date if any
  1. . . Q:$S(RDATE:1,1:0)'=FLAG ; Unreleased/Released selection
  1. . . I FLAG D Q:(TODAY>RDADD)
  1. . . . S DAYS=$G(DAYS,90) ; Released only for last DAYS, default 90
  1. . . . S RDADD=$$FMADD^XLFDT(RDATE,DAYS) ; Calculate Release Date + DAYS
  1. . . . Q
  1. . . I SELFLAG Q:'$$ISCONSLT^MAGTP009(LRAC,SITE) ; Quit if no consultations for that case and site
  1. . . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
  1. . . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
  1. . . S REC=IN ;#2005.42 ien
  1. . . ;OUTPUT contains pieces ^02:^17 defined above in the @MAGRY@(i) description
  1. . . S OUTPUT=$$GETCASE^MAGTP009(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN)
  1. . . S CT=CT+1
  1. . . I (CT>100),'GBLRET D
  1. . . . D ARY2GLB^MAGTP009(.MAGRY)
  1. . . . S GBLRET=1
  1. . . . Q
  1. . . S @MAGRY@(CT)=LRAC_U_OUTPUT
  1. . . Q
  1. . Q
  1. ; Worklist Header
  1. S TEXT=$S(FLAG:"Released Reports",1:"Unreleased Reports")
  1. S @MAGRY@(0)="0^"_CT_U_TEXT
  1. Q ;end GETAC
  1. ;
  1. ;***** GET SPECIMEN, SMEAR/PREP/BLOCK AND STAIN/PROCEDURE/SLIDE
  1. ; INFO FOR A SPECIFIED CASE
  1. ; RPC: MAGTP GET SLIDES
  1. ;
  1. ; .MAGRY Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; LRSS AP Section
  1. ;
  1. ; YEAR Accession Year (Two figures)
  1. ;
  1. ; LRAN Accession Number
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; If MAGRY(0) 1st '^'-piece is 0, then an error
  1. ; occurred during execution of the procedure: 0^0^ ERROR explanation
  1. ;
  1. ; Otherwise, the output array is as follows:
  1. ;
  1. ; MAGRY(0) Description
  1. ; ^01: 1
  1. ; ^02: Total Number of Lines
  1. ; ^03: "Specimen"
  1. ; ^04: "Smear Prep"
  1. ; ^05: "Stain/Procedure"
  1. ; ^06: "# of Slides"
  1. ; ^07: "Last Stain Date"
  1. ;
  1. ; MAGRY(i) Description
  1. ; ^01: Specimen
  1. ; ^02: Smear Prep/Block Name
  1. ; ^03: Stain/Procedure/Slide Name
  1. ; ^04: Number of Stains/Procedures/Slides
  1. ; ^05: Date of Entry of the Last Stain/Procedure/Slide
  1. ;
  1. GETSD(MAGRY,LRSS,YEAR,LRAN) ; RPC [MAGTP GET SLIDES]
  1. K MAGRY
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. N INPUT
  1. S INPUT=$$CONTEXT^MAGTP006(.MAGRY,LRSS,YEAR,LRAN) Q:'MAGRY(0)
  1. N MAGOUT,MAGERR
  1. N LRSF,IEN,SUBF,NIEN,CT,N,SPEC
  1. N J,NIENJ,NJ,START,SMEAR,SUBFJ,SUBFK
  1. N NIENJK,NJK,SLIDE,INDX,INDXJ,INDXJK,LAST
  1. S LRSF=$P(INPUT,","),IEN=$P(INPUT,",",2,4)
  1. ; Get all info for specimen(s), then sort through it
  1. D GETS^DIQ(LRSF,IEN,".012*","IE","MAGOUT","MAGERR")
  1. I $D(MAGERR) S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1) Q
  1. S SUBF=+$$GET1^DID(LRSF,.012,"","SPECIFIER") ; Subfields of Specimen
  1. S START=$O(^DD(SUBF,1),-1),J=START
  1. ;
  1. ; Extract subfields, sub-subfields
  1. ;
  1. F S J=$O(^DD(SUBF,J)) Q:J'>0 D
  1. . S SUBFJ(J)=+$$GET1^DID(SUBF,J_",","","SPECIFIER")
  1. . S SUBFK(J)=+$$GET1^DID(SUBFJ(J),"1,","","SPECIFIER")
  1. . Q
  1. ;
  1. ; NIEN may be ordered incorrectly, set index
  1. ;
  1. S NIEN=""
  1. F S NIEN=$O(MAGOUT(SUBF,NIEN)) Q:NIEN="" D
  1. . S INDX($P(NIEN,","))=""
  1. S CT=1,N=""
  1. F S N=$O(INDX(N)) Q:N="" D
  1. . S NIEN=N_","_IEN
  1. . S SPEC=MAGOUT(SUBF,NIEN,.01,"E")
  1. . S MAGRY(CT)=SPEC ; Record specimen
  1. . S J=START
  1. . F S J=$O(^DD(SUBF,J)) Q:J'>0 D
  1. . . K INDXJ ; Subnodes: Smear Prep/Block
  1. . . S NIENJ=""
  1. . . F S NIENJ=$O(MAGOUT(SUBFJ(J),NIENJ)) Q:NIENJ="" D
  1. . . . S:$P(NIENJ,",",2)=N INDXJ($P(NIENJ,",",1,2))=""
  1. . . Q:'$D(INDXJ) ; Quit if no subnodes
  1. . . S NJ=""
  1. . . F S NJ=$O(INDXJ(NJ)) Q:NJ="" D
  1. . . . S NIENJ=NJ_","_IEN
  1. . . . S SMEAR=MAGOUT(SUBFJ(J),NIENJ,.01,"E")
  1. . . . K INDXJK ; Sub-subnodes: Stain/Procedure/Slide
  1. . . . S NIENJK=""
  1. . . . F S NIENJK=$O(MAGOUT(SUBFK(J),NIENJK)) Q:NIENJK="" D
  1. . . . . S:$P(NIENJK,",",2,3)=NJ INDXJK($P(NIENJK,",",1,3))=""
  1. . . . Q:'$D(INDXJK) ; Quit if no sub-subnodes
  1. . . . S NJK=""
  1. . . . F S NJK=$O(INDXJK(NJK)) Q:NJK="" D
  1. . . . . S NIENJK=NJK_","_IEN
  1. . . . . S SLIDE=MAGOUT(SUBFK(J),NIENJK,.01,"E")
  1. . . . . S SLIDE=SLIDE_U_MAGOUT(SUBFK(J),NIENJK,.02,"E")
  1. . . . . S SLIDE=SLIDE_U_$TR($$FMTE^XLFDT(MAGOUT(SUBFK(J),NIENJK,.04,"I"),"5Z"),"@"," ")
  1. . . . . S MAGRY(CT)=SPEC_U_SMEAR_U_SLIDE
  1. . . . . S CT=CT+1
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . ; If no slides for a specimen increase counter, output specimen only
  1. . S LAST=$O(MAGRY(""),-1)
  1. . S:$P(MAGRY(LAST),U,4)="" CT=CT+1
  1. . Q
  1. S MAGRY(0)="1^"_LAST_"^Specimen^Smear Prep^Stain/Procedure^# of Slides^Last Stain Date/Time"
  1. Q ;
  1. ;