Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTLB1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTLB1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTLB1.m
r613 r623 1 MAGGTLB1 ;WOIFO/LB - RPC routine for Imaging Lab Interface ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 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 ;After an image is captured and an entry is created in file 2005, 21 ;this routine will be called to set the imaging pointers in the 22 ;corresponding Lab subfile (Autopsy/ Organism, Surgical Path, EM, 23 ;or Cytology) and update the imaging file with the corresponding 24 ;Lab pointers. 25 FILE(MAGRY,IMIEN,DATA) ;RPC Call to file pointers in Lab and Image files. 26 ;IMIEN - ^MAG(2005,IMIEN image captured. 27 ;DATA - piece 1 = stain piece 2 = micro obj 28 ; 3 = Pt name 4 = ssn 29 ; 5 = date/time 6 = acc# 30 ; 7 = Pathologist 8 = specimen desc. 31 ; 9 = lab section 10 = dfn 32 ; 11 = lrdfn 12 = lri 33 ; 13 = spec ien 14 = field# 34 ; 15 = global root e.g. ^LR(1,"SP",7069758,1,1 35 ;DATA is the result of START^MAGGTLB (the specimen variable during the 36 ;image capture window). 37 ;Will return a single value on filing success. 38 ; 39 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 40 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") 41 ; 42 N ANUM,DA,DA1,DAS,DFN,DIERR,FIELD,I,IMOBJ,LABD,LABFDA,LABIEN,LABIENS 43 N LRDFN,LRI,MAGFDA,MAGIEN,MAGNODE,OUT,SECT,SECTLTR,SPEC,SPECD 44 N SSUBFILE,SSUBFL,STAIN,SUBFILE,X,Y 45 S MAGRY="0^Started filing",MAGIEN=IMIEN 46 S SECT=$P(DATA,"^",9),DFN=$P(DATA,"^",10),LRDFN=$P(DATA,"^",11) 47 S LRI=$P(DATA,"^",12) 48 S SPEC=$P(DATA,"^",13),FIELD=$P(DATA,"^",14) 49 S MAGNODE="^"_$P(DATA,"^",15,99),ANUM=$P(DATA,"^",6) 50 S SPECD=$P(DATA,"^",8),STAIN=$P(DATA,"^",1),IMOBJ=$P(DATA,"^",2) 51 I SECT["~" S SECT=$P(SECT,"~",1) 52 ;Check for valid image 53 I '$D(^MAG(2005,MAGIEN,0)) D Q 54 . S Y(0)="0^Image entry does not exist." 55 ;Check for valid image patient entry. 56 I $P(^MAG(2005,MAGIEN,0),"^",7)'=DFN D Q 57 . S MAGRY="0^Image patient does not match Lab patient." 58 ;Check if parent file and corresponding fields are filed in file 2005. 59 I $D(^MAG(2005,MAGIEN,2)) S X=^MAG(2005,MAGIEN,2) D Q:OUT 60 . S OUT=0 61 . I $P(X,"^",6),$P(X,"^",7),$P(X,"^",8) S OUT=1 62 . I OUT S MAGRY="0^Report already exist for this image." 63 ;Check the Lab entries...do they still exists. 64 S MAGNODE=MAGNODE_",0)" 65 I '$D(@MAGNODE) S MAGRY="0^Specimen no longer in Lab file." Q 66 ;Everything seem okay lets file image pointer in lab file. 67 S SECTLTR=$S(SECT=63:"AY",SECT=63.2:"AY",1:$P(^MAG(2005.03,SECT,0),"^",2)) 68 ;Lab nodes; AY, SP, EM or CY. 69 ; 70 LAB2 ;updating files using silent Fileman DB calls. 71 N MAGERR,MAGLVL 72 S SUBFILE=$S(SECT=63:63.2,1:SECT) 73 S MAGRY="0^Lab's Imaging subfile doesn't exisit." ;default 74 ;Laboratory's Autopsy subfile has two imaging fields (2005 & 2005.1) 75 ; and file 2005.03 does not reflect this. 76 D FIELD^DID(SUBFILE,FIELD,"","SPECIFIER","MAGLVL","MAGERR") 77 I $D(MAGERR("DIERR")) Q 78 I '$D(MAGLVL("SPECIFIER")) Q 79 S SSUBFL=$G(MAGLVL("SPECIFIER")) ;Lab's Imaging subfile 80 I SSUBFL="" Q 81 ;Image sub-subfile. 82 S SSUBFILE="" F I=1:1:$L(SSUBFL) D 83 . I $E(SSUBFL,I)?1N!($E(SSUBFL,I)?1".") S SSUBFILE=SSUBFILE_$E(SSUBFL,I) 84 . ;Leave off the alpha characters 85 S DA1=$S(SECTLTR="AY":SPEC,1:LRI) ;Autopsy is by specimen not date/time 86 S DAS="+3,"_DA1_","_LRDFN_"," 87 ;Sets the iens e.g. da,da(1),da(2). The +3 can be any #; it is the 88 ;subscript of the return variable LABIENS. 89 ;Returns IEN for that subfile & use of +3 is because it's 2 levels down. 90 S LABFDA(SSUBFILE,DAS,.01)=MAGIEN,LABIENS="" 91 D UPDATE^DIE("S","LABFDA","LABIENS") 92 I $D(DIERR) S MAGRY="O^Unsuccessful Lab updating." Q 93 I '$D(LABIENS(3)) S MAGRY="0^Unsuccessful Lab updating" Q 94 S DA=$G(LABIENS(3)) 95 I 'DA!('$D(^LR(LRDFN,SECTLTR,DA1,FIELD,DA,0))) D Q 96 . S MAGRY="0^Unsuccessful Lab updating" 97 IMAGE2 ; 98 S MAGIEN=MAGIEN_",",LABIEN=DA,LABD=DA1 K DA,DA1 99 ; The following fields are saved in the ADDIMAGE Call. 100 ; 50 =ANUM ;ACCESSION NUMBER FIELD 101 ; 51 =SPECD ;SPECIMEN DESCRIPTION FIELD 102 ; 52 =SPEC ;SPECIMEN DO 103 ; 53 =STAIN ;Histology stain 104 ; 54 =IMOBJ ;MICROSCOPE OBJECTIVE 105 N DIK 106 S MAGFDA(2005,MAGIEN,16)=SECT ;LAB SECTION 107 S MAGFDA(2005,MAGIEN,17)=LRDFN ;PARENT FILE DO VALUE 108 S MAGFDA(2005,MAGIEN,18)=LABIEN ;LAB BACKWARD IMAGE POINTER 109 S MAGFDA(2005,MAGIEN,63)=LABD ;If AUTOPSY, it's specimen else date/time 110 S I=0 F I=$O(MAGFDA(2005,MAGIEN,I)) Q:'I D 111 . D UPDATE^DIE("S","MAGFDA","") 112 I $D(DIERR) S I=0 F S I=$O(MAGFDA(2005,MAGIEN,I)) Q:'I D 113 . S MAGFDA(2005,MAGIEN,I)="" D UPDATE^DIE("","MAGFDA","") 114 I $D(DIERR),$D(^LR(LRDFN,SECTLTR,DA1,FIELD,LABIEN,0)),$G(^LR(LRDFN,SECTLTR,DA1,FIELD,LABIEN,0))=MAGIEN D 115 . S DA(2)=LRDFN,DA(1)=DA1,DA=LABIEN 116 . S DIK="^LR("_LRDFN_","""_SECTLTR_""","_DA1_","_FIELD_"," 117 . D ^DIK ;Remove imaging pointers from lab subfile. 118 I $D(DIERR) S MAGRY="0^Unsuccessful both files not updated." K DIERR Q 119 S MAGRY="1^Success in filing both parent & image files." K DIERR 120 D LINKDT^MAGGTU6(.X,+MAGIEN) 121 Q 1 MAGGTLB1 ;WOIFO/LB - RPC routine for Imaging Lab Interface ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;;Mar 01, 2002 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 ;After an image is captured and an entry is created in file 2005, 21 ;this routine will be called to set the imaging pointers in the 22 ;corresponding Lab subfile (Autopsy/ Organism, Surgical Path, EM, 23 ;or Cytology) and update the imaging file with the corresponding 24 ;Lab pointers. 25 FILE(MAGRY,IMIEN,DATA) ;RPC Call to file pointers in Lab and Image files. 26 ;IMIEN - ^MAG(2005,IMIEN image captured. 27 ;DATA - piece 1 = stain piece 2 = micro obj 28 ; 3 = Pt name 4 = ssn 29 ; 5 = date/time 6 = acc# 30 ; 7 = Pathologist 8 = specimen desc. 31 ; 9 = lab section 10 = dfn 32 ; 11 = lrdfn 12 = lri 33 ; 13 = spec ien 14 = field# 34 ; 15 = global root e.g. ^LR(1,"SP",7069758,1,1 35 ;DATA is the result of START^MAGGTLB (the specimen variable during the 36 ;image capture window). 37 ;Will return a single value on filing success. 38 ; 39 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 40 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") 41 ; 42 N ANUM,DA,DA1,DAS,DFN,DIERR,FIELD,I,IMOBJ,LABD,LABFDA,LABIEN,LABIENS 43 N LRDFN,LRI,MAGFDA,MAGIEN,MAGNODE,OUT,SECT,SECTLTR,SPEC,SPECD 44 N SSUBFILE,SSUBFL,STAIN,SUBFILE,X,Y 45 S MAGRY="0^Started filing",MAGIEN=IMIEN 46 S SECT=$P(DATA,"^",9),DFN=$P(DATA,"^",10),LRDFN=$P(DATA,"^",11) 47 S LRI=$P(DATA,"^",12) 48 S SPEC=$P(DATA,"^",13),FIELD=$P(DATA,"^",14) 49 S MAGNODE="^"_$P(DATA,"^",15,99),ANUM=$P(DATA,"^",6) 50 S SPECD=$P(DATA,"^",8),STAIN=$P(DATA,"^",1),IMOBJ=$P(DATA,"^",2) 51 I SECT["~" S SECT=$P(SECT,"~",1) 52 ;Check for valid image 53 I '$D(^MAG(2005,MAGIEN,0)) D Q 54 . S Y(0)="0^Image entry does not exist." 55 ;Check for valid image patient entry. 56 I $P(^MAG(2005,MAGIEN,0),"^",7)'=DFN D Q 57 . S MAGRY="0^Image patient does not match Lab patient." 58 ;Check if parent file and corresponding fields are filed in file 2005. 59 I $D(^MAG(2005,MAGIEN,2)) S X=^MAG(2005,MAGIEN,2) D Q:OUT 60 . S OUT=0 61 . I $P(X,"^",6),$P(X,"^",7),$P(X,"^",8) S OUT=1 62 . I OUT S MAGRY="0^Report already exist for this image." 63 ;Check the Lab entries...do they still exists. 64 S MAGNODE=MAGNODE_",0)" 65 I '$D(@MAGNODE) S MAGRY="0^Specimen no longer in Lab file." Q 66 ;Everything seem okay lets file image pointer in lab file. 67 S SECTLTR=$S(SECT=63:"AY",SECT=63.2:"AY",1:$P(^MAG(2005.03,SECT,0),"^",2)) 68 ;Lab nodes; AY, SP, EM or CY. 69 ; 70 LAB2 ;updating files using silent Fileman DB calls. 71 N MAGERR,MAGLVL 72 S SUBFILE=$S(SECT=63:63.2,1:SECT) 73 S MAGRY="0^Lab's Imaging subfile doesn't exisit." ;default 74 ;Laboratory's Autopsy subfile has two imaging fields (2005 & 2005.1) 75 ; and file 2005.03 does not reflect this. 76 D FIELD^DID(SUBFILE,FIELD,"","SPECIFIER","MAGLVL","MAGERR") 77 I $D(MAGERR("DIERR")) Q 78 I '$D(MAGLVL("SPECIFIER")) Q 79 S SSUBFL=$G(MAGLVL("SPECIFIER")) ;Lab's Imaging subfile 80 I SSUBFL="" Q 81 ;Image sub-subfile. 82 S SSUBFILE="" F I=1:1:$L(SSUBFL) D 83 . I $E(SSUBFL,I)?1N!($E(SSUBFL,I)?1".") S SSUBFILE=SSUBFILE_$E(SSUBFL,I) 84 . ;Leave off the alpha characters 85 S DA1=$S(SECTLTR="AY":SPEC,1:LRI) ;Autopsy is by specimen not date/time 86 S DAS="+3,"_DA1_","_LRDFN_"," 87 ;Sets the iens e.g. da,da(1),da(2). The +3 can be any #; it is the 88 ;subscript of the return variable LABIENS. 89 ;Returns IEN for that subfile & use of +3 is because it's 2 levels down. 90 S LABFDA(SSUBFILE,DAS,.01)=MAGIEN,LABIENS="" 91 D UPDATE^DIE("S","LABFDA","LABIENS") 92 I $D(DIERR) S MAGRY="O^Unsuccessful Lab updating." Q 93 I '$D(LABIENS(3)) S MAGRY="0^Unsuccessful Lab updating" Q 94 S DA=$G(LABIENS(3)) 95 I 'DA!('$D(^LR(LRDFN,SECTLTR,DA1,FIELD,DA,0))) D Q 96 . S MAGRY="0^Unsuccessful Lab updating" 97 IMAGE2 ; 98 S MAGIEN=MAGIEN_",",LABIEN=DA,LABD=DA1 K DA,DA1 99 ; The following fields are saved in the ADDIMAGE Call. 100 ; 50 =ANUM ;ACCESSION NUMBER FIELD 101 ; 51 =SPECD ;SPECIMEN DESCRIPTION FIELD 102 ; 52 =SPEC ;SPECIMEN DO 103 ; 53 =STAIN ;Histology stain 104 ; 54 =IMOBJ ;MICROSCOPE OBJECTIVE 105 N DIK 106 S MAGFDA(2005,MAGIEN,16)=SECT ;LAB SECTION 107 S MAGFDA(2005,MAGIEN,17)=LRDFN ;PARENT FILE DO VALUE 108 S MAGFDA(2005,MAGIEN,18)=LABIEN ;LAB BACKWARD IMAGE POINTER 109 S MAGFDA(2005,MAGIEN,63)=LABD ;If AUTOPSY, it's specimen else date/time 110 S I=0 F I=$O(MAGFDA(2005,MAGIEN,I)) Q:'I D 111 . D UPDATE^DIE("S","MAGFDA","") 112 I $D(DIERR) S I=0 F S I=$O(MAGFDA(2005,MAGIEN,I)) Q:'I D 113 . S MAGFDA(2005,MAGIEN,I)="" D UPDATE^DIE("","MAGFDA","") 114 I $D(DIERR),$D(^LR(LRDFN,SECTLTR,DA1,FIELD,LABIEN,0)),$G(^LR(LRDFN,SECTLTR,DA1,FIELD,LABIEN,0))=MAGIEN D 115 . S DA(2)=LRDFN,DA(1)=DA1,DA=LABIEN 116 . S DIK="^LR("_LRDFN_","""_SECTLTR_""","_DA1_","_FIELD_"," 117 . D ^DIK ;Remove imaging pointers from lab subfile. 118 I $D(DIERR) S MAGRY="0^Unsuccessful both files not updated." K DIERR Q 119 S MAGRY="1^Success in filing both parent & image files." K DIERR 120 Q
Note:
See TracChangeset
for help on using the changeset viewer.
