MAGTP013 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:08 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 SELECTED UNRELEASED OR RELEASED REPORTS
; RPC: MAGTP GET CASES
;
; .MAGRY Reference to a local or global variable where the results
; are returned to.
;
; .ENT Input array. The case numbers must be
; listed one on each line.
;
; 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 if all case numbers sent in array ENT were found
; 1 if one or more case numbers sent in array ENT were not found
; ^02: Total Number of Lines
;
; @MAGRY@(i) Description
; ^01: Case Number
; (if case not found, error description will follow
; and pieces 2-19 will not be populated)
; ^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: Employee/Sensitive? (1=Yes/0=No)
;
GETCAS(MAGRY,ENT) ; RPC [MAGTP GET CASES]
K MAGRY
I $D(ENT)<10 S MAGRY(0)="-2^^No Input" Q
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGUTERR"
N CT,BDFLG,LINE,LRAC,LRSS,YEAR
N LRAN,LRSF,LRX,LRDFN,LRI,IEN
N RDATE,FLAG,PNM,DFN,REC,OUTPUT,LRAA,YR,LRACC
S (CT,LINE)=""
S BDFLG=0 ; If BDFLG=1 there's a bad entry
F S LINE=$O(ENT(LINE)) Q:LINE=""!(BDFLG) D
. S LRAC=ENT(LINE) ;Ex: 'SP 13 12' ; Read case number
. S LRSS=$E(LRAC,1,2)
. S YEAR=$E(LRAC,4,5)
. S LRAN=$E(LRAC,7,$L(LRAC))
. S CT=CT+1
. I LRAN'?1.N S MAGRY(CT)=LRAC_": Invalid Accession Number",BDFLG=1 Q
. ; Only these three AP Sections considered
. S LRSF=$S(LRSS="CY":63.09,LRSS="EM":63.02,LRSS="SP":63.08,1:"")
. I LRSF="" S MAGRY(CT)=LRAC_": Invalid AP Section",BDFLG=1 Q
. S LRX="A"_LRSS_"A"
. ; Find 3-digit year in index
. S YR=$S($D(^LR(LRX,200+YEAR)):200+YEAR,$D(^LR(LRX,300+YEAR)):300+YEAR,1:"")
. I YR="" S MAGRY(CT)=LRAC_": Invalid Year "_YEAR,BDFLG=1 Q
. I '$D(^LR(LRX,YEAR,LRSS,LRAN)) D ; Try new style case(s) after LEDI
. . S LRAA=$O(^LRO(68,"B",LRSS,0)),IEN="" ; Number for #68 Acc - CY EM SP
. . F YR=(300+YEAR*10000),(200+YEAR*10000) D Q:IEN'="" ; YR 2000, 1900
. . . S LRDFN=+$P($G(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1)
. . . I 'LRDFN S MAGRY(CT)=LRAC_": Record Not Found LRDFN" Q
. . . S LRI=+$P($G(^LRO(68,LRAA,1,YR,1,LRAN,3)),"^",5)
. . . I 'LRI S MAGRY(CT)=LRAC_": Record Not Found LRI" Q
. . . S IEN=LRI_","_LRDFN_","
. . . S LRACC=$G(^LRO(68,LRAA,1,YR,1,LRAN,.2)) Q:LRACC="" ; Accession
. . . S REC=$O(^MAG(2005.42,"B",LRACC,""))_"," ; Record Number worklist
. . . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
. . . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I"),FLAG=$G(FLAG,0)
. . . S OUTPUT=$$GETCASE^MAGTP009(LRSS,LRACC,LRSF,IEN,REC,FLAG,PNM,DFN)
. . . S MAGRY(CT)=LRACC_U_OUTPUT
. . . Q ; OUTPUT contains pieces ^02:^17 defined above in the MAGRY(i) description
. . I IEN=""!(LRACC="") S MAGRY(CT)=LRAC_": Record Not Found In #68",BDFLG=1
. . Q
. I $D(^LR(LRX,YR,LRSS,LRAN)) D ;old style before LEDI
. . S LRDFN=$O(^LR(LRX,YR,LRSS,LRAN,""))
. . I LRDFN="" S MAGRY(CT)=LRAC_": Record Not Found LRDFN",BDFLG=1 Q
. . S LRI=$O(^LR(LRX,YR,LRSS,LRAN,LRDFN,""))
. . I LRI="" S MAGRY(CT)=LRAC_": Record Not Found LRI",BDFLG=1 Q
. . S IEN=LRI_","_LRDFN_","
. . S RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I") ; Release date if any
. . S FLAG=$S(RDATE:1,1:0)
. . S PNM=$$GET1^DIQ(63,LRDFN_",",".03")
. . S DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
. . S REC=$O(^MAG(2005.42,"B",LRAC,""))_","
. . ; 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 MAGRY(CT)=LRAC_U_OUTPUT
. . Q
. Q
;
; Header
;
S MAGRY(0)=BDFLG_"^"_CT
Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGTP013 5795 printed Apr 09, 2024@21:10:23 Page 2
MAGTP013 ;WOIFO/FG,MLH,JSL - TELEPATHOLOGY RPCS ; 25 Jul 2013 5:08 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 SELECTED UNRELEASED OR RELEASED REPORTS
+20 ; RPC: MAGTP GET CASES
+21 ;
+22 ; .MAGRY Reference to a local or global variable where the results
+23 ; are returned to.
+24 ;
+25 ; .ENT Input array. The case numbers must be
+26 ; listed one on each line.
+27 ;
+28 ; Return Values
+29 ; =============
+30 ;
+31 ; If @MAGRY@(0) 1st '^'-piece is < 0, then an error
+32 ; occurred during execution of the procedure: [code]^^[error explanation]
+33 ;
+34 ; Otherwise, the output array is as follows:
+35 ;
+36 ; @MAGRY@(0) Description
+37 ; ^01: 0 if all case numbers sent in array ENT were found
+38 ; 1 if one or more case numbers sent in array ENT were not found
+39 ; ^02: Total Number of Lines
+40 ;
+41 ; @MAGRY@(i) Description
+42 ; ^01: Case Number
+43 ; (if case not found, error description will follow
+44 ; and pieces 2-19 will not be populated)
+45 ; ^02: Reserved Entry (0/1 for Not Reserved/Reserved)
+46 ; ^03: Initials of who reserved the case in the LAB DATA file (#63)
+47 ; ^04: Patient's Name
+48 ; ^05: Patient's ID Number
+49 ; ^06: Priority
+50 ; ^07: Slide(s) Available
+51 ; ^08: Date/Time Specimen Taken
+52 ; ^09: Case Status
+53 ; ^10: Site Initials
+54 ; ^11: AP Section
+55 ; ^12: Year
+56 ; ^13: Accession Number
+57 ; ^14: ICN
+58 ; ^15: Specimen Count
+59 ; ^16: Reading Method
+60 ; ^17: Patient's Short ID
+61 ; ^18: Is there a Note? (Yes/No)
+62 ; ^19: Employee/Sensitive? (1=Yes/0=No)
+63 ;
GETCAS(MAGRY,ENT) ; RPC [MAGTP GET CASES]
+1 KILL MAGRY
+2 IF $DATA(ENT)<10
SET MAGRY(0)="-2^^No Input"
QUIT
+3 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGUTERR"
+4 NEW CT,BDFLG,LINE,LRAC,LRSS,YEAR
+5 NEW LRAN,LRSF,LRX,LRDFN,LRI,IEN
+6 NEW RDATE,FLAG,PNM,DFN,REC,OUTPUT,LRAA,YR,LRACC
+7 SET (CT,LINE)=""
+8 ; If BDFLG=1 there's a bad entry
SET BDFLG=0
+9 FOR
SET LINE=$ORDER(ENT(LINE))
if LINE=""!(BDFLG)
QUIT
Begin DoDot:1
+10 ;Ex: 'SP 13 12' ; Read case number
SET LRAC=ENT(LINE)
+11 SET LRSS=$EXTRACT(LRAC,1,2)
+12 SET YEAR=$EXTRACT(LRAC,4,5)
+13 SET LRAN=$EXTRACT(LRAC,7,$LENGTH(LRAC))
+14 SET CT=CT+1
+15 IF LRAN'?1.N
SET MAGRY(CT)=LRAC_": Invalid Accession Number"
SET BDFLG=1
QUIT
+16 ; Only these three AP Sections considered
+17 SET LRSF=$SELECT(LRSS="CY":63.09,LRSS="EM":63.02,LRSS="SP":63.08,1:"")
+18 IF LRSF=""
SET MAGRY(CT)=LRAC_": Invalid AP Section"
SET BDFLG=1
QUIT
+19 SET LRX="A"_LRSS_"A"
+20 ; Find 3-digit year in index
+21 SET YR=$SELECT($DATA(^LR(LRX,200+YEAR)):200+YEAR,$DATA(^LR(LRX,300+YEAR)):300+YEAR,1:"")
+22 IF YR=""
SET MAGRY(CT)=LRAC_": Invalid Year "_YEAR
SET BDFLG=1
QUIT
+23 ; Try new style case(s) after LEDI
IF '$DATA(^LR(LRX,YEAR,LRSS,LRAN))
Begin DoDot:2
+24 ; Number for #68 Acc - CY EM SP
SET LRAA=$ORDER(^LRO(68,"B",LRSS,0))
SET IEN=""
+25 ; YR 2000, 1900
FOR YR=(300+YEAR*10000),(200+YEAR*10000)
Begin DoDot:3
+26 SET LRDFN=+$PIECE($GET(^LRO(68,LRAA,1,YR,1,LRAN,0)),"^",1)
+27 IF 'LRDFN
SET MAGRY(CT)=LRAC_": Record Not Found LRDFN"
QUIT
+28 SET LRI=+$PIECE($GET(^LRO(68,LRAA,1,YR,1,LRAN,3)),"^",5)
+29 IF 'LRI
SET MAGRY(CT)=LRAC_": Record Not Found LRI"
QUIT
+30 SET IEN=LRI_","_LRDFN_","
+31 ; Accession
SET LRACC=$GET(^LRO(68,LRAA,1,YR,1,LRAN,.2))
if LRACC=""
QUIT
+32 ; Record Number worklist
SET REC=$ORDER(^MAG(2005.42,"B",LRACC,""))_","
+33 SET PNM=$$GET1^DIQ(63,LRDFN_",",".03")
+34 SET DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
SET FLAG=$GET(FLAG,0)
+35 SET OUTPUT=$$GETCASE^MAGTP009(LRSS,LRACC,LRSF,IEN,REC,FLAG,PNM,DFN)
+36 SET MAGRY(CT)=LRACC_U_OUTPUT
+37 ; OUTPUT contains pieces ^02:^17 defined above in the MAGRY(i) description
QUIT
End DoDot:3
if IEN'=""
QUIT
+38 IF IEN=""!(LRACC="")
SET MAGRY(CT)=LRAC_": Record Not Found In #68"
SET BDFLG=1
+39 QUIT
End DoDot:2
+40 ;old style before LEDI
IF $DATA(^LR(LRX,YR,LRSS,LRAN))
Begin DoDot:2
+41 SET LRDFN=$ORDER(^LR(LRX,YR,LRSS,LRAN,""))
+42 IF LRDFN=""
SET MAGRY(CT)=LRAC_": Record Not Found LRDFN"
SET BDFLG=1
QUIT
+43 SET LRI=$ORDER(^LR(LRX,YR,LRSS,LRAN,LRDFN,""))
+44 IF LRI=""
SET MAGRY(CT)=LRAC_": Record Not Found LRI"
SET BDFLG=1
QUIT
+45 SET IEN=LRI_","_LRDFN_","
+46 ; Release date if any
SET RDATE=+$$GET1^DIQ(LRSF,IEN,.11,"I")
+47 SET FLAG=$SELECT(RDATE:1,1:0)
+48 SET PNM=$$GET1^DIQ(63,LRDFN_",",".03")
+49 SET DFN=$$GET1^DIQ(63,LRDFN_",",".03","I")
+50 SET REC=$ORDER(^MAG(2005.42,"B",LRAC,""))_","
+51 ; OUTPUT contains pieces ^02:^17 defined above in the MAGRY(i) description
+52 SET OUTPUT=$$GETCASE^MAGTP009(LRSS,LRAC,LRSF,IEN,REC,FLAG,PNM,DFN)
+53 SET MAGRY(CT)=LRAC_U_OUTPUT
+54 QUIT
End DoDot:2
+55 QUIT
End DoDot:1
+56 ;
+57 ; Header
+58 ;
+59 SET MAGRY(0)=BDFLG_"^"_CT
+60 ;
QUIT
