| [613] | 1 | MAGGTLB ;WOIFO/LB - RPC call for Laboratory/Imaging interface ; [ 11/24/2004 04:06 ]
|
|---|
| 2 | ;;3.0;IMAGING;**48**;Jan 11, 2005
|
|---|
| 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 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | Q
|
|---|
| 19 | ;This routine is called from the Laboratory Image capture window.
|
|---|
| 20 | ;The line tag SECT is used for selection of the Laboratory section.
|
|---|
| 21 | ;The line tag STAIN is used for selection of Histological stain.
|
|---|
| 22 | ;The line tag MICRO is used for selection of Microscopic Objective.
|
|---|
| 23 | ;The line tag START is used for selection of the specimen that the image
|
|---|
| 24 | ;relates to. This line tag will require a lab section (Autopsy/
|
|---|
| 25 | ;Gross, Autopsy/Microscopic, EM, Surgical Path, or Cytology),
|
|---|
| 26 | ;the Accession year, and either an Accession # or Autopsy #. Based on
|
|---|
| 27 | ;this information it will return an array of specimens for selection.
|
|---|
| 28 | ;
|
|---|
| 29 | START(MAGRY,SECT,YR,ACNUM,XXX) ;RPC Call to Return a list of specimens
|
|---|
| 30 | ; -Removed DFN (XXX) -no longer being used for lookup
|
|---|
| 31 | ;SECT = Lab entry from 2005.03
|
|---|
| 32 | ;YR = 4 digits of year (1700-2000's)
|
|---|
| 33 | ;ACNUM = Accession number or autopsy number
|
|---|
| 34 | ;Returns an array of specimens for the year_accession#.
|
|---|
| 35 | ;MAGRY(#)=Piece 1 = Pt Name piece 2 = Ssn
|
|---|
| 36 | ; 3 = Date/Time 4 = Accn #
|
|---|
| 37 | ; 5 = Pathologist 6 = Specimen
|
|---|
| 38 | ; 7 = Ien for file 2005.03 8 = Dfn
|
|---|
| 39 | ; 9 = Lrdfn 10 = Ien for date/time
|
|---|
| 40 | ; 11 = Ien specimen 12 = Lab section subfile
|
|---|
| 41 | ; imaging field number
|
|---|
| 42 | ; 13 = LR global being referenced
|
|---|
| 43 | ;the MAGRY(0)=0 or # lines in array^status (success or no success)
|
|---|
| 44 | ;the MAGRY(1)=titles for the grid array
|
|---|
| 45 | N Y,YEAR
|
|---|
| 46 | IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
|
|---|
| 47 | E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
|
|---|
| 48 | S MAGRY(0)="0^No Data",DATA=0
|
|---|
| 49 | S MAGRY(1)="Name^SSN^Date/Time^Acc #^Pathologist^Specimen"
|
|---|
| 50 | N CNT,NUM,DATE,ANUM,NUM,DATA,LRDFN,LRI,LINE,MAGI,DATE,PATH,SPEC,MAGABV
|
|---|
| 51 | N MAGNODE,MAGSSN,PAT,MAGSECT,FILE,DATA,MAGDFN,MAGNM,MAGX,X0
|
|---|
| 52 | S DATA=0
|
|---|
| 53 | S LINE=2
|
|---|
| 54 | S MAGRY(0)="0^No specimen information found, please enter via DHCP Lab application"
|
|---|
| 55 | I '$G(SECT)!('$G(ACNUM))!($L(YR)'=4) D Q
|
|---|
| 56 | . S MAGRY(0)="0^Incorrect variables sent"
|
|---|
| 57 | S MAGABV=$P(SECT,"~",2),SECT=$P(SECT,"~")
|
|---|
| 58 | Q:'$D(^MAG(2005.03,SECT,0))
|
|---|
| 59 | S MAGSECT=$P(^MAG(2005.03,SECT,0),"^"),MAGI=$E($P(^(0),"^",2),1)
|
|---|
| 60 | S MAGNODE=$S(MAGI="S":"SP",MAGI="E":"EM",MAGI="C":"CY",1:"AU")
|
|---|
| 61 | S MAGX="A"_MAGNODE_"A"
|
|---|
| 62 | ;Xref to search accession year and accession/autopsy #.
|
|---|
| 63 | I YR<1700 S MAGRY(0)="0^=Invalid year provided" Q
|
|---|
| 64 | S YEAR=YR,YR=YEAR-1700
|
|---|
| 65 | ;2001-1700 =301 Fileman internal & YR2K compliance
|
|---|
| 66 | ;Checked with Lab developers, still setting 3digit year in xref
|
|---|
| 67 | ;S YR=$S(YR>1999:3_$E(YR,3,4),1:2_$E(YR,3,4)) ;CODE FOR YRS >1999
|
|---|
| 68 | ;Checking MUMPs x-ref which can not be done via FM DB silent calls.
|
|---|
| 69 | I '$D(^LR(MAGX,YR,MAGABV,ACNUM)) D Q
|
|---|
| 70 | . S MAGRY(0)="0^Accession number "_MAGABV_" "_YEAR_" "_ACNUM_" is invalid"
|
|---|
| 71 | . ;No data for the year accession #
|
|---|
| 72 | S LRDFN=$O(^LR(MAGX,YR,MAGABV,ACNUM,0)),LRI=$O(^(LRDFN,0))
|
|---|
| 73 | S MAGDFN=$P(^LR(LRDFN,0),"^",3),FILE=$P(^LR(LRDFN,0),"^",2)
|
|---|
| 74 | I FILE=2 S X=^DPT(MAGDFN,0),MAGNM=$P(X,"^"),MAGSSN=$P(X,"^",9) ;Patient file
|
|---|
| 75 | I FILE[67 D Q:MAGNM=""
|
|---|
| 76 | . D GETS^DIQ(67,MAGDFN,".01;.09","E",MAGZZ,MAGERR)
|
|---|
| 77 | . I $D(MAGERR("DIERR")) S MAGRY(0)="0^Patient lookup failed" Q
|
|---|
| 78 | . S MAGNM=$G(MAGZZ(67,MAGDFN_",",".01","E"))
|
|---|
| 79 | . S MAGSSN=$G(MAGZZ(67,MAGDFN_",",".09","E"))
|
|---|
| 80 | I "ASCE"'[MAGI Q ;Not a valid lab section (Autopsy,Surgical Path, Cytology or EM)
|
|---|
| 81 | S MAGNODE=$S(MAGI="S":"SP",MAGI="E":"EM",MAGI="C":"CY",1:"AY")
|
|---|
| 82 | G:MAGNODE="AY" AUTOPSY ;Need this because 2005.03 does not reference the right node.
|
|---|
| 83 | Q:'$D(^LR(LRDFN,MAGNODE,LRI,0))
|
|---|
| 84 | S X0=^LR(LRDFN,MAGNODE,LRI,0),PATH=$P(X0,"^",2),NUM=$P(X0,"^",6)
|
|---|
| 85 | S DATE=$P(X0,"^",1),ANUM=NUM
|
|---|
| 86 | LOOK ;
|
|---|
| 87 | S PATH=$S('PATH:"UNKNOWN",1:$$GET1^DIQ(200,PATH_",",.01))
|
|---|
| 88 | S YEAR=$E(DATE,1,3)+1700 ;4 digit year
|
|---|
| 89 | ; YR2K Compliance 301+1700=2001
|
|---|
| 90 | S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_YEAR
|
|---|
| 91 | S X=0 F S X=$O(^LR(LRDFN,MAGNODE,LRI,.1,X)) Q:'X D
|
|---|
| 92 | . S SPEC=$P($G(^LR(LRDFN,MAGNODE,LRI,.1,X,0)),"^")
|
|---|
| 93 | . S MAGRY(LINE)=MAGNM_"^"_MAGSSN_"^"_DATE_"^"_ANUM_"^"_PATH_"^"_SPEC_"^"_SECT_"^"_MAGDFN_"^"_LRDFN_"^"_LRI_"^"_X_"^"_"2005"_"^"_"LR("_LRDFN_","""_MAGNODE_""","_LRI_",.1,"_X
|
|---|
| 94 | . S DATA=1,LINE=LINE+1
|
|---|
| 95 | I DATA S MAGRY(0)=(LINE-2)_"^"_"DATA FOUND"
|
|---|
| 96 | Q
|
|---|
| 97 | AUTOPSY ;
|
|---|
| 98 | N MAGERR,MAGRYLN,MAGZZ,XX
|
|---|
| 99 | S (MAGERR,MAGZZ)=""
|
|---|
| 100 | S X0=^LR(LRDFN,"AU"),DATE=$P(X0,"^"),NUM=$P(X0,"^",6)
|
|---|
| 101 | S PATH=$P(X0,"^",7),ANUM=NUM
|
|---|
| 102 | S PATH=$S('PATH:"UNKNOWN",1:$$GET1^DIQ(200,PATH_",",.01))
|
|---|
| 103 | ; DATE in line below, was DATA ( DATA was a misprint ) GEK
|
|---|
| 104 | S YEAR=$E(DATE,1,3)+1700 ;4 digit year
|
|---|
| 105 | ; YR2K compliance 301+1700= 2001
|
|---|
| 106 | S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_YEAR
|
|---|
| 107 | S XX=0 F S XX=$O(^LR(LRDFN,MAGNODE,XX)) Q:'XX D
|
|---|
| 108 | . Q:'$D(^LR(LRDFN,MAGNODE,XX,0))
|
|---|
| 109 | . S SPEC=$P(^LR(LRDFN,MAGNODE,XX,0),"^")
|
|---|
| 110 | . D GETS^DIQ(61,SPEC,".01","E","MAGZZ","MAGERR")
|
|---|
| 111 | . S SPEC=$S($D(MAGERR("DIERR")):"UNKNOWN",1:$G(MAGZZ(61,SPEC_",",".01","E")))
|
|---|
| 112 | . S MAGRYLN=""
|
|---|
| 113 | . S MAGRYLN=MAGNM_"^"_MAGSSN_"^"_DATE_"^"_ANUM_"^"_PATH_"^"_SPEC
|
|---|
| 114 | . S MAGRYLN=MAGRYLN_"^"_SECT_"^"_MAGDFN_"^"_LRDFN_"^^"_XX
|
|---|
| 115 | . S MAGRYLN=MAGRYLN_"^"_$S(MAGSECT["GROSS":2005,1:2005.1)
|
|---|
| 116 | . S MAGRYLN=MAGRYLN_"^"_"LR("_LRDFN_","""_MAGNODE_""","_XX
|
|---|
| 117 | . S MAGRY(LINE)=MAGRYLN
|
|---|
| 118 | . S DATA=1,LINE=LINE+1
|
|---|
| 119 | I DATA S MAGRY(0)=(LINE-2)_"^"_"DATA FOUND"
|
|---|
| 120 | I 'DATA S MAGRY(0)="0^No organ/tissue defined for this autopsy."
|
|---|
| 121 | ;If MAGSECT[ "GROSS" then the field # is 2005 for subfile 63.2
|
|---|
| 122 | ;else the field # is 2005.1 for the same subfile (AUTOPSY ORGAN/TISSUE).
|
|---|
| 123 | Q
|
|---|
| 124 | STAIN(MAGRY) ;RPC Call to return array of entries from
|
|---|
| 125 | ; file 2005.4, Image Histological Stain.
|
|---|
| 126 | ;
|
|---|
| 127 | S MAGRY(0)="0^No Entries found for file 2005.4"
|
|---|
| 128 | Q:'$D(^MAG(2005.4,0)) ;Imaging file not defined.
|
|---|
| 129 | N ENTRY,CNT,DATA,BLANK
|
|---|
| 130 | S ENTRY=0,CNT=1,DATA=0,$P(BLANK," ",30)=" "
|
|---|
| 131 | F S ENTRY=$O(^MAG(2005.4,ENTRY)) Q:'ENTRY D
|
|---|
| 132 | . Q:'$D(^MAG(2005.4,ENTRY,0)) S X=$P(^MAG(2005.4,ENTRY,0),"^")
|
|---|
| 133 | . S MAGRY(CNT)=X_BLANK_"^"_X,CNT=CNT+1,DATA=1
|
|---|
| 134 | I DATA S MAGRY(0)="1^DATA FOUND"_U_(CNT-1)
|
|---|
| 135 | Q
|
|---|
| 136 | MICRO(MAGRY) ;RPC Call to Return array of entries from
|
|---|
| 137 | ; file 2005.41, Microscopic Objective
|
|---|
| 138 | S MAGRY(0)="0^No entries found for file 2005.41"
|
|---|
| 139 | Q:'$D(^MAG(2005.41,0)) ;Imaging file not defined.
|
|---|
| 140 | N ENTRY,CNT,DATA,BLANK
|
|---|
| 141 | S ENTRY=0,CNT=1,DATA=0,$P(BLANK," ",30)=" "
|
|---|
| 142 | F S ENTRY=$O(^MAG(2005.41,ENTRY)) Q:'ENTRY D
|
|---|
| 143 | . Q:'$D(^MAG(2005.41,ENTRY,0)) S X=$P(^MAG(2005.41,ENTRY,0),"^")
|
|---|
| 144 | . S MAGRY(CNT)=X_BLANK_"^"_X,CNT=CNT+1,DATA=1
|
|---|
| 145 | I DATA S MAGRY(0)="1^DATA FOUND"_"^"_(CNT-1)
|
|---|
| 146 | Q
|
|---|
| 147 | SECT(MAGRY) ;RPC Call to Build Pathology selection
|
|---|
| 148 | ; from file 68 accordingly to user's division
|
|---|
| 149 | ;MAGRY - Returns array of lab section name, section abbreviation
|
|---|
| 150 | ; used in defining the accession number & xref lookup,
|
|---|
| 151 | ; as well as the IEN in Imaging Parent file.
|
|---|
| 152 | N Y,A,B,BLANK,MAGABV,MAGERR,MAGIEN,MAGNM,MAGNNM,MAGSEC,MAGTYPE,DATA
|
|---|
| 153 | IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
|
|---|
| 154 | E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP")
|
|---|
| 155 | S MAGRY(0)="0^No entries found^0"
|
|---|
| 156 | S MAGSEC="SPCYEMAU",(A,B)=0,$P(BLANK," ",30)="" D CK Q:MAGERR
|
|---|
| 157 | F S A=$O(^LRO(68,A)) Q:'A D
|
|---|
| 158 | . I MAGSEC[$P($G(^LRO(68,A,0)),"^",2),$P(^LRO(68,A,0),"^",2)]"""",$G(^LRO(68,A,3,+DUZ(2),0)) D
|
|---|
| 159 | . . S MAGABV=$P(^LRO(68,A,0),"^",11) Q:MAGABV="" ;No abbreviation defined
|
|---|
| 160 | . . S MAGTYPE=$P(^LRO(68,A,0),"^",2),MAGNM=$P(^LRO(68,A,0),"^")
|
|---|
| 161 | . . Q:MAGSEC'[MAGTYPE D PARENT ;Must be pathology section.
|
|---|
| 162 | . . S B=B+1,DATA=1,MAGRY(B)=MAGNM_BLANK_"^"_MAGIEN_"~"_MAGABV
|
|---|
| 163 | I '$D(DATA) S MAGRY(0)="0^No entries found for your division^0" Q
|
|---|
| 164 | I DATA S B=B+1,MAGRY(0)="1^Entries found^"_B
|
|---|
| 165 | Q
|
|---|
| 166 | CK ;Check for valid division.
|
|---|
| 167 | S MAGERR=1
|
|---|
| 168 | N MAGSITE,MAGER
|
|---|
| 169 | S MAGSITE=+DUZ(2)
|
|---|
| 170 | I 'MAGSITE D Q
|
|---|
| 171 | . S MAGRY(0)="0^You don't have a division setup."
|
|---|
| 172 | ; gek/ change : ..."A",MAGSITE... to ..."","`"_MAGSITE...
|
|---|
| 173 | I '$$FIND1^DIC(4,"","","`"_MAGSITE,"","","MAGER") D Q
|
|---|
| 174 | . S MAGRY(0)="0^No division name found."
|
|---|
| 175 | S MAGERR=0
|
|---|
| 176 | Q
|
|---|
| 177 | PARENT ;Set the corresponding parent file/subfile in ^MAG(2005.03,62:64.
|
|---|
| 178 | S MAGIEN=$S(MAGTYPE="SP":63.08,MAGTYPE="EM":63.02,MAGTYPE="CY":63.09,1:63.2)
|
|---|
| 179 | I MAGTYPE="AU" S MAGIEN=63.2,MAGNNM=MAGNM_" (GROSS)",B=B+1,MAGRY(B)=MAGNNM_BLANK_"^"_MAGIEN_"~"_MAGABV,MAGNNM="",MAGIEN=63,MAGNM=MAGNM_" (MICROSCOPIC)"
|
|---|
| 180 | ;Autopsy selection will have two selection (GROSS or MICROSCOPIC) and the parent file ^MAG(2005.03 has two entries (63 & 63.2).
|
|---|
| 181 | Q
|
|---|
