Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTMC1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTMC1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTMC1.m
r613 r623 1 MAGGTMC1 ;WOIFO/GEK - RPC Calls for Imaging/Medicine procedures ; [ 06/20/2001 08:57 ] 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 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 Q 20 FILE(MAGRY,DATA,MAGARR) ;RPC Call to File the Image pointer into 21 ; the Procedure/Subspecialty and Proc/Subspec into Image file. 22 ; 23 ; DATA = DATETIME^PSIEN^DFN^MCIEN^PROCSTUB ; 6/19/97 24 ; If MCIEN isn't sent, this will be added as new procedure 25 ; MAGARR is array of image pointers 26 ; IF PROCSTUB is 1 we JUST want New Medicine procedure stub IEN 6/19/97 27 ; as the success i.e. MAGRY="IEN^Procdure Stub created" 6/19/97 28 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 29 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") 30 N I,J,K,X,Y,Z,TIME,PSIEN,DFN,MAGPTR,MAGMCIEN,MCFILE,MAGOK,MAGERR,PROCSTUB 31 ; 32 S X=$P(DATA,U,1),%DT="TS" D ^%DT S TIME=Y 33 S PSIEN=+$P(DATA,U,2) 34 S DFN=+$P(DATA,U,3) 35 S MAGMCIEN=+$P(DATA,U,4) 36 S PROCSTUB=+$P(DATA,U,5) ; NEW 6/19/97 GEK 37 S MCFILE=$P($P(^MCAR(697.2,PSIEN,0),U,2),"(",2) 38 I '$D(^MAG(2005.03,MCFILE)) S MAGRY="0^Procedure file is Invalid in Imaging Parent Data File " Q 39 S MAGOK="" 40 S I="" F S I=$O(MAGARR(I)) Q:I="" D 41 . S MAGPTR(I)="" 42 . I '$D(^MAG(2005,I)) S MAGERR="0^INVALID Image entry "_I 43 I $D(MAGERR) S MAGRY=MAGERR Q 44 ; 6/19/97 New Note .MAGMCIEN 45 D UPDATE^MCUIMAG0(TIME,PSIEN,DFN,.MAGPTR,.MAGMCIEN,.MAGOK) 46 ; 47 I 'MAGOK S MAGRY=MAGOK Q 48 ; Next if we're getting a stub, Quit with the stub if it was created 49 I MAGOK,PROCSTUB D Q 50 . I MAGMCIEN<1 S MAGRY="0^FAILED Creating New Procedure stub"_MAGOK Q 51 . S MAGRY=$P(MAGMCIEN,U,1)_"^Procedure Stub created" 52 ; 53 ; now enter the pointers to procedures, in the image file. 54 ; we get back MAGPTR(I)= MCFILE^PSIEN^MULTIPLE ENTRY IEN 55 S I="" F S I=$O(MAGPTR(I)) Q:I="" D 56 . S $P(^MAG(2005,I,2),U,6,8)=MAGPTR(I) 57 . D LINKDT^MAGGTU6(.X,I) 58 S MAGRY=MAGOK 59 Q 60 ;/GEK/ 4/29/98 put in modification to return DICOM ID for MED proc. 61 DICOMID(MAGRY,DATA) ;RPC Call to return a Dicom ID for medicine procedure. 62 ; This is displayed on workstation, and used to link Dicom images 63 ; to a medicine procedure. 64 ; DATA is null ^ PSIEN ^ DFN ^ MCIEN ^ null 65 ; 66 N TMCFILE,TPSIEN,TDFN,TMCIEN,RETX 67 S TPSIEN=+$P(DATA,U,2) 68 S TDFN=+$P(DATA,U,3) 69 S TMCIEN=+$P(DATA,U,4) 70 S TMCFILE=$P($P($G(^MCAR(697.2,TPSIEN,0)),U,2),"(",2) 71 I 'TMCFILE S MAGRY="0^InValid data input PSIEN="_TPSIEN Q 72 D DICOMID^MAGDMEDI(.RETX,TMCFILE,TMCIEN,TPSIEN,TDFN) 73 S MAGRY=RETX 74 Q 75 NEW(MAGRY,DATA) ;RPC call to Create NEW Procedure stub 76 ; for a medicine procedure 77 ; 78 ; DATA = DATETIME^PSIEN^DFN ; same as old call 79 S $P(DATA,"^",4)="^1" ; the 1 means we want a new procedure stub 80 K MAGARR ; we are not passing any images. 81 D FILE(.MAGRY,DATA,.MAGARR) 82 Q 1 MAGGTMC1 ;WOIFO/GEK - RPC Calls for Imaging/Medicine procedures ; [ 06/20/2001 08:57 ] 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 FILE(MAGRY,DATA,MAGARR) ;RPC Call to File the Image pointer into 20 ; the Procedure/Subspecialty and Proc/Subspec into Image file. 21 ; 22 ; DATA = DATETIME^PSIEN^DFN^MCIEN^PROCSTUB ; 6/19/97 23 ; If MCIEN isn't sent, this will be added as new procedure 24 ; MAGARR is array of image pointers 25 ; IF PROCSTUB is 1 we JUST want New Medicine procedure stub IEN 6/19/97 26 ; as the success i.e. MAGRY="IEN^Procdure Stub created" 6/19/97 27 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 28 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") 29 N I,J,K,X,Y,Z,TIME,PSIEN,DFN,MAGPTR,MAGMCIEN,MCFILE,MAGOK,MAGERR 30 ; 31 S X=$P(DATA,U,1),%DT="TS" D ^%DT S TIME=Y 32 S PSIEN=+$P(DATA,U,2) 33 S DFN=+$P(DATA,U,3) 34 S MAGMCIEN=+$P(DATA,U,4) 35 S PROCSTUB=+$P(DATA,U,5) ; NEW 6/19/97 GEK 36 S MCFILE=$P($P(^MCAR(697.2,PSIEN,0),U,2),"(",2) 37 I '$D(^MAG(2005.03,MCFILE)) S MAGRY="0^Procedure file is Invalid in Imaging Parent Data File " Q 38 S MAGOK="" 39 S I="" F S I=$O(MAGARR(I)) Q:I="" D 40 . S MAGPTR(I)="" 41 . I '$D(^MAG(2005,I)) S MAGERR="0^INVALID Image entry "_I 42 I $D(MAGERR) S MAGRY=MAGERR Q 43 ; 6/19/97 New Note .MAGMCIEN 44 D UPDATE^MCUIMAG0(TIME,PSIEN,DFN,.MAGPTR,.MAGMCIEN,.MAGOK) 45 ; 46 I 'MAGOK S MAGRY=MAGOK Q 47 ; Next if we're getting a stub, Quit with the stub if it was created 48 I MAGOK,PROCSTUB D Q 49 . I MAGMCIEN<1 S MAGRY="0^FAILED Creating New Procedure stub"_MAGOK Q 50 . S MAGRY=$P(MAGMCIEN,U,1)_"^Procedure Stub created" 51 ; 52 ; now enter the pointers to procedures, in the image file. 53 ; we get back MAGPTR(I)= MCFILE^PSIEN^MULTIPLE ENTRY IEN 54 S I="" F S I=$O(MAGPTR(I)) Q:I="" D 55 . S $P(^MAG(2005,I,2),U,6,8)=MAGPTR(I) 56 S MAGRY=MAGOK 57 Q 58 ;/GEK/ 4/29/98 put in modification to return DICOM ID for MED proc. 59 DICOMID(MAGRY,DATA) ;RPC Call to return a Dicom ID for medicine procedure. 60 ; This is displayed on workstation, and used to link Dicom images 61 ; to a medicine procedure. 62 ; DATA is null ^ PSIEN ^ DFN ^ MCIEN ^ null 63 ; 64 N TMCFILE,TPSIEN,TDFN,TMCIEN 65 S TPSIEN=+$P(DATA,U,2) 66 S TDFN=+$P(DATA,U,3) 67 S TMCIEN=+$P(DATA,U,4) 68 S TMCFILE=$P($P($G(^MCAR(697.2,TPSIEN,0)),U,2),"(",2) 69 I 'TMCFILE S MAGRY="0^InValid data input PSIEN="_TPSIEN Q 70 D DICOMID^MAGDMEDI(.RETX,TMCFILE,TMCIEN,TPSIEN,TDFN) 71 S MAGRY=RETX 72 Q 73 NEW(MAGRY,DATA) ;RPC call to Create NEW Procedure stub 74 ; for a medicine procedure 75 ; 76 ; DATA = DATETIME^PSIEN^DFN ; same as old call 77 S $P(DATA,"^",4)="^1" ; the 1 means we want a new procedure stub 78 K MAGARR ; we are not passing any images. 79 D FILE(.MAGRY,DATA,.MAGARR) 80 Q
Note:
See TracChangeset
for help on using the changeset viewer.
