Changeset 636 for FOIAVistA/tag/r/IMAGING-MAG-ZMAG
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (15 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 62 edited
- 1 copied
-
. (copied) (copied from FOIAVistA/trunk/r )
-
IMAGING-MAG-ZMAG/MAGBAPIP.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGBRTE5.m (modified) (1 diff)
-
IMAGING-MAG-ZMAG/MAGBRTUT.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGDHL7.m (modified) (1 diff)
-
IMAGING-MAG-ZMAG/MAGDRPC3.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGNLKP.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGNTI.m (modified) (9 diffs)
-
IMAGING-MAG-ZMAG/MAGGNTI1.m (modified) (11 diffs)
-
IMAGING-MAG-ZMAG/MAGGNTI2.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGNTI3.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGSIA.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGGSIA1.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGSIU2.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGSIUI.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGSIV.m (modified) (1 diff)
-
IMAGING-MAG-ZMAG/MAGGSIV1.m (modified) (1 diff)
-
IMAGING-MAG-ZMAG/MAGGTAU.m (modified) (10 diffs)
-
IMAGING-MAG-ZMAG/MAGGTERR.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTIA1.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGGTID.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGGTII.m (modified) (9 diffs)
-
IMAGING-MAG-ZMAG/MAGGTLB1.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTMC1.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGGTPT1.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGTRA.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGGTSR.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTSR1.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGTSY2.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTSYS.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU1.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU3.m (modified) (5 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU31.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU4.m (modified) (9 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU41.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU6.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU71.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGGTU9.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGGTUP.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJEX1B.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJEX2.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGJLS2.m (modified) (10 diffs)
-
IMAGING-MAG-ZMAG/MAGJLS2B.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJLS4.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGJLST1.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGJMN1.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGJUPD1.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJUPD2.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJUTL1.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGJUTL2.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJUTL3.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGJUTL4.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGJUTL5.m (modified) (5 diffs)
-
IMAGING-MAG-ZMAG/MAGLOG.m (modified) (2 diffs)
-
IMAGING-MAG-ZMAG/MAGQBPG1.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGQBPRG.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGQBTM.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGQBUT1.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGQBUT2.m (modified) (6 diffs)
-
IMAGING-MAG-ZMAG/MAGQBUT4.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGQBUT5.m (modified) (3 diffs)
-
IMAGING-MAG-ZMAG/MAGSIXG1.m (modified) (4 diffs)
-
IMAGING-MAG-ZMAG/MAGSIXGT.m (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGBAPIP.m
r628 r636 1 1 MAGBAPIP ;WOIFO/MLH - Background Processor API to build queues - Modules for place 2 ;;3.0;IMAGING;**1,7,8,20,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**1,7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 17 16 ;; +---------------------------------------------------------------+ 18 17 ;; 19 DUZ2PLC(WARN) ; Convert DUZ to a PLACE. File 2006.1 entry (PLACE)20 ; Extrinsic : Always returns a PLACE 21 ; WARN : message about where the PLACE was derived from. 18 DUZ2PLC(WARN) ; Moved from MAGGTU3 v2.5 - DBI - SEB Patch 4 19 ; Extrinsic : Always returns a PLACE /gek 8/2003 20 ; WARN : message about where the PLACE was derived from. /gek 8/2003 22 21 ; Compute the Users Institution for older versions of Imaging Display workstation. 23 ; This is called when DUZ(2) doesn't exist Or Can't resolve DUZ(2)24 ; into site param entry. This solved a GateWay Problem where DUZ(2) didn't25 ; exist. - Shouldn't get here anymore, that was fixed.22 ; This is called when : 23 ; DUZ(2) doesn't exist, 24 ; Or Can't resolve DUZ(2) into site param entry 26 25 N MAGINST,DIVDTA,PLACE 27 26 S MAGINST=0 … … 38 37 Q PLACE 39 38 ; 40 DA2PLC(MAGDA,TYPE) ; Get Place from Image File IEN39 DA2PLC(MAGDA,TYPE) ; Moved from MAGGTU7 v2.5 - DBI - SEB Patch 4 41 40 ; TYPE : Possible values "A" Abstract, "F" Full Res or "B" Big File 42 41 ; (defaults to "F" if null) 43 ; Resolve Place (PLC) using the Acquisition Site field (ACQS) 44 ; IF ACQS is null or not doesn't exist in the site parameter file 45 ; THEN Resolve PLC using NetWork Location pointer 42 ; Resolve current place of image using the Acquisition Site field, then 43 ; resolve current place of image using NetWork Location pointer 44 ; if the Acquisition Site field is null or not related to the site 45 ; parameter file. 46 46 ; 47 47 N MAGREF,MAG0,FBIG,SITE,PLC,MAGJB … … 49 49 S SITE=$P($G(^MAG(2005,MAGDA,100)),U,3) 50 50 I SITE S PLC=$$PLACE^MAGBAPI(SITE) Q:PLC PLC 51 ; p59 Stop the error when an Image is Deleted. 52 S MAG0=$G(^MAG(2005,MAGDA,0)) Q:MAG0="" 0 53 ; 51 S MAG0=^MAG(2005,MAGDA,0) 52 ;I '$D(TYPE) S TYPE="F" /gek 8/2003 mod for efficiency (from ed) 54 53 S TYPE=$E($G(TYPE)_"F",1) 55 54 I "AF"[TYPE D -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGBRTE5.m
r628 r636 23 23 . N CP,M1,M2,MAX,B,E,L,RD,T 24 24 . ; 25 . L +^MAGRT(2006.5906,0):1 E9 ; Background task must wait for lock25 . L +^MAGRT(2006.5906,0):19 ; Background task must wait for lock 26 26 . ; 27 27 . ; Clean up old info -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGBRTUT.m
r628 r636 117 117 N D0,MORE,N,P1,P4,P5,P6,P7,P8,TIME 118 118 S TIME=$$STAMP($H)+55,N=0,MORE=0 119 L +^MAGQUEUE(2006.03,0):1 E9 ; Background process must wait119 L +^MAGQUEUE(2006.03,0):19 ; Background process must wait 120 120 S D0="" F S D0=$O(^MAGQUEUE(2006.03,"B","EVAL",D0)) Q:D0="" D Q:MORE 121 121 . S X=$G(^MAGQUEUE(2006.03,D0,0)) … … 168 168 I KEY'=5,KEY'=6 S OUT="-3,Invalid key specified ("_KEY_")" Q 169 169 ; 170 L +^MAG(2006.587,0):1 E9 ; Background process MUST wait170 L +^MAG(2006.587,0):19 ; Background process MUST wait 171 171 S (N,D0)=0 F S D0=$O(^MAG(2006.587,D0)) Q:'D0 D 172 172 . S X=$G(^MAG(2006.587,D0,0)),ID=$P(X,"^",KEY) Q:ID'=OLD -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDHL7.m
r628 r636 136 136 N D0,HDR 137 137 S DATE=DATE\1 138 L +^MAGDHL7(2006.5,0):1 E9 ; Background process MUST wait138 L +^MAGDHL7(2006.5,0):19 ; Background process MUST wait 139 139 S D0=$O(^MAGDHL7(2006.5," "),-1)+1 140 140 S ^MAGDHL7(2006.5,D0,0)=DATE -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDRPC3.m
r628 r636 133 133 . Q 134 134 ; 135 L +^MAGDOUTP(2006.574,0):1 E9 ; Background process MUST wait135 L +^MAGDOUTP(2006.574,0):19 ; Background process MUST wait 136 136 S P=$P($G(^MAG(2005,IMAGE,0)),"^",10),P=$S(P:P,1:IMAGE) 137 137 S STUID=$P($G(^MAG(2005,P,"PACS")),"^",1) S:STUID="" STUID="?" … … 199 199 Q:OLD 1 200 200 ; 201 L +^MAGDOUTP(2006.574,D0,1,0):1 E9 ; Background Process MUST wait201 L +^MAGDOUTP(2006.574,D0,1,0):19 ; Background Process MUST wait 202 202 S X=$G(^MAGDOUTP(2006.574,D0,1,0)) 203 203 S $P(X,"^",1,2)="^2006.5744" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNLKP.m
r628 r636 1 1 MAGGNLKP ;WOIFO/GEK - Lookup from delphi into any file ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**8,92 ,46,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**8,92**;Jan 10, 2007;Build 1 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 36 36 ; Defaults to "B" 37 37 ; 38 ; 38 39 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 39 40 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNTI.m
r628 r636 1 1 MAGGNTI ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 04 Apr 2002 2:37 PM 2 ;;3.0;IMAGING;**10,8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**10,8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 20 20 ; Call to file TIU and Imaging Pointers 21 21 ; TIU API to add image to TIU 22 N X23 22 I $P(^TIU(8925,TIUDA,0),U,2)'=$P(^MAG(2005,MAGDA,0),U,7) S MAGRY="0^Patient Mismatch." Q 24 23 D PUTIMAGE^TIUSRVPL(.MAGRY,TIUDA,MAGDA) ; … … 28 27 ; DONE. 29 28 S MAGRY="1^Image pointer filed successfully" 30 ; Now we save the PARENT ASSOCIATION Date/Time31 D LINKDT^MAGGTU6(.X,MAGDA)32 29 Q 33 30 DATA(MAGRY,TIUDA) ;RPC [MAG3 TIU DATA FROM DA] 34 31 ; Call to get TIU data from the TIUDA 35 ; Return = TIUDA^Document Type ^Document Date^DFN ^Author DUZ32 ; Return = TIUDA^Document Type ^Document Date^DFN 36 33 ; 37 S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I") _U_$$GET1^DIQ(8925,TIUDA,"1202","I")_U34 S MAGRY=TIUDA_U_$$GET1^DIQ(8925,TIUDA,".01","E")_U_$$GET1^DIQ(8925,TIUDA,"1201","I")_U_$$GET1^DIQ(8925,TIUDA,".02","I") 38 35 Q 39 36 IMAGES(MAGRY,TIUDA) ;RPC [MAG3 CPRS TIU NOTE] 40 37 ; Call to get all images for a given TIU DA 41 ; We first get all Image IEN's breaking groups into sep arate images38 ; We first get all Image IEN's breaking groups into seperate images 42 39 ; Then get Image Info for each one. 43 40 ; MAGRY - Return array of Image Data entries … … 47 44 ; 48 45 ; Call TIU API to get list of Image IEN's 49 N MAGARR,CT,TCT ,I,J,Z K ^TMP($J,"MAGGX")46 N MAGARR,CT,TCT K ^TMP("MAGGX",$J) 50 47 N DA,MAGQI,MAGNCHK,MAGXX,MAGRSLT 51 48 N TIUDFN,MAGQUIT ; MAGQI 8/22/01 … … 78 75 . . ; children. Later when list is looped through, it's INFO^MAGGTII will be in 79 76 . . ; list. Have to do this to allow other images in list from TIU to be processed. 80 . . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP( $J,"MAGGX",CT)=DA Q77 . . D CHK^MAGGSQI(.MAGQI,DA) I 'MAGQI(0) S CT=CT+1,^TMP("MAGGX",$J,CT)=DA Q 81 78 . . S J=0 ; the following line needs to take only the first piece of the node - PMK 4/4/02 82 . . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP( $J,"MAGGX",CT)=$P(^(J,0),"^")79 . . F S J=$O(^MAG(2005,DA,1,J)) Q:'J S CT=CT+1,^TMP("MAGGX",$J,CT)=$P(^(J,0),"^") 83 80 . S CT=CT+1 84 . S ^TMP( $J,"MAGGX",CT)=DA81 . S ^TMP("MAGGX",$J,CT)=DA 85 82 ; Now get image info for each image 86 83 ; 87 84 S Z="" 88 85 S MAGQUIET=1 89 F S Z=$O(^TMP( $J,"MAGGX",Z)) Q:Z="" D90 . S TCT=TCT+1,MAGXX=^TMP( $J,"MAGGX",Z)91 . ;GEK 8/24/00 Stop ping the Invalid Image IEN's and Deleted Images86 F S Z=$O(^TMP("MAGGX",$J,Z)) Q:Z="" D 87 . S TCT=TCT+1,MAGXX=^TMP("MAGGX",$J,Z) 88 . ;GEK 8/24/00 Stoping the Invalid Image IEN's and Deleted Images 92 89 . I '$D(^MAG(2005,MAGXX)) D Q 93 90 . . D INVALID^MAGGTIG(MAGXX,.MAGRSLT) S MAGRY(CT)=MAGRSLT … … 96 93 K MAGQUIET 97 94 S MAGRY(0)=TCT_"^"_TCT_" Images for the selected TIU NOTE" 98 ; P ut the Image IEN of the last image into the group IENfield.95 ; PUT THE Image IEN of the last image into the group ien field. 99 96 Q:'TCT 100 97 S $P(MAGRY(0),U,3)=TIUDA … … 103 100 S $P(MAGRY(0),U,4)=$$GET1^DIQ(8925,TIUDA,".02","E")_" "_$P(MAGRSLT,U,2)_" "_$$FMTE^XLFDT($P(MAGRSLT,U,3),"8") 104 101 ; 105 S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U), $G(MAGXX):MAGXX,1:0)102 S $P(MAGRY(0),U,5)=$S($P($G(MAGFILE),U):$P(MAGFILE,U),1:MAGXX) 106 103 Q 107 104 ;. S Z=ISDELIMG(DA) I Z S TCT=TCT+1,MAGRY(TCT)="B2^"_$P(Z,U,2) Q … … 123 120 S $P(Z,U,17)=$P(MAGR,U,2) 124 121 Q Z 125 ISDOCCL(MAGRY,IEN,TIUFILE,CLASS) ;RPC [MAGG IS DOC CLASS]126 ;Checks to see if IEN of TIU Files 8925 or 8925.1 is of a certain Doc Class127 ;MAGRY = Return String128 ; for Success "1^message"129 ; for Failure "0^message"130 ;IEN = Internal Entry Number in the TIUFILE131 ;TIUFILE = either 8925 if we need to see if a Note is of a Document Class132 ; or 8925.1 if we need to see if a Title is of a Document Class133 ;CLASS = Text Name of the Document Class example: "ADVANCE DIRECTIVE"134 ;135 S MAGRY="0^Unknown Error checking TIU Document Class"136 K MAGTRGT,DEFIEN,DOCCL,RES,DONE,NTTL137 S DONE=0138 ; If we're resolving a Title139 I TIUFILE="8925.1" D Q:DONE140 . S DEFIEN=IEN,NTTL="Title"141 . I '$D(^TIU(8925.1,DEFIEN,0)) S MAGRY="0^Invalid Title IEN",DONE=1 Q142 . Q143 ; If we're resolving a Note144 I TIUFILE="8925" D Q:DONE145 . S NTTL="Note"146 . I '$D(^TIU(8925,IEN)) S MAGRY="0^Invalid Note IEN",DONE=1 Q147 . ; Get Title IEN from Note IEN148 . S DEFIEN=$$GET1^DIQ(8925,IEN_",",.01,"I")149 . I DEFIEN="" S MAGRY="0^Error resolving Document Class from Note IEN" S DONE=1 Q150 . Q151 ;152 ; Find the IEN in 8925.1 for Document Class (CLASS)153 D FIND^DIC(8925.1,"","@;.001","X",CLASS,"","","I $P(^(0),U,4)=""DC""","","MAGTRGT")154 S DOCCL=$G(MAGTRGT("DILIST",2,1))155 ;156 ; See if ^TIU(8925.1,DEFIEN is of Document Class DOCCL157 S RES=$$ISA^TIULX(DEFIEN,DOCCL)158 I RES S MAGRY="1^The "_NTTL_" is of Document Class "_CLASS Q159 S MAGRY="0^The "_NTTL_" is Not of Document Class "_CLASS160 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNTI1.m
r628 r636 1 MAGGNTI1 ;WOIFO/GEK - Imaging interface to TIU . RPC Calls etc. ; 04 Apr 2002 2:37PM2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 201 MAGGNTI1 ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 20 Nov 2006 12:42 PM 2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | … … 16 15 ;; | to be a violation of US Federal Statutes. | 17 16 ;; +---------------------------------------------------------------+ 18 ;; 17 ;; 19 18 Q 20 19 NEW(MAGRY,MAGDFN,MAGTITLE,MAGADCL,MAGMODE,MAGES,MAGESBY,MAGLOC,MAGDATE,MAGCNSLT,MAGTEXT) ;RPC [MAG3 TIU NEW] … … 37 36 ; MAGESBY - The DUZ of the Signer (Defaults to DUZ) 38 37 ; MAGADCL - 1 = Mark this Note as Administratively Closed 39 ; MAGMODE - Mode of Admin Closure: "S" = Scanned Document 38 ; MAGMODE - Mode of Admin Closure: "S" = Scanned Document 40 39 ; "M" = Manual closure, "E" = Electronically Filed 41 40 ; MAGDATE - Date of the Note. For New Notes. … … 55 54 I "MSE"'[MAGMODE S MAGRY="0^Invalid Mode of Closure: """_MAGMODE_"""" Q 56 55 ; 57 ; 56 ; Here if we have no Text, we'll add at least a line. 58 57 I $O(MAGTEXT(""))="" S MAGTEXT(.1)=" VistA Imaging - - Scanned Document" 59 58 ; Reformat Text - "TEXT",i,0)" for TIU Call. … … 97 96 I '$$VALID^MAGGSIV1(8925,1301,.MAGDATE,.MAGRES) S MAGRY=MAGRY_" "_MAGRES 98 97 E S MTXT(1301)=MAGDATE 99 ; - Fix in T30, if DUZ isn't MAGESBY, we have Author different than User. 100 I MAGESBY'=DUZ S MTXT("1202")=MAGESBY 101 ; Update and LINK TO CONSULT if needed. 98 ; 99 ; Update and LINK TO CONSULT if needed. 102 100 I MAGISC S MTXT("1405")=MAGCNSLT_";GMR(123," 103 101 I $D(MTXT) D I 'MUPD S MAGRY=MUPD Q … … 105 103 . Q 106 104 ; 107 ; 105 ; If Admin Close, then We quit. 108 106 I MAGADCL="1" D Q 109 107 . D ADMNCLOS^MAGGNTI2(.MAGTY,MAGDFN,MAGTIUDA,MAGMODE) … … 111 109 . Q 112 110 ; 113 ; 111 ; if caller sent esignature to Sign this Note. 114 112 I $L(MAGES) D 115 113 . D SIGN^MAGGNTI3(.MAGTY,MAGDFN,MAGTIUDA,MAGES,MAGESBY) … … 143 141 ; 144 142 I '$$VALDATA^MAGGNTI2(.MAGRY,MAGDFN,MAGTIUDA) Q 145 N MAGXT,I,CT,NEWTIUDA,MAGY,MAGRES ,MAGUPD143 N MAGXT,I,CT,NEWTIUDA,MAGY,MAGRES 146 144 S CT=1,I="" 147 145 S MAGXT("TEXT",1,0)="VistA Imaging Scanned Document - Addendum." … … 153 151 D MAKEADD^TIUSRVP(.MAGRY,MAGTIUDA,.MAGXT) 154 152 ; MAGRY could be 0^error message 155 ; -1^message156 ; TIUDA153 ; -1^message 154 ; TIUDA 157 155 I $P(MAGRY,"^")<0 S $P(MAGRY,"^")=0 Q 158 156 S NEWTIUDA=+MAGRY 159 157 S MAGRY=MAGRY_"^Addendum was created." 160 ; 158 ; 161 159 ;Put in the Date that was sent. 162 K MAGUPD163 160 I '$$VALID^MAGGSIV1(8925,1301,.MAGDATE,.MAGRES) S MAGRY=MAGRY_" "_MAGRES 164 161 E D 165 . S MAGUPD(1301)=MAGDATE 166 . S MAGUPD(1211)=$$GET1^DIQ(8925,1211,MAGTIUDA,"I") 167 ; - Fix in T30, if DUZ isn't MAGESBY, we have Author different than User. 168 I MAGESBY'=DUZ S MAGUPD("1202")=MAGESBY 169 I $D(MAGUPD) D 170 . D UPDATE^TIUSRVP(.MAGY,NEWTIUDA,.MAGUPD) 162 . K X 163 . S X(1301)=MAGDATE 164 . S X(1211)=$$GET1^DIQ(8925,1211,MAGTIUDA,"I") 165 . D UPDATE^TIUSRVP(.MAGY,NEWTIUDA,.X) 171 166 . I 'MAGY S MAGRY=MAGRY_" TIU Data was Not Correctly Filed." 172 167 . Q … … 185 180 Q 186 181 MOD(MAGRY,MAGDFN,MAGTIUDA,MAGADCL,MAGMODE,MAGES,MAGESBY,MAGTEXT) ; RPC [MAG3 TIU MODIFY NOTE] 187 ; After a Note is filed, we call this to Modify the Note. We do this to sign it.188 ; That way the Signed Date is After the Image Association Date/Time.189 182 N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0) 190 183 S MAGDFN=$G(MAGDFN),MAGTIUDA=$G(MAGTIUDA) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNTI2.m
r628 r636 1 MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU . RPC Calls etc. ; 04 Apr 2002 2:37PM2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.1 MAGGNTI2 ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 20 Nov 2006 12:18 PM 2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. |5 ;; | Property of the US Government. | 6 6 ;; | No permission to copy or redistribute this software is given. | 7 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. |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 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | 13 13 ;; | Modifications to this software may result in an adulterated | 14 14 ;; | medical device under 21CFR820, the use of which is considered | 15 ;; | to be a violation of US Federal Statutes. |15 ;; | to be a violation of US Federal Statutes. | 16 16 ;; +---------------------------------------------------------------+ 17 ;; 17 ;; 18 18 Q 19 19 LIST(MAGRY,CLASS,MYLIST) ; RPC [MAG3 TIU LONG LIST OF TITLES] … … 26 26 ; TIU PERSONAL TITLE LIST PERSLIST^TIUSRVD 27 27 ; 28 ; Note : sending CLASS IEN isn't used in p59.28 ; Note : sending CLASS IEN isn't tested. 29 29 ; 30 30 K MAGRY -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGNTI3.m
r628 r636 1 MAGGNTI3 ;WOIFO/GEK - Imaging interface to TIU .RPC Calls etc. ; 04 Apr 2002 2:37 PM2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.1 MAGGNTI3 ;WOIFO/GEK - Imaging interface to TIU RPC Calls etc. ; 04 Apr 2002 2:37 PM 2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 15 15 ;; | to be a violation of US Federal Statutes. | 16 16 ;; +---------------------------------------------------------------+ 17 ;; 17 ;; 18 18 Q 19 19 MOD(MAGRY,MAGDFN,MAGTIUDA,MAGADCL,MAGMODE,MAGES,MAGESBY,MAGTEXT) ; RPC [MAG3 TIU MODIFY NOTE] -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIA.m
r628 r636 1 1 MAGGSIA ;WOIFO/GEK - Imaging RPC Broker calls. Add/Modify Image entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,21,8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,21,8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 45 44 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK 46 45 ; TO THE NEW FILE NAME RETURNED BY THIS CALL. 47 ; Changed to include hierarchi cal directory hash - PMK 04/23/9846 ; Changed to include hierarchial directory hash - PMK 04/23/98 48 47 ;---------------------------------------------------------------- 49 48 N MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM … … 64 63 I '$D(MAGGFDA(2005,"+1,")) S MAGRY(0)="0^No data to file. Operation CANCELED." Q 65 64 ; 66 ;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43)))67 65 ; Check on some possible problems: required fields, create default values etc. 68 66 D PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF) I $L(MAGERR) S MAGRY(0)=MAGERR Q … … 88 86 ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT 89 87 ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename 90 I MAGGRP D G C188 I MAGGRP D Q 91 89 . D UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA) 92 90 . S MAGRY(0)=MAGGDA_U … … 95 93 ; ENTRY in Image File has been made, if any errors from here on 96 94 ; then we have to delete the image entry. 97 ; IF This image is a member of a Group, Update the Group Entry with new child. 98 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q 99 . D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA) 100 . I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN 95 ; New Index Field Check. If this entry doesn't have the Index fields introduced 96 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values. 97 ;-This is being deferred to a later patch. 98 ;-I '$D(^MAG(2005,MAGGDA,40)) D 99 ;-. D ONE^MAGSCNVI(MAGGDA) 100 ;-. D ACTION^MAGGTAU("DFTINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA) 101 101 ; 102 102 ; Now generate the Image FileName. This is passed back to the calling app, … … 120 120 . . D CLEAN 121 121 ; 122 C1 ; 59123 K MAGGFDA ; P59.124 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry125 I '$D(^MAG(2005,MAGGDA,40)) D126 . N INDXD127 . D GENIEN^MAGXCVI(MAGGDA,.INDXD)128 . D COMIEN^MAGXCVC(MAGGDA,.INDXD)129 . S ^MAGIXCVT(2006.96,MAGGDA)=1 ; Flag. Says fields were converted by index generation130 . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)131 . ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108))132 . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5))133 . Q134 122 ; 135 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values. 136 I '$P(^MAG(2005,MAGGDA,40),"^",3) D 137 . N INDXD,OLD40,N40 138 . S (N40,OLD40)=^MAG(2005,MAGGDA,40) 139 . D GENIEN^MAGXCVI(MAGGDA,.INDXD) 140 . ; If Origin doesn't exist in existing, this will put V in. 141 . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V" 142 . ; We're not changing existing values of Spec,Proc or Origin 143 . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J) 144 . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc 145 . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5) 146 . S ^MAG(2005,MAGGDA,40)=N40 147 . ;;D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108)) 148 . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5)) 149 . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1) 150 . Q 123 ; 124 ; IF This image is a member of a Group, Update the Group Entry with new child. 125 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q 126 . D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA) 127 . I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN 128 ; 151 129 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE. 152 130 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation 153 131 ; 154 132 ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG] 155 ; example:487^C:\IMAGE\^DC000487.TIF133 ; i.e 487^C:\IMAGE\^DC000487.TIF 156 134 ; The calling routine is responsible for renaming/naming the file 157 135 ; to the returned DRIVE:\DIR\FILENAME.EXT 158 136 ; 159 ; Modified 4/23/98 to include hierarchical directory structure -- PMK 160 I 'MAGGRP D 161 . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 162 . ; For now, BIG files are in same directory as FullRes (or PACS) file 163 . S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 164 . ; If BIG file also, add it's Drive, Hash, Filename to end of Return string. 165 . I $G(MAGACT("BIG")) D 166 . . S X=$P(MAGGFNM,".",1)_".BIG" 167 . . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X 168 . . Q 169 . Q 137 ; Modified 4/23/98 to include hierarchial directory structure -- PMK 138 S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 139 ; For now, BIG files are in same directory as FullRes (or PACS) file 140 S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 141 ; If BIG file also, add it's Drive, Hash, Filename to end of Return string. 142 I $G(MAGACT("BIG")) D 143 . S X=$P(MAGGFNM,".",1)_".BIG" 144 . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X 170 145 ; 171 146 CLEAN ; Called as tag -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIA1.m
r628 r636 1 1 MAGGSIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,8,85 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**7,8,85**;16-March-2007;;Build 1039 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIU2.m
r628 r636 1 1 MAGGSIU2 ;WOIFO/GEK - Utilities for Image Add/Modify ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,8,85 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**7,8,85**;16-March-2007;;Build 1039 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIUI.m
r628 r636 1 1 MAGGSIUI ;WOIFO/GEK - Utilities for Image Import API 2 ;;3.0;IMAGING;**7,8,48,20,85 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**7,8,48,20,85**;16-March-2007;;Build 1039 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIV.m
r628 r636 1 1 MAGGSIV ;WOIFO/GEK - Imaging RPC Broker calls. Validate Image data array ; [ 12/27/2000 10:49 ] 2 ;;3.0;IMAGING;**7,8,20,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGSIV1.m
r628 r636 1 1 MAGGSIV1 ;WOIFO/GEK - Imaging Validate Data ; [ 08/15/2004 08:57 ] 2 ;;3.0;IMAGING;**8,20,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTAU.m
r628 r636 1 1 MAGGTAU ;WOIFO/GEK - RPC Calls to Update the Imaging Windows Workstation file ; [ 03/25/2001 11:20 ] 2 ;;3.0;IMAGING;**7,16,8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,16,8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 18 17 ;; 19 18 Q 20 UPD(MAGRY,DATA) ;RPC [MAGG WRKS UPDATES] 21 ; Called after User login. Local and RIV. 22 ; Updates information in the IMAGING WINDOWS WORKSTATION 19 UPD(MAGRY,DATA) ;RPC [MAGG WRKS UPDATES] 20 ; Call from workstation updating it's exe's Date/Time 21 ; and other Workstation information into IMAGING WINDOWS WORKSTATION 22 ; at logon of user. 23 23 ; 24 24 ; DATA is '^' delimited piece 25 25 ; 1 Workstation name 2 Date/Time of capture app. 26 26 ; 3 Date/Time of Display App. 27 ; 4 Location of works tation 5 Date/Time of MAGSETUP27 ; 4 Location of worksation 5 Date/Time of MAGSETUP 28 28 ; 6 Version of Display 7 Version of Capture 29 29 ; 8 1=Normal startup 2=Started by CPRS 3=Import API 30 30 ; 9 OS Version 10 VistaRad Version 31 ; 11 RPCBroker Server 12 RPCBroker Port32 31 N X,Y,Z 33 32 N MAGNAME,MAGCDT,MAGDDT,MAG0,MAGLOC,MAGIEN,MAGSETUP,MAGSTART,MAGSRV … … 40 39 S MAGSETUP=$P(DATA,U,5) 41 40 S MAGVERSD=$P(DATA,U,6) 42 I MAGVERSD S MAGJOB("DISPLAY")=""43 41 S MAGVERSC=$P(DATA,U,7) 44 I MAGVERSC S MAGJOB("CAPTURE")=""45 42 S MAGMODE=$P(DATA,U,8) 46 43 S MAGOSVER=$P(DATA,U,9) 47 44 S MAGVERVR=$P(DATA,U,10) 48 I $P(DATA,U,11)]"" S MAGJOB("RPCSERVER")=$P(DATA,U,11)49 I $P(DATA,U,12)]"" S MAGJOB("RPCPORT")=$P(DATA,U,12)50 45 S MAGIEN=0 51 46 I $L(MAGNAME) S MAGIEN=$O(^MAG(2006.81,"B",MAGNAME,"")) … … 59 54 L +^MAG(2006.81,"LOCK",MAGIEN):0 60 55 S MAGIEN=+MAGIEN_"," 61 S MAGGFDA(2006.81,MAGIEN,.01)=MAGNAME ; Comp uter Name56 S MAGGFDA(2006.81,MAGIEN,.01)=MAGNAME ; Compter Name 62 57 I MAGCDT>-1 S MAGGFDA(2006.81,MAGIEN,4)=MAGCDT ;TELE19N.EXE dttm 63 58 I MAGDDT>-1 S MAGGFDA(2006.81,MAGIEN,5)=MAGDDT ;IMGVWP10.EXE dttm … … 65 60 S MAGGFDA(2006.81,MAGIEN,8)=1 ; Active or not. 66 61 S MAGGFDA(2006.81,MAGIEN,6)=MAGLOC ; location free text from .INI 67 S MAGGFDA(2006.81,MAGIEN,3)="@" ; delete log off time for this job.62 S MAGGFDA(2006.81,MAGIEN,3)="@" ; delete logff time for this job. 68 63 S MAGGFDA(2006.81,MAGIEN,10)="@" ; delete session pointer 69 64 S MAGGFDA(2006.81,MAGIEN,11)="@" ; reset the session error count. … … 75 70 S X=$P(MAG0,U,12) 76 71 S MAGGFDA(2006.81,MAGIEN,12)=X+1 ; Sess count for wrks. 77 ; Keep PLACE that this wrks logged in.72 ; Keep the last PLACE that this wrks logged in. 78 73 S MAGPL=0 I $D(DUZ(2)) S MAGPL=+$$PLACE^MAGBAPI(DUZ(2)) ; DBI 79 74 I MAGPL S MAGGFDA(2006.81,MAGIEN,.04)=MAGPL ; DBI … … 87 82 D UPDATE^DIE("S","MAGGFDA","MAGXIEN","MAGXERR") 88 83 I $D(DIERR) D RTRNERR(.MAGRY) Q 89 ; The MAGJOB(array is used by Imaging routines that are84 ; The " MAGJOB(" array is used by Imaging routines that are 90 85 ; called from the Delphi App. 86 ; We use nodes of the Array MAGJ0B to organize the shared partition variables. 91 87 ; 92 ; 3. 0.8 Whatever App calls this, we'll use that Version number.88 ; 3.O.8 Whatever App calls this, we'll use that Version number. 93 89 S MAGVERX=$S(MAGVERSD]"":MAGVERSD,MAGVERSC]"":MAGVERSC,MAGVERVR]"":MAGVERVR,1:0) 94 90 S MAGJOB("WRKSIEN")=+MAGIEN … … 96 92 S MAGRY="1^" 97 93 ; 98 ; SESSION : Create new session entry94 ; SESSION : Now we create new session entry 99 95 D GETS^DIQ(200,DUZ_",","29","I","Z","") ; service/section 100 96 S MAGSRV=$G(Z(200,DUZ_",",29,"I")) … … 158 154 ; $P(9) is Vrad REMOTE Read flag (1/0; 1=REMOTE) 159 155 ; $P(TXT,"$$",2) is Tracking ID from an Imported Image. From this we compute Session #, to log actions. 160 ; LOGTM - [1|0] Flag to indicate whet her or not to log the time of the Action. Default = 0156 ; LOGTM - [1|0] Flag to indicate wheter or not to log the time of the Action. Default = 0 161 157 ; MAGSESS - Session IEN where the action should be logged. Default to MAGJOB("SESSION") 162 158 ; … … 202 198 ; and marks the session closed. 203 199 ; 200 K ^TMP("MAGGTAU","LOGOFF",$J) 204 201 S MAGRY=1 205 202 N MAGGFDA,MAGXERR,MAGXIEN,MAGIEN,MAGSESS,MAGEND,MAGCON -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTERR.m
r628 r636 1 1 MAGGTERR ;WOIFO/GEK - IMAGING ERROR TRAP, AND ERROR LOG ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 21 20 ; This will enable logging Imaging errors and Sending messages for 22 21 ; certain errors etc. later 23 ;N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 22 ;IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 23 ;E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP") 24 24 ; 25 25 ; This assumes the Return variable or array is MAGRY or MAGRY() … … 46 46 LOGERR(ERROR) ; 47 47 Q:'$G(MAGJOB("SESSION")) 48 N SESS,WRKS,ERR 49 S SESS=$G(MAGJOB("SESSION")) 50 ; Quit if No entry in Session File. 51 Q:'$D(^MAG(2006.82,SESS,0)) 52 I '$D(^MAG(2006.82,SESS,"ERR",0)) S ^MAG(2006.82,SESS,"ERR",0)="^2006.823A^0^0" 53 S ERR=$O(^MAG(2006.82,SESS,"ERR"," "),-1)+1 54 S ^MAG(2006.82,SESS,"ERR",ERR,0)=ERROR 55 S $P(^MAG(2006.82,SESS,"ERR",0),"^",3,4)=ERR_"^"_ERR 56 ; 57 Q:'$G(MAGJOB("WRKSIEN")) 58 S WRKS=$G(MAGJOB("WRKSIEN")) 59 ; Quit if No entry in Workstation File. 60 Q:'$D(^MAG(2006.81,WRKS,0)) 61 S $P(^MAG(2006.81,WRKS,0),"^",11)=ERR 48 N MAGGFDA,MAGXERR,MAGXIEN,MAGNODE 49 S MAGNODE="+1,"_+MAGJOB("SESSION")_"," 50 ;S MAGNODE="+1,10," 51 S MAGGFDA(2006.823,MAGNODE,.01)=ERROR 52 D UPDATE^DIE("","MAGGFDA","MAGXIEN","MAGXERR") 53 ; error flag for this session in workstation file 54 S MAGNODE=+MAGJOB("WRKSIEN")_"," 55 S MAGGFDA(2006.81,MAGNODE,11)=+MAGXIEN(1) ; 56 D UPDATE^DIE("","MAGGFDA","MAGXIEN","MAGXERR") 62 57 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTIA1.m
r628 r636 1 1 MAGGTIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**21,8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**21,8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 33 32 . D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN 34 33 ; 35 ; There are incidents of using an IEN from a deleted image 36 ; these next lines are to stop the problem.34 ; There are incidents of using an IEN from a deleted image (still) 35 ; these next lines are TESTING for now. To stop the problem. 37 36 S GIEN=$O(^MAG(2005," "),-1)+1 38 37 S DIEN=$O(^MAG(2005.1," "),-1)+1 … … 56 55 ; we Return the IEN with NO Filename. Groups don't get Filename 57 56 ; 58 I MAGGR S MAGRY=MAGGDA_U,Z="" D G C157 I MAGGR S MAGRY=MAGGDA_U,Z="" D Q 59 58 . F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA 60 59 . D CLEAN 61 60 ; 62 61 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D 63 . ; If here: This image is a member of a Group 64 . ; -Modify the Group Parent, add DA to it's group 65 . ; -Also set 'Series Number' and 'Image Number' if they exist; 62 . ; We're here beceause this image is a member of a Group 63 . ; so we will modify the Group Parent, adding this to it's group 64 . ; HERE we will also send the 'Series Number' and 'Image Number' if 65 . ; they exist; 66 66 . K MAGGFDA 67 67 . S Y="+2,"_X_"," … … 72 72 . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE") 73 73 ; 74 ; Now get the Image file name. DOS FILE name 75 ; The ENTRY in Image File has been made, if any errors from here on 74 ; 75 ; 76 ; now get the Image file name. DOS FILE name 77 ; ENTRY in Image File has been made, if any errors from here on 76 78 ; then we have to delete the image entry. 77 79 I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1 … … 93 95 ; 94 96 C1 ; we jump here if we already had a Filename sent 97 ; 95 98 K MAGGFDA 96 99 ; New Index Field Check. If this entry doesn't have the Index fields introduced 97 100 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values. 98 101 ; 99 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry. 100 I '$D(^MAG(2005,MAGGDA,40)) D 101 . N INDXD 102 . D GENIEN^MAGXCVI(MAGGDA,.INDXD) 103 . S ^MAG(2005,MAGGDA,40)=INDXD 104 . S ^MAGIXCVT(2006.96,MAGGDA)=2 ; Flag. Says fields were converted Patch 59 105 . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108) 106 . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108)) 107 . D ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1) 108 . Q 109 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values. 110 I '$P(^MAG(2005,MAGGDA,40),"^",3) D 111 . N INDXD,OLD40,N40 112 . S (N40,OLD40)=^MAG(2005,MAGGDA,40) 113 . D GENIEN^MAGXCVI(MAGGDA,.INDXD) 114 . ; If Origin doesn't exist in existing, this will put V in. 115 . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V" 116 . ; We're not changing existing values of Spec,Proc or Origin 117 . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J) 118 . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc 119 . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5) 120 . S ^MAG(2005,MAGGDA,40)=N40 121 . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108)) 122 . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1) 123 . Q 102 ;-This is being deferred to a later patch. 103 ;-I '$D(^MAG(2005,MAGGDA,40)) D 104 ;-. D ONE^MAGSCNVI(MAGGDA) 105 ;-. D ACTION^MAGGTAU("DFTINDX^^"_MAGGDA) 106 ; 124 107 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE. 125 108 ;** IT IS DONE IN A SEPERATE CALL … … 136 119 ; 137 120 ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT 138 ; example:487^C:\IMAGE\^DC000487.TIF121 ; i.e 487^C:\IMAGE\^DC000487.TIF 139 122 ; The calling routine is responsible for renaming/naming the file 140 123 ; to the returned DRIVE:\DIR\FILENAME.EXT 141 ; 4/23/98 to include hierarchical directory structure -- PMK124 ; Modified 4/23/98 to include hierarchial directory structure -- PMK 142 125 ; 143 I 'MAGGR D 144 . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 145 . S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 146 . ; For now, BIG files are in same directory as FullRes (or PACS) file 147 . I $G(MAGBIG) D 148 . . S X=$P(MAGGFNM,".",1)_".BIG" 149 . . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X 150 . . Q 126 S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF) 127 S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM 128 ; For now, BIG files are in same directory as FullRes (or PACS) file 129 I $G(MAGBIG) D 130 . S X=$P(MAGGFNM,".",1)_".BIG" 131 . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X 151 132 . Q 152 133 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTID.m
r628 r636 1 1 MAGGTID ;WOIFO/SRR/RED/SAF/GEK - Deletion of Images and Pointers ; [ 06/20/2001 08:56 ] 2 ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 20 19 ; 21 20 IMAGEDEL(MAGGRY,MAGIEN,MAGGRPDF,REASON) ;RPC [MAGG IMAGE DELETE] 22 ; Call to Delete Image entry from Image file ^MAG(2005 23 ; MAGIEN Image IEN ^ SYSDEL flag 24 ; MAGGRPDF group delete flag 1 = group delete allowed 25 ; SYSDEL Flag that forces delete, even if no KEY 26 ; 21 ; Call to Delete Image entry 22 ; SEB 6/6/2002 - added MAGGRPDF - group delete flag = 1 if group delete allowed 23 ; from Image file ^MAG(2005 27 24 N Y,RY 28 25 ; 1 in 3rd piece means : DELETE the Image File Also. … … 135 132 Q 136 133 SETDEL(MAGIEN,REASON) ; set deletion fields 137 N DA,DR,DIE,X 138 ;N %H 139 ;S %H=$H D YMD^%DTC 140 S X=$$NOW^XLFDT 134 N DA,DR,DIE,%H,X 135 S %H=$H D YMD^%DTC 141 136 ; gek - changed 3 slash to 4 slash. to stop FM question marks. ?? 142 137 S DR="30////"_DUZ_";30.1////"_X_";30.2////"_REASON … … 145 140 ; 146 141 ARCHIVE(MAGARCIE) ;save image data before deletion 147 N MAGCNT,MAGLAST ,%X,%Y142 N MAGCNT,MAGLAST 148 143 S MAGCNT=$P(^MAG(2005.1,0),U,4)+1 149 144 S %X="^MAG(2005,"_MAGARCIE_",",%Y="^MAG(2005.1,"_MAGARCIE_"," -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTII.m
r628 r636 1 1 MAGGTII ;WOIFO/GEK - RETURN IMAGE INFO ; [ 11/08/2001 17:18 ] 2 ;;3.0;IMAGING;**8,48,63,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8,48,63**;Apr 11, 2005 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 40 40 ; $P(19^20) Patient DFN ^ Patient Name; // Patch 3.8 41 41 ; $P(21) Image Class: Clin,Admin,Clin/Admin,Admin/Clin 42 ; $p(22) Date Time Image Saved(FLD 7)43 ; $p(23) Document Date (FLD 110)44 42 ; 45 43 N FILETYPE,MAGPREF,MAGJBCP,GRPTYPE,GRPIEN,ABSTYPE,MAGTYPE,MAGJBOL 46 44 N MAGOFFLN,FULLTYPE,MAGOBJT,MAGQI,X 47 45 N ABSFILE,FULLFILE,BIGFILE,PATCH,MDFN,FNL,PLC,PLCODE 48 N MAGN0,MAGN2,MAGN40 ,MAGN10046 N MAGN0,MAGN2,MAGN40 49 47 ; set the Variables for the Global Nodes of the Image Entry 50 S MAGN0=$G(^MAG(2005,MAGXX,0)) 51 S MDFN=$P(MAGN0,"^",7) 48 S MAGN0=$G(^MAG(2005,MAGXX,0)),MDFN=$P(MAGN0,"^",7) ; P48T1 MDFN 52 49 S MAGN2=$G(^MAG(2005,MAGXX,2)) 53 50 S MAGN40=$G(^MAG(2005,MAGXX,40)) 54 S MAGN100=$G(^MAG(2005,MAGXX,100)) 55 ; Set Name in Variable, Call $$GET 1 time not 2000 56 I MDFN I '$D(MAGJOB("PTNM",MDFN)) S MAGJOB("PTNM",MDFN)=$$GET1^DIQ(2,MDFN_",",.01) 51 ; P48T1 Set Name in Variable, Call $$GET 1 time not 2000 52 I '$D(MAGJOB("PTNM",MDFN)) S MAGJOB("PTNM",MDFN)=$$GET1^DIQ(2,MDFN_",",.01) 57 53 I '$D(MAGJOB("NETPLC")) D NETPLCS^MAGGTU6 58 54 ; Object Type … … 119 115 S PLC=$P($G(MAGJOB("NETPLC",FNL)),"^",1) 120 116 S PLCODE=$P($G(MAGJOB("NETPLC",FNL)),"^",2) 121 I PLC="" S PLC=$G(MAGJOB("PLC")),PLCODE=$G(MAGJOB("PLCODE")) ; Group of 0 need this.122 117 ; if we were using first image of a group, reset the Real IEN 123 118 I $G(GRPIEN) S MAGXX=GRPIEN … … 135 130 K MAGFILE 136 131 S $P(MAGFILE,U,25)="" ; We put extra '^^^' on end of String to stop error in Delphi. 137 ; Pieces 26 BrokerServer and 27 Broker Port are set if this is P59 Client. 138 ; Clients Prior to Patch 59, the String must only be 25 pieces. - Patch 45 snafu 139 ; 132 ; 140 133 ; $P(1^2^3) IEN^Image FullPath and name^Abstract FullPath and Name 141 134 S $P(MAGFILE,U,1,3)=MAGXX_U_FULLFILE_U_ABSFILE 135 S $P(MAGFILE,U,18)=BIGFILE 142 136 ; 143 137 ; now set $P(4) SHORT DESCRIPTION field and desc of offline JukeBox … … 156 150 ; the delphi TStringGrid so we display mm/dd/yyyy 157 151 ; now set $P(8) display date 158 S X=$ $FMTE^XLFDT($P(MAGN2,U,5),"5Z")159 S X=$TR(X,"@"," ")152 S X=$P($P(MAGN2,"^",5),".",1) 153 I X'="" S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700) 160 154 S $P(MAGFILE,U,8)=X 161 155 ; … … 174 168 ; $p(12) and $p(13) 175 169 ; 176 ; 14 -count of images , if this is a group170 ; lets add the count of images , if this is a group 177 171 S X=+$P($G(^MAG(2005,MAGXX,1,0)),U,4),$P(MAGFILE,U,14)=$S(X:X,1:1) 178 172 ; … … 191 185 . ;Send the error message 192 186 . S $P(MAGFILE,U,17)=$P(MAGQI(0),U,2) 193 ; $p(18) is BIGFile Full name and path. 194 S $P(MAGFILE,U,18)=BIGFILE 195 ; DFN 196 S $P(MAGFILE,U,19)=$P(MAGN0,U,7) 197 ; Patient Name 198 S $P(MAGFILE,U,20)=$S(MDFN:MAGJOB("PTNM",MDFN),1:MDFN) 187 ; $p(18) is BIGFile Full name and path. ( set above) 188 ; Patches prior to 8, only had 17 pieces of data. this will speed up their listings. 189 ; Patch 8 had New M rtn MAGSIXG1, if it doesn't exist, this is PRE - 8. 190 I '$L($T(PGI^MAGSIXG1)) Q 191 S $P(MAGFILE,U,19)=$P(MAGN0,U,7) ; DFN 192 ; P48T1 The change to speed up access to large groups left out patient name. 193 ;S $P(MAGFILE,U,20)=$$GET1^DIQ(2,$P(MAGN0,U,7)_",",.01) ; Patient Name 194 S $P(MAGFILE,U,20)=MAGJOB("PTNM",MDFN) 199 195 S $P(MAGFILE,U,21)=$S(+$P(MAGN40,U,2):$P(^MAG(2005.82,$P(MAGN40,U,2),0),U),1:"") 200 S X=$$FMTE^XLFDT($P(MAGN2,U,1),"5Z") ; Date/Time Image Saved #7201 S X=$TR(X,"@"," ")202 S $P(MAGFILE,U,22)=X203 S X=$$FMTE^XLFDT($P(MAGN100,U,6),"5Z") ; DocumentDate #110204 S X=$TR(X,"@"," ")205 S $P(MAGFILE,U,23)=X206 ; If Patch 59 Client - we can set beyond 25 pieces.207 I $D(MAGJOB("RPCSERVER"))&$D(MAGJOB("RPCPORT")) D208 . S $P(MAGFILE,U,26)=MAGJOB("RPCSERVER")209 . S $P(MAGFILE,U,27)=MAGJOB("RPCPORT")210 . S $P(MAGFILE,U,28)="" ; "^" at end, stops problems in delphi211 . Q212 196 ; Stop displaying a Group of 1 as a Group, so here we'll change Object type 213 197 ; to that of the '1ST' image in the group of 1. … … 217 201 . S $P(MAGFILE,U,6)=$P(^MAG(2005,X,0),U,6) ; OBJECT TYPE OF 1ST IMAGE IN GROUP 218 202 . S $P(MAGFILE,U,1)=X 219 . Q203 . ; Need Site and Site code of 220 204 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTLB1.m
r628 r636 1 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 118 118 I $D(DIERR) S MAGRY="0^Unsuccessful both files not updated." K DIERR Q 119 119 S MAGRY="1^Success in filing both parent & image files." K DIERR 120 D LINKDT^MAGGTU6(.X,+MAGIEN)121 120 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTMC1.m
r628 r636 1 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 28 27 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 29 28 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") 30 N I,J,K,X,Y,Z,TIME,PSIEN,DFN,MAGPTR,MAGMCIEN,MCFILE,MAGOK,MAGERR ,PROCSTUB29 N I,J,K,X,Y,Z,TIME,PSIEN,DFN,MAGPTR,MAGMCIEN,MCFILE,MAGOK,MAGERR 31 30 ; 32 31 S X=$P(DATA,U,1),%DT="TS" D ^%DT S TIME=Y … … 55 54 S I="" F S I=$O(MAGPTR(I)) Q:I="" D 56 55 . S $P(^MAG(2005,I,2),U,6,8)=MAGPTR(I) 57 . D LINKDT^MAGGTU6(.X,I)58 56 S MAGRY=MAGOK 59 57 Q … … 64 62 ; DATA is null ^ PSIEN ^ DFN ^ MCIEN ^ null 65 63 ; 66 N TMCFILE,TPSIEN,TDFN,TMCIEN ,RETX64 N TMCFILE,TPSIEN,TDFN,TMCIEN 67 65 S TPSIEN=+$P(DATA,U,2) 68 66 S TDFN=+$P(DATA,U,3) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTPT1.m
r628 r636 1 1 MAGGTPT1 ;WOIFO/GEK - Delphi-Broker calls for patient lookup and information ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**16,8,92 ,46,59**;Nov 27, 2007;Build 202 ;;3.0;IMAGING;**16,8,92**;Jan 10, 2007;Build 1 3 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 23 23 ; MAGRY is the Array to return. 24 24 ; ZY is parameter sent by calling app (Delphi) 25 ; FILE NUM ^ NUM TO RETURN ^ TEXT TO MATCH ^^ SCREEN ($P 5-99)25 ; NUM TO RETURN ^ TEXT TO MATCH ^ ^ ^ SCREEN ($P 5-99) 26 26 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 27 27 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTRA.m
r628 r636 1 1 MAGGTRA ;WOIFO/GEK - RPC Call to list Patient's Rad/Nuc Exams, Reports ; [ 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 40 40 ; MAGIEN is Image File IEN ^MAG(2005,IEN 41 41 ; 42 N Y,I,CT,MAGERR ,DIQUIET43 N RADFN,RADTI,RACNI,RANME,RASSN,RADATE,RADTE,RACN,RAPRC,RARPT,RAST ,MAGGP42 N Y,I,CT,MAGERR 43 N RADFN,RADTI,RACNI,RANME,RASSN,RADATE,RADTE,RACN,RAPRC,RARPT,RAST 44 44 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR" 45 45 E S X="ERR^MAGGTERR",@^%ZOSF("TRAP") … … 72 72 ; DONE. 73 73 S MAGRY="1^Image pointer filed successfully" 74 D LINKDT^MAGGTU6(.X,MAGIEN)75 74 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTSR.m
r628 r636 1 1 MAGGTSR ;WOIFO/GEK - SURGERY CASE LIST ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 18 17 ;; 19 18 Q 20 GET(MAGRY,MAGDFN ,DATA) ;RPC [MAGGSUR GET]19 GET(MAGRY,MAGDFN) ;RPC [MAGGSUR GET] 21 20 ; Call to get list of Patient Surgery procedures 22 ; MAGDFN =Patient DFN23 ; DATA = For Future Use.24 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"25 N Y,NAME,AI,CASES,SDAT,DTX,SRFDA26 K ^TMP($J,"MAGGTSR")27 S NAME=$P($G(^DPT(MAGDFN,0)),U) I NAME="" S MAGRY(0)="0^INVALID Patient ID" Q28 ; This is the Old Call we have always made. Doesn't have Non-OR21 ; MAGDFN is Patient DFN 22 ; 23 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR" 24 E S X="ERRA^MAGGTERR",@^%ZOSF("TRAP") 25 N Y,DFN,MAGNAME 26 S MAGNAME=$P($G(^DPT(MAGDFN,0)),U) 27 I MAGNAME="" S MAGGRY(0)="0^INVALID Patient ID" Q 29 28 D GET^SROGTSR(.MAGRY,MAGDFN) 30 I 'MAGRY(0) S MAGRY(0)=MAGRY(0)_" for "_NAME G C1 31 ; Image count is for future use by Display 32 S MAGRY(1)="#^Date^Case description^Case #^Images" 29 I 'MAGRY(0) S MAGRY(0)=MAGRY(0)_" for "_MAGNAME Q 30 ; Here we are changing the data returned in the array, from SROGTSR 31 ; , it will now also return the count of images associated with the 32 ; surgery report. This is in advance of the change for Display, to 33 ; list the patient's surgery reports, like we list radiology reports. 34 ; 35 I (+$G(MAGJOB("VERSION"))<2.5) Q 36 S MAGRY(1)=$P(MAGRY(1),U,1,3)_"^Images" 33 37 S I=1 F S I=$O(MAGRY(I)) Q:'I D 34 . S DTX=$$FMTE^XLFDT($P(MAGRY(I),U,5),"5MZ") 35 . S ^TMP($J,"MAGGTSR",$P(MAGRY(I),U,5),$P(MAGRY(I),U,4))=DTX_"^"_$P(MAGRY(I),U,3)_"^"_$P(MAGRY(I),"^",4)_"^"_$P(MAGRY(I),U,6)_U_"|"_$P(MAGRY(I),U,4,5)_U 36 ; 37 ;This is the New Call, which has Non-OR, but doesn't have (Scheduled) so we merge the two calls. 38 C1 D LIST^SROESTV(.CASES,MAGDFN) 39 I '$D(@CASES) G E1 40 S MAGRY(0)="1^" 41 S MAGRY(1)="#^Date^Case description^Case #^Images" 42 S I=0 F S I=$O(@CASES@(I)) Q:'I D 43 . S SDAT=@CASES@(I) 44 . ; SDAT = SURIEN ^ SURDESC ^ SURDT ^ DFN;NAME ^ 45 . I $D(^TMP($J,"MAGGTSR",$P(SDAT,U,3),$P(SDAT,U,1))) Q 46 . S ^TMP($J,"MAGGTSR",$P(SDAT,U,3),$P(SDAT,U,1))=$$FMTE^XLFDT($P(SDAT,U,3),"5MZ")_U_$P(SDAT,U,2)_U_$P(SDAT,U,1)_U_$$IMGCT($P(SDAT,U,1))_U_"|"_$P(SDAT,U,1)_U_$P(SDAT,U,3)_U 47 . Q 48 ; 49 ; Now Returned the Merged List of the results of Old Call, with Results of New Call. 50 E1 ; 51 I '$D(^TMP($J,"MAGGTSR")) S MAGRY(0)="0^No Cases for "_$G(NAME) Q 52 S I=1,DTX=0,SRFDA=0 53 F S DTX=$O(^TMP($J,"MAGGTSR",DTX)) Q:'DTX D 54 . S SRFDA="" F S SRFDA=$O(^TMP($J,"MAGGTSR",DTX,SRFDA),-1) Q:'SRFDA D 55 . . S I=I+1,MAGRY(I)=I-1_"^"_^TMP($J,"MAGGTSR",DTX,SRFDA) 56 . . Q 57 . Q 58 S $P(MAGRY(0),"^",1)=I-1 38 . S MAGRY(I)=$P(MAGRY(I),U,1,3)_U_$P(MAGRY(I),U,6)_U_$C(124)_$P(MAGRY(I),U,4,5)_U 59 39 Q 60 IMGCT(SRFIEN) ;61 ; Count of images for this Surgery Case62 ; If more than one group (or image)63 ; then return "Group count : total images" i.e. "3:134"64 ; else return count of Images i.e. "4"65 ;66 N CT,GCT,ICT,J67 S J=0,CT=0,GCT=068 F S J=$O(^SRF(SRFIEN,2005,"B",J)) Q:'J D69 . S ICT=+$P($G(^MAG(2005,J,1,0)),U,4)70 . S ICT=$S(ICT:ICT,1:1) ;If no group images, set count =1 (single image)71 . S GCT=GCT+172 . S CT=CT+ICT73 I (GCT>1) Q GCT_":"_CT74 Q CT75 ;76 40 IMAGE(MAGRY,DATA) ; 77 41 ; Called with the IEN of the Surgery package ^SRF(170,x … … 87 51 ; We'll make a tmp list of just the image IEN's 88 52 ; splitting groups into individual image entries. 89 K ^TMP( $J,"MAGGX")53 K ^TMP("MAGGX",$J) 90 54 S I=0,CT=1 F S I=$O(^SRF(SRFIEN,2005,I)) Q:'I D 91 55 . S MAGIEN=$P(^SRF(SRFIEN,2005,I,0),U,1) 92 56 . Q:'$D(^MAG(2005,MAGIEN,0)) 93 . I '$O(^MAG(2005,MAGIEN,1,0)) S ^TMP( $J,"MAGGX",MAGIEN)=""94 . E S Z=0 F S Z=$O(^MAG(2005,MAGIEN,1,Z)) Q:Z="" S ^TMP( $J,"MAGGX",$P(^MAG(2005,MAGIEN,1,Z,0),U,1))=""95 I '$D(^TMP( $J,"MAGGX")) S MAGRY(0)="0^Surgery File Entry "_SRFIEN_": has INVALID Image Pointers" Q57 . I '$O(^MAG(2005,MAGIEN,1,0)) S ^TMP("MAGGX",$J,MAGIEN)="" 58 . E S Z=0 F S Z=$O(^MAG(2005,MAGIEN,1,Z)) Q:Z="" S ^TMP("MAGGX",$J,$P(^MAG(2005,MAGIEN,1,Z,0),U,1))="" 59 I '$D(^TMP("MAGGX",$J)) S MAGRY(0)="0^Surgery File Entry "_SRFIEN_": has INVALID Image Pointers" Q 96 60 S Z="",CT=0 97 61 S MAGQUIET=1 98 F S Z=$O(^TMP( $J,"MAGGX",Z)) Q:Z="" D62 F S Z=$O(^TMP("MAGGX",$J,Z)) Q:Z="" D 99 63 . S CT=CT+1,MAGXX=Z D INFO^MAGGTII 100 64 . S MAGRY(CT)="B2^"_MAGFILE -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTSR1.m
r628 r636 1 1 MAGGTSR1 ;WOIFO/GEK - ADD IMAGES TO SURGERY FILE ; [ 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 48 47 S MAGRY="1^Image added to Surgery Package" 49 48 S $P(^MAG(2005,MAGIEN,2),U,6,8)="130^"_MAGSIEN_U_MAGIENS(1) 50 D LINKDT^MAGGTU6(.X,MAGIEN)51 49 Q 52 50 RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTSY2.m
r628 r636 1 1 MAGGTSY2 ;WOIFO/GEK - Calls from Imaging windows for System Manager ; [ 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 17 17 ;; 18 18 Q 19 MAG(MAGRY,NODE) ;RPC Call to show node of Image File 20 ; NODE is the IEN of Image File : ^MAG(2005,NODE 21 N Y,I,CT,X,TNODE 19 MAG(MAGRY,NODE) ; RPC Call for MAGSYS utility. Returns Global Node. 20 N CT,I,X,Y 22 21 S MAGRY=$NA(^TMP("MAGNODE",$J)) 23 S NODE= $G(NODE)24 N I,CT,X22 S NODE=+$G(NODE) 23 I 'NODE S NODE=$P(^MAG(2005,0),U,3) 25 24 K @MAGRY 26 S @MAGRY@(0)="Display NODE: "_$S($L(NODE):NODE,1:"LAST")25 ;S @MAGRY@(0)="Display Imaging File NODE "_$S(NODE:NODE,1:"LAST") 27 26 S I=0,CT=0 28 I $E(NODE)="^" G OTH29 I 'NODE S NODE=$P(^MAG(2005,0),U,3)30 27 S I="^MAG(2005,"_NODE_","""")" 31 28 F S X=$Q(@I) S I=X Q:$P(X,",",2)'=NODE D 32 29 . S CT=CT+1,@MAGRY@(CT)=X_" "_@X 33 . Q34 I $P($G(^MAG(2005,NODE,2)),"^",6)="8925" D35 . S CT=CT+1,@MAGRY@(CT)=" ******* TIU ******* "36 . S TNODE=$P(^MAG(2005,NODE,2),"^",7)37 . S I="^TIU(8925,"_TNODE_","""")"38 . F S X=$Q(@I) S I=X Q:$P(X,",",2)'=TNODE D39 . . S CT=CT+1,@MAGRY@(CT)=X_" "_@X40 . . Q41 30 Q 42 OTH ;43 N OTHDA44 S OTHDA=$P(NODE,",",2)45 I OTHDA=0 S NODE=NODE_")" Q:'$D(@NODE) S CT=$O(@MAGRY@(""),-1)+1,@MAGRY@(CT)=$G(@(NODE)) Q46 S I=NODE_","""")"47 F S X=$Q(@I) S I=X Q:$P(X,",",2)'=OTHDA D48 . S CT=$O(@MAGRY@(""),-1)+1,@MAGRY@(CT)=X_" "_@X49 . Q50 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTSYS.m
r628 r636 1 1 MAGGTSYS ;WOIFO/GEK - Calls from Imaging windows for System Manager ; [ 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. 2 ;;3.0;IMAGING;;Mar 01, 2002 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 17 17 ;; 18 18 Q 19 GETS(MAGRY,NODE,FLAGS) ; USE GETS^DIQ TO GET FIELD VALUES. 20 K MAGWIN,I,CT,Y,NC,MAGOUT,MAGERR,TNC,ZZ 19 MAG(MAGRY,NODE) ;RPC Call to show node of Image File 20 ; NODE is the IEN of Image File : ^MAG(2005,NODE 21 N Y 21 22 S MAGRY=$NA(^TMP("MAGNODE",$J)) 22 23 S NODE=+$G(NODE) 23 24 I 'NODE S NODE=$P(^MAG(2005,0),U,3) 25 N MAGWIN,I,CT,X 24 26 S MAGWIN=$$BROKER^XWBLIB 27 K @MAGRY 28 ;S @MAGRY@(0)="Display Imaging File NODE "_$S(NODE:NODE,1:"LAST") 29 S I=0,CT=0 25 30 I 'MAGWIN W !,"NODE"," ",NODE 31 S I="^MAG(2005,"_NODE_","""")" 32 F S X=$Q(@I) S I=X Q:$P(X,",",2)'=NODE D 33 . S CT=CT+1,@MAGRY@(CT)=X_" "_@X 34 . I 'MAGWIN W !,X," ",@X 35 ; 36 Q 37 GETS(MAGRY,NODE,FLAGS) ; USE GETS^DIQ TO GET FIELD VALUES. 38 N Y 39 S MAGRY=$NA(^TMP("MAGNODE",$J)) 40 S NODE=+$G(NODE) 41 I 'NODE S NODE=$P(^MAG(2005,0),U,3) 42 N MAGWIN,I,CT 43 S MAGWIN=$$BROKER^XWBLIB 26 44 K @MAGRY 27 S @MAGRY@(0)=" ****** Fields for Image IEN: "_NODE_" ******"45 S @MAGRY@(0)="Fields for Image IEN: "_NODE 28 46 S I=0,CT=0 47 I 'MAGWIN W !,"NODE"," ",NODE 48 N MAGOUT,MAGERR 29 49 S FLAGS=$S($L($G(FLAGS)):FLAGS,1:"IERN") 30 50 D GETS^DIQ(2005,NODE,"*",FLAGS,"MAGOUT","MAGERR") 31 51 ;D GETS^DIQ(2005,NODE,".01;1;2;2.1;2.2;3;5;6;12","R","MAGOUT","MAGERR") 32 S N C=NODE_","33 S I="" F S I=$O(MAGOUT(2005,N C,I)) Q:I="" D52 S NNODE=NODE_"," 53 S I="" F S I=$O(MAGOUT(2005,NNODE,I)) Q:I="" D 34 54 . S CT=CT+1 35 . I $G(MAGOUT(2005,NC,I,"I"))=$G(MAGOUT(2005,NC,I,"E")) D Q 36 . . S ZZ=I,$E(ZZ,45,999)=" = "_$G(MAGOUT(2005,NC,I,"E")) 37 . . S @MAGRY@(CT)=ZZ 38 . . ;S @MAGRY@(CT)=I_" = "_MAGOUT(2005,NC,I,"E") Q 39 . . Q 40 . ; 41 . S ZZ=I,$E(ZZ,25,999)=" = ("_$G(MAGOUT(2005,NC,I,"I"))_") " 42 . I ($L(ZZ)>44) S ZZ=ZZ_" = "_$G(MAGOUT(2005,NC,I,"E")) S @MAGRY@(CT)=ZZ Q 43 . I ($L(ZZ)<45) S $E(ZZ,45,999)=" = "_$G(MAGOUT(2005,NC,I,"E")) S @MAGRY@(CT)=ZZ Q 44 . ;S @MAGRY@(CT)=I_" = ("_$G(MAGOUT(2005,NC,I,"I"))_") = "_$G(MAGOUT(2005,NC,I,"E")) 45 . Q 46 I $P($G(^MAG(2005,NODE,2)),"^",6)=8925 D 47 . K MAGOUT,MAGERR 48 . S CT=CT+1,@MAGRY@(CT)=" *************** TIU *************** " 49 . S CT=CT+1,@MAGRY@(CT)=" **** Field Values for TIUDA: "_$P(^MAG(2005,NODE,2),"^",7)_" ****" 50 . D GETS^DIQ(8925,$P(^MAG(2005,NODE,2),"^",7),"*",FLAGS,"MAGOUT","MAGERR") 51 . S NC=$P(^MAG(2005,NODE,2),"^",7)_"," 52 . S I="" F S I=$O(MAGOUT(8925,NC,I)) Q:I="" D 53 . . S CT=CT+1 54 . . I $G(MAGOUT(8925,NC,I,"I"))=$G(MAGOUT(8925,NC,I,"E")) D Q 55 . . . S ZZ=I,$E(ZZ,45,999)=" = "_$G(MAGOUT(8925,NC,I,"E")) 56 . . . S @MAGRY@(CT)=ZZ 57 . . . ;S @MAGRY@(CT)=I_" = "_MAGOUT(2005,NC,I,"E") Q 58 . . . Q 59 . . ; 60 . . S ZZ=I,$E(ZZ,25,999)=" = ("_$G(MAGOUT(8925,NC,I,"I"))_") " 61 . . I ($L(ZZ)>44) S ZZ=ZZ_" = "_$G(MAGOUT(8925,NC,I,"E")) S @MAGRY@(CT)=ZZ Q 62 . . I ($L(ZZ)<45) S $E(ZZ,45,999)=" = "_$G(MAGOUT(8925,NC,I,"E")) S @MAGRY@(CT)=ZZ Q 63 . . ;S @MAGRY@(CT)=I_" = ("_$G(MAGOUT(2005,NC,I,"I"))_") = "_$G(MAGOUT(2005,NC,I,"E")) 64 . . Q 65 . Q 55 . I $G(MAGOUT(2005,NNODE,I,"I"))=$G(MAGOUT(2005,NNODE,I,"E")) S @MAGRY@(CT)=I_" = "_MAGOUT(2005,NNODE,I,"E") Q 56 . S @MAGRY@(CT)=I_" = ("_$G(MAGOUT(2005,NNODE,I,"I"))_") = "_$G(MAGOUT(2005,NNODE,I,"E")) 66 57 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU1.m
r628 r636 1 1 MAGGTU1 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**3,8,85 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**3,8,85**;16-March-2007;;Build 1039 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU3.m
r628 r636 1 1 MAGGTU3 ;WOIFO/GEK - Silent calls for Imaging ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**7,8,48,45,20,46 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**7,8,48,45,20,46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 18 18 Q 19 19 IMAGEINF(MAGRY,IEN,NOCHK) ;RPC [MAGG IMAGE INFO] Call to return information for 1 image; 20 ; IEN = Image IEN 21 ; NOCHK = 1|"" if 1then do not run QA check on this image.20 ; IEN = Image IEN ^MAG(2005,IEN 21 ; NOCHK = If Flag = 1, then do not run QA check on this image. 22 22 ; 23 23 N MAGFILE,Y,Z,MAGNOCHK … … 66 66 ; NOW NET STUFF 67 67 I 'MAGPLC Q 68 ; From IMAGING SITE PARAMETERS File69 ; 68 ; Get info from IMAGING SITE PARAMETERS File 69 ; get the Network UserName and PassWord. 70 70 S MAGRY(2)=$P($G(^MAG(2006.1,MAGPLC,"NET")),U,1,2) 71 ; 71 ; get the default MUSE Site number. 72 72 S MAGRY(3)=+$P($G(^MAG(2006.1,MAGPLC,"USERPREF")),U,2) 73 ; 73 ; default to 1 if nothing is entered in Site Parameters File 74 74 I MAGRY(3)=0 S MAGRY(3)=1 75 75 ; This SITEIEN^SITECODE^USER INSTITUTION IEN^INSTITUTION NAME^CONSOLIDATED^User's local STATION NUMBER … … 80 80 S MAGJOB("PLCODE")=$$GET1^DIQ(2006.1,MAGPLC,.09) 81 81 S MAGRY(4)=MAGRY(4)_U_$$CONSOLID^MAGBAPI_U_$$GET1^DIQ(4,DUZ(2),99,"E") 82 ; is CP not installed at this site, the Clientwill hide options83 ; related to CP .82 ; is CP installed at this site, the Front End will hide options 83 ; related to CP if not installed. 84 84 S X=$$VERSION^XPDUTL("CLINICAL PROCEDURES") 85 85 S MAGRY(5)=+X_U_X … … 158 158 Q 159 159 GETINFO(MAGRY,IEN) ; RPC [MAG4 GET IMAGE INFO] 160 ; Call (3.0p8) to get information on 1 image 161 ; and Display in the Image Information Window 162 D GETINFO^MAGGTU31(.MAGRY,IEN) 163 Q 160 ; Call (3.0p8) to get information on 1 image 161 N Y,J,JI,I,CT,IENC,FLAGS,SNGRP,Z,M40,T,QACHK 162 S I=0,CT=0 163 S MAGRY(CT)="Image ID#: "_IEN 164 I $D(^MAG(2005.1,IEN)) D Q 165 . S CT=CT+1,MAGRY(CT)=" STATUS: "_"HAS BEEN DELETED. !!" 166 . S CT=CT+1,MAGRY(CT)="Deleted By: "_$$GET1^DIQ(2005.1,IEN,30,"E") 167 . S CT=CT+1,MAGRY(CT)=" Reason: "_$$GET1^DIQ(2005.1,IEN,30.2,"E") 168 . S CT=CT+1,MAGRY(CT)=" Date: "_$$GET1^DIQ(2005.1,IEN,30.1,"E") 169 . Q 170 S M40=$G(^MAG(2005,IEN,40)),T=$P(M40,"^",3) 171 S Z=$P($G(^MAG(2005,IEN,0)),"^",10) I Z D 172 . S CT=CT+1,MAGRY(CT)=" is in Group#: "_Z_" ("_+$P(^MAG(2005,Z,1,0),"^",4)_" images)" 173 . D CHK^MAGGSQI(.QACHK,Z) Q:QACHK(0) 174 . S CT=CT+1,MAGRY(CT)=" QA Warning - Group#: "_Z_" "_$P(QACHK(0),"^",2) 175 . Q 176 S SNGRP="FLDS" 177 I (+$O(^MAG(2005,IEN,1,0)))!($P(^MAG(2005,IEN,0),"^",6)=11)!($P(^MAG(2005,IEN,0),"^",6)=16) D 178 . S CT=CT+1,MAGRY(CT)=$P(^MAG(2005,IEN,0),"^",8)_" Group of "_+$P($G(^MAG(2005,IEN,1,0)),U,4) 179 . S SNGRP="FLDG" 180 . Q 181 K QACHK 182 D CHK^MAGGSQI(.QACHK,IEN) I 'QACHK(0) D 183 . S CT=CT+1,MAGRY(CT)=" QA Warning - Image#: "_IEN_" "_$P(QACHK(0),"^",2) 184 N MAGOUT,MAGERR,MAGVAL 185 S IENC=IEN_"," 186 S FLAGS="EN" 187 S I=-1 188 F S I=I+1,Z=$T(@SNGRP+I) Q:$P(Z,";",3)="end" D 189 . S J=$P(Z,";",4),JI=J_";" 190 . K MAGOUT 191 . S CT=CT+1,MAGRY(CT)=$P(Z,";",3) 192 . I J=41 D Q ; Need to compute the Class. Class field in Image File is wrong. 193 . . S MAGVAL=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^MAG(2005.82,$P(^MAG(2005.83,T,0),"^",2),0),"^",1)) 194 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL 195 . . Q 196 . D GETS^DIQ(2005,IEN,JI,FLAGS,"MAGOUT","MAGERR") 197 . ; Get Extension from FileRef 198 . I J=1 S MAGVAL=$P($G(MAGOUT(2005,IENC,J,"E")),".",2) 199 . E S MAGVAL=$G(MAGOUT(2005,IENC,J,"E")) 200 . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL 201 ; Compare Parent Association Date with Date/Time Note Signed. 202 I $P(^MAG(2005,IEN,0),"^",10) S IEN=$P(^MAG(2005,IEN,0),"^",10) 203 I $P(^MAG(2005,IEN,2),"^",6)=8925 S CT=CT+1,MAGRY(CT)=$$ATTSTAT^MAGGTU31(IEN) 204 Q 205 ; 206 FLDS ;;Format: ;3;; 207 ;;Extension: ;1;; 208 FLDG ;;Patient: ;5;; 209 ;;Desc: ;10;; 210 ;;Procedure: ;6;; 211 ;; Date: ;15;; 212 ;;Class: ;41;; 213 ;;Package: ;40;; 214 ;;Type: ;42;; 215 ;;Proc/Event: ;43;; 216 ;;Spec/SubSpec: ;44;; 217 ;;Origin: ;45;; 218 ;;Captured on: ;7;; 219 ;; by: ;8;; 220 ;;end;; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU31.m
r628 r636 1 1 MAGGTU31 ;WOIFO/GEK - Silent calls for Imaging ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 202 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | … … 62 61 I MAGMED S J=J+1,MAGK(J)="MAGCAP MED" 63 62 Q 64 GETINFO(MAGRY,IEN) ; RPC [MAG4 GET IMAGE INFO]Called from MAGGTU365 ; Call (3.0p8) to get information on 1 image66 ; and Display in the Image Information Window67 N Y,J,JI,I,CT,IENC,FLAGS,SNGRP,Z,M40,T,QACHK,OBJTYP,VAL,LBL68 S I=0,CT=069 S MAGRY(CT)="Image ID#: "_IEN70 I $D(^MAG(2005.1,IEN)) D Q71 . S CT=CT+1,MAGRY(CT)=" STATUS: "_"HAS BEEN DELETED. !!"72 . S CT=CT+1,MAGRY(CT)="Deleted By: "_$$GET1^DIQ(2005.1,IEN,30,"E")73 . S CT=CT+1,MAGRY(CT)=" Reason: "_$$GET1^DIQ(2005.1,IEN,30.2,"E")74 . S CT=CT+1,MAGRY(CT)=" Date: "_$$GET1^DIQ(2005.1,IEN,30.1,"E")75 . Q76 S M40=$G(^MAG(2005,IEN,40)),T=$P(M40,"^",3)77 S Z=$P($G(^MAG(2005,IEN,0)),"^",10) I Z D78 . S CT=CT+1,MAGRY(CT)=" is in Group#: "_Z_" ("_+$P(^MAG(2005,Z,1,0),"^",4)_" images)"79 . D CHK^MAGGSQI(.QACHK,Z) Q:QACHK(0)80 . S CT=CT+1,MAGRY(CT)=" QA Warning - Group#: "_Z_" "_$P(QACHK(0),"^",2)81 . Q82 S OBJTYP=$P(^MAG(2005,IEN,0),"^",6)83 S SNGRP="FLDS"84 I (+$O(^MAG(2005,IEN,1,0)))!(OBJTYP=11)!(OBJTYP=16) D85 . S CT=CT+1,MAGRY(CT)=$P($G(^MAG(2005,IEN,40)),"^",1)_" Group of "_+$P($G(^MAG(2005,IEN,1,0)),U,4)86 . S SNGRP="FLDG"87 . Q88 K QACHK89 D CHK^MAGGSQI(.QACHK,IEN) I 'QACHK(0) D90 . S CT=CT+1,MAGRY(CT)=" QA Warning - Image#: "_IEN_" "_$P(QACHK(0),"^",2)91 N MAGOUT,MAGERR,MAGVAL,PKG92 S IENC=IEN_","93 S FLAGS="EN"94 S I=-195 S PKG=""96 F S I=I+1,Z=$T(@SNGRP+I) Q:$P(Z,";",3)="end" D97 . S J=$P(Z,";",4),JI=J_";"98 . K MAGOUT99 . S CT=CT+1,MAGRY(CT)=$P(Z,";",3)100 . I J=41 D Q ; Need to compute the Class. Class field in Image File is wrong.101 . . S MAGVAL=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^MAG(2005.82,$P(^MAG(2005.83,T,0),"^",2),0),"^",1))102 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL103 . . Q104 . D GETS^DIQ(2005,IEN,JI,FLAGS,"MAGOUT","MAGERR")105 . ; Get Extension from FileRef106 . I J=1 S MAGVAL=$P($G(MAGOUT(2005,IENC,J,"E")),".",2)107 . E S MAGVAL=$G(MAGOUT(2005,IENC,J,"E"))108 . S MAGVAL=$TR(MAGVAL,"&","+")109 . I J=40 S PKG=MAGVAL110 . I ((J>=50)&(J<=54)) D Q111 . . I PKG'="LAB" K MAGRY(CT) Q112 . . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL113 . . Q114 . S MAGRY(CT)=MAGRY(CT)_" "_MAGVAL115 ; Compare Parent Association Date with Date/Time Note Signed.116 I $P(^MAG(2005,IEN,0),"^",10) S IEN=$P(^MAG(2005,IEN,0),"^",10)117 I $P(^MAG(2005,IEN,2),"^",6)=8925 S CT=CT+1,MAGRY(CT)=$$ATTSTAT^MAGGTU31(IEN)118 ;119 I (OBJTYP=11),($P($G(^MAG(2005,IEN,100)),"^",6)="") D120 . S X=$O(^MAG(2005,IEN,1,0))121 . S IEN=+$G(^MAG(2005,IEN,1,X,0))122 . Q123 I $P($G(^MAG(2005,IEN,100)),"^",6)]"" D124 . I OBJTYP=11 D ; If a Group, get Object Type of First Child125 . . S Z=$O(^MAG(2005,IEN,1,0))126 . . I 'Z Q127 . . S Z=+$G(^MAG(2005,IEN,1,Z,0))128 . . S OBJTYP=+$P($G(^MAG(2005,Z,0)),"^",6) ; Object of First Child129 . . Q130 . S OBJTYP=","_OBJTYP_","131 . S LBL="",VAL=""132 . I ",3,9,10,12,100,"[OBJTYP S LBL="Image Creation Date: " ; "Acquisition Date";133 . I ",15,101,102,103,104,105,"[OBJTYP S LBL="Document Creation Date: "134 . I LBL="" S LBL="Image Creation Date: "135 . S VAL=$$GET1^DIQ(2005,IEN,110,"E") S:(VAL="") VAL="N/A"136 . S CT=CT+1,MAGRY(CT)=LBL_VAL137 . Q138 Q139 ;140 FLDS ;;Format: ;3;;141 ;;Extension: ;1;;142 FLDG ;;Patient: ;5;;143 ;;Desc: ;10;;144 ;;Procedure: ;6;;145 ;; Date: ;15;;146 ;;Class: ;41;;147 ;;Package: ;40;;148 ;;Type: ;42;;149 ;;Proc/Event: ;43;;150 ;;Spec/SubSpec: ;44;;151 ;;Origin: ;45;;152 ;;Accession # ;50;;153 ;;Specimen Desc ;51;;154 ;;Specimen# ;52;;155 ;;Stain ;53;;156 ;;Objective ;54;;157 ;;Captured on: ;7;;158 ;; by: ;8;;159 ;;end;; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU4.m
r628 r636 1 MAGGTU4 ;WOIFO/GEK - Imaging Client- Version checking routine; [ 06/20/2001 08:57 ]2 ;;3.0;IMAGING;**8,48,63,45,46 ,59,96**;April 29, 2008;Build 93 ;; Per VHA Directive 2004-038, this routine should not be modified.1 MAGGTU4 ;WOIFO/GEK - Testing callbacks for Delphi Doc Image Prototype ; 02/16/2007 13:37 2 ;;3.0;IMAGING;**8,48,63,45,46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 22 22 ; The Server Version SVRVER needs hardcoded to match the Delphi Client. 23 23 ; and This Routine must be distributed whenever a new Client is 24 S SVRVER="3.0. 96"25 S SVRTVER= "4"; This is the T version that the server expects24 S SVRVER="3.0.46" 25 S SVRTVER=28 ; This is the T version that the server expects 26 26 ; released Client will have the T version that the server expects 27 27 S A("3.0.24")=5 ;Sept 2003 … … 32 32 S A("3.0.63")=4 ;June 2005 33 33 S A("3.0.45")=8 ;Sept 2005 34 S A("3.0.46")=28 ;Mar 2007 35 S A("3.0.59")=31 ;Jul 2007 36 S A("3.0.72")=21 ;Jan 2008 37 S A("3.0.83")=24 ;Mar 2008 38 S A("3.0.95")=5 ;Mar 2008 39 S A("3.0.96")=4 ;Apr 2008 34 S A("3.0.59")=20 ;July 2006 40 35 Q 41 36 ; 42 37 CHKVER(MAGRY,CLVER) ;RPC [MAG4 VERSION CHECK] 43 38 ; CLVER is the version of the Delphi Client. 44 ; CLVER format = Major .Minor.Patch.T-version39 ; CLVER format = Major,Minor,Patch,T Version 45 40 ; example : for Version 3.0 Patch 8 T 21 --> CLVER=3.0.8.21 46 41 ; Ver 2.5P9 (2.5.24.1) is first Delphi Ver that makes this call. … … 60 55 I $P(CLVER,".",1)="30" S CLVER="3.0."_$P(CLVER,".",3,99) 61 56 ; 62 N PLC,SV,ST,SVSTAT,CV,CP,CT,OKVER,WARN,I ,BETA57 N PLC,SV,ST,SVSTAT,CV,CP,CT,OKVER,WARN,I 63 58 ; PLC = Entry in 2006.1 64 59 ; SV = Server Version -> (3.0.8) from (3.0.8.43) Hard coded to Sync with Delphi Clients … … 93 88 D VERSTAT(.SVSTAT,SV) 94 89 I 'SVSTAT S MAGRY(0)="2^"_$P(SVSTAT,"^",2) Q ; There is not record of a KIDS for this Server. 95 ; Set Alpha Beta Flag 96 S BETA=(+SVSTAT=2) 90 ; 97 91 ; If Client isn't one of the Supported Clients. 98 92 I (CV'=SV),'$D(OKVER(CV)) D Q 99 . I BETAD NOTOKB^MAGGTU41(.MAGRY) Q93 . I +SVSTAT=2 D NOTOKB^MAGGTU41(.MAGRY) Q 100 94 . D NOTOK^MAGGTU41(.MAGRY) Q 101 95 . Q … … 104 98 I (CV'=SV) D Q 105 99 . I CT<$G(OKVER(CV)) D Q 106 . . I BETADO OKBADTB^MAGGTU41(.MAGRY) Q100 . . I +SVSTAT=2 DO OKBADTB^MAGGTU41(.MAGRY) Q 107 101 . . DO OKBADT^MAGGTU41(.MAGRY) Q 108 102 . . Q 109 . I BETAD OKB^MAGGTU41(.MAGRY)103 . I +SVSTAT=2 D OKB^MAGGTU41(.MAGRY) 110 104 . E D OK^MAGGTU41(.MAGRY) 111 105 . I WARN D WARNING … … 114 108 ; At this point, Versions are the Same: If T versions are not, warn the Client. 115 109 I CT,(CT'=ST) D Q 116 . I BETAD TNOTOKB^MAGGTU41(.MAGRY) Q110 . I +SVSTAT=2 D TNOTOKB^MAGGTU41(.MAGRY) Q 117 111 . D TNOTOK^MAGGTU41(.MAGRY) Q 118 112 . Q … … 125 119 ; 126 120 NEEDWARN(WARN) ; This call determines if Client needs the warning. 127 S WARN=0 Q ; we don't need warning anymore.128 121 I $P($G(^MAG(2006.1,PLC,"USERPREF")),U,2)="" S WARN=0 Q ; Not a MUSE Site. 129 122 I $D(MAGJOB("CAPTURE")) S WARN=0 Q ;Not needed for Capture Clients … … 173 166 N VERI,TVER,MAGERR 174 167 I +MAGVER S MAGVER="MAG*"_$P(MAGVER,".",1,2)_"*"_$P(MAGVER,".",3) 175 S VERI=$$FIND1^DIC(9.6,"","M O",MAGVER,"","","MAGERR")176 I 'VERI S MAGRY="0^There is No KIDs Install record for """_MAGVER_"""." Q168 S VERI=$$FIND1^DIC(9.6,"","M",MAGVER,"","","MAGERR") 169 I 'VERI S MAGRY="0^There is No KIDs Install record." Q 177 170 S TVER=$$GET1^DIQ(9.6,VERI_",","ALPHA/BETA TESTING") 178 171 I TVER="YES" S MAGRY="2^Alpha/Beta Version." Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU41.m
r628 r636 1 1 MAGGTU41 ;WOIFO/GEK - Version Control utilities ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 202 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | … … 45 44 I $P(CV,".",1)=2 S X(50)="(clicking 'Cancel' will not stop the Abort.)" 46 45 Q 47 OKBADTB(X) ; Client not Equal, Is supported. Previous Supported Version. Beta46 OKBADTB(X) ; Client not Equal, but it is supported. 48 47 ; But it's T isn't the T of it's Released Patch 49 48 S X(0)="0^ Server is running Imaging V. "_SV_" "_$P(SVSTAT,"^",2) … … 59 58 S X(30)=" APPLICATION will Continue " 60 59 Q 61 OKBADT(X) ; Client not Equal, but it is supported. Previous Supported Version60 OKBADT(X) ; Client not Equal, but it is supported. 62 61 ; But it's T isn't the T of it's Released Patch 63 62 S X(0)="2^ Server is running Imaging V. "_SV_" "_$P(SVSTAT,"^",2) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU6.m
r628 r636 1 MAGGTU6 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]2 ;;3.0;IMAGING;**24,8,48,45,20,46 ,59**;Nov 27, 2007;Build 201 MAGGTU6 ;WOIFO/GEK - Silent Utilities ; 25 Jan 2006 12:14 PM 2 ;;3.0;IMAGING;**24,8,48,45,20,46**;16-February-2007;;Build 1023 3 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 9 9 ;; | Development Office of the Department of Veterans Affairs, | 10 10 ;; | telephone (301) 734-0100. | 11 ;; | |12 11 ;; | The Food and Drug Administration classifies this software as | 13 12 ;; | a medical device. As such, it may not be changed in any way. | -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU71.m
r628 r636 1 1 MAGGTU71 ;WOIFO/GEK - Silent calls for Queing functions from GUI, cont ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**46 ,59**;Nov 27, 2007;Build 203 ;; Per VHA Directive 2004-038, this routine should not be modified.2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ 5 5 ;; | Property of the US Government. | … … 17 17 ;; 18 18 Q 19 ABSJB(MAGRY, DATA) ;RPC [MAG ABSJB] SET ABSTRACT AND/OR JUKEBOX QUEUES19 ABSJB(MAGRY,MAGIN) ;RPC [MAG ABSJB] SET ABSTRACT AND/OR JUKEBOX QUEUES 20 20 ; 21 ; DATA21 ; MAGIN 22 22 ; DESCRIPTION: '^' delimited String: 23 23 ; Piece 1 = the IEN of the image that needs an abstract created. … … 31 31 N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0) 32 32 S MAGRY="0^ERROR: Setting Queue for Abstract or JukeBox copy" 33 S MAGIENAB=+$P( DATA,"^",1),MAGIENJB=+$P(DATA,"^",2)33 S MAGIENAB=+$P(MAGIN,"^",1),MAGIENJB=+$P(MAGIN,"^",2) 34 34 I MAGIENAB Q:((+$P($G(^MAG(2005,MAGIENAB,0)),U,11))!(+$P($G(^MAG(2005,MAGIENAB,0)),U,12))) "0^Image integrity" 35 35 I MAGIENJB Q:((+$P($G(^MAG(2005,MAGIENJB,0)),U,11))!(+$P($G(^MAG(2005,MAGIENJB,0)),U,12))) "0^Image integrity" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTU9.m
r628 r636 1 1 MAGGTU9 ;WOIFO/LB/GEK - Imaging utilities assign key 2 ;;3.0;IMAGING;**8,59**;Nov 27, 2007;Build 20 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8**;Sep 15, 2004 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 18 17 ;; 19 18 Q 20 CHKKEY ; 21 N NOGIVE 22 S NOGIVE=1 23 GIVEKEY ;Give MAGDISP CLIN key to all MAG WINDOWS option holders 24 ; that have neither MAGDISP CLIN nor MAGDISP ADMIN 19 EN ;Give MAGDISP CLIN key to all MAG WINDOWS option holders. 25 20 ; Find the menu option's IEN 26 N MKEYC,MKEYA,ERR,OPT,MAGUSER,I,KEYCLIN,KEYADMIN,KEYCT,KEYECT,XCT 27 N KEYHASC,KEYHASA,KEYHASB,KEYNONE,SP,LSP 28 N UCT,UTOT,OPTACC,MDOT,UDISCT 29 ; This could be made Generic if ever a need, to search for users 30 ; withour either key, and assigned those users the first (KEYCLIN) 31 S KEYCLIN="MAGDISP CLIN" 32 S KEYADMIN="MAGDISP ADMIN" 21 N MKEY,ERR,OPT,MAGUSER,I,KEYNM,KEYCT,KEYECT,XCT,KEYHAS 22 N UCT,UTOT,OPTACC,MDOT 23 S KEYNM="MAGDISP CLIN" 33 24 S KEYCT=0 ; count of number of users that were assigned the key. 34 25 S KEYECT=0 ; count of number of errors during the assignment. 35 S KEYHASC=0 ; count of number of users that already have key Clin 36 S KEYHASA=0 ; count of number of users that already have key Admin 37 S KEYHASB=0 ; count of number of users that Have Both keys 38 S KEYNONE=0 ; count of Users that have Neither Key. 26 S KEYHAS=0 ; count of number of users that already have key. 39 27 S OPTACC=0 ; count of users with access to MAG WINDOWS. 40 S UDISCT=0 ; count of Disabled Users Skipped.41 28 S MDOT=10000 ; print '.' to screen to show progress. 42 29 S UCT=0 ; user count. for progress 43 30 S UTOT=$P(^VA(200,0),"^",4) 44 ; 45 I $G(NOGIVE) D 46 . D MES^XPDUTL("Checking for users that have access to Option : "_"MAG WINDOWS") 47 . D MES^XPDUTL(" but do not have either '"_KEYCLIN_"' or '"_KEYADMIN_"' Keys") 48 . D MES^XPDUTL(" Disabled users (DISUSER=1) are skipped, they are not checked.") 49 . Q 50 E D MES^XPDUTL("Assigning "_KEYCLIN_" to all users with access to Option : "_"MAG WINDOWS") 51 D MES^XPDUTL(" ") 31 ; 32 D MES^XPDUTL("Assigning "_KEYNM_" to all users with access to Option : "_"MAG WINDOWS") 52 33 S OPT=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","ERR") 53 34 I OPT="" D MES^XPDUTL("ERROR ",$G(ERR("DIERR",1,"TEXT",1))) Q 54 35 I OPT=0 D MES^XPDUTL("MAG WINDOWS wasn't found in Option File") Q 55 36 ; Lookup the security key 56 S MKEYC=$$LKUP^XPDKEY(KEYCLIN) 57 S MKEYA=$$LKUP^XPDKEY(KEYADMIN) 58 I ('MKEYC)!('MKEYA) D MES^XPDUTL("ERROR: Imaging Display Keys are not defined at this site") Q 59 ; Check all Users at site to see if they don't have either Clin or Admin 37 S MKEY=$$LKUP^XPDKEY(KEYNM) 38 I 'MKEY D MES^XPDUTL("ERROR "_KEYNM_" Key wasn't found") Q 39 ; Give users the Key, if they don't have it already 60 40 D MES^XPDUTL("Checking users...") 61 D MES^XPDUTL(" ")62 41 S I=0 F S I=$O(^VA(200,I)) Q:'I D 63 . I $$GET1^DIQ(200,I,7,"E")]"" S UDISCT=UDISCT+1 Q64 42 . S UCT=UCT+1 I UCT>MDOT S MDOT=MDOT+10000 D MES^XPDUTL(UCT_" of "_UTOT_" users checked...") 65 . I (($$ACCESS^XQCHK(I,OPT))>0) S OPTACC=OPTACC+1 D C(I)43 . I (($$ACCESS^XQCHK(I,OPT))>0) S OPTACC=OPTACC+1 D GIVEKEY(MKEY,KEYNM,I) 66 44 . Q 67 S SP=" " 68 S LSP=$L(UTOT)+3 69 D MES^XPDUTL(" ") 70 I $G(NOGIVE) D 71 . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.") 72 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users have Both Keys ") 73 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users only have "_KEYCLIN_" key") 74 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users only have "_KEYADMIN_" key") 75 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYNONE))_KEYNONE_" Users have neither Key") 76 . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details") 77 . Q 78 I '$G(NOGIVE) D 79 . D MES^XPDUTL($E(SP,1,LSP-$L(OPTACC))_OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.") 80 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASB))_KEYHASB_" Users already have Both Keys ") 81 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASC))_KEYHASC_" Users have Only Key "_KEYCLIN) 82 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYHASA))_KEYHASA_" Users have Only Key "_KEYADMIN) 83 . D MES^XPDUTL($E(SP,1,LSP-$L(KEYCT))_KEYCT_" Users were assigned key: "_KEYCLIN) 84 . D MES^XPDUTL("Assignment Complete.") 85 . I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details") 86 . Q 45 D MES^XPDUTL(OPTACC_" of "_UTOT_" Users have access to option MAG WINDOWS.") 46 D MES^XPDUTL(KEYHAS_" Users already have Key "_KEYNM) 47 D MES^XPDUTL(KEYCT_" Users were assigned key: "_KEYNM) 48 D MES^XPDUTL("Assignment Complete.") 49 I KEYECT>0 D MES^XPDUTL(KEYECT_" Errors during Key Assignment. See install log for details") 87 50 Q 88 C(USER) ; 89 ; check KEY for USER 90 N DO,D1,MFDA,ZC,ZA,MIEN 91 ; check to see if they have the Clin key 92 S ZC=$$FIND1^DIC(200.051,","_USER_",","",KEYCLIN) 93 I ZC="" D Q 94 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYCLIN) 51 GIVEKEY(KEY,KEYNM,USER) ; 52 ; Give KEY to USER 53 N DO,D1,MFDA,Z,MIEN 54 ; Quit if they already have the key 55 S Z=$$FIND1^DIC(200.051,","_USER_",","",KEYNM) 56 I +Z S KEYHAS=KEYHAS+1 57 Q:Z ; Already have key 58 I Z="" D Q 59 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has key ("_KEYNM_")") 95 60 . S KEYECT=KEYECT+1 96 . Q 97 ; check to see if they have the Admin key 98 S ZA=$$FIND1^DIC(200.051,","_USER_",","",KEYADMIN) 99 I ZA="" D Q 100 . D MES^XPDUTL("ERROR Validating that user ("_USER_") has Key "_KEYADMIN) 101 . S KEYECT=KEYECT+1 102 . Q 103 I ((+ZC)&(+ZA)) S KEYHASB=KEYHASB+1 Q 104 I +ZC S KEYHASC=KEYHASC+1 Q 105 I +ZA S KEYHASA=KEYHASA+1 Q 106 S KEYNONE=KEYNONE+1 107 I $G(NOGIVE) D Q 108 . D MES^XPDUTL("User: "_$P($G(^VA(200,USER,0)),"^")_" has neither Key") 109 . Q 110 S MFDA(200.051,"+1,"_USER_",",.01)=MKEYC 61 ; 62 S MFDA(200.051,"+1,"_USER_",",.01)=KEY 111 63 S MFDA(200.051,"+1,"_USER_",",1)=DUZ 112 64 S MFDA(200.051,"+1,"_USER_",",2)=DT 113 S MIEN(1)= MKEYC_","65 S MIEN(1)=KEY_"," 114 66 D UPDATE^DIE("","MFDA","MIEN") 115 67 I $D(DIERR) D Q 116 . D MES^XPDUTL("ERROR Assigning Key ("_KEYCLIN_") to user ("_USER_")")68 . D MES^XPDUTL("ERROR Assigning key ("_KEYNM_") to user ("_USER_")") 117 69 . S KEYECT=KEYECT+1 118 70 . D CLEAN^DILF -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTUP.m
r628 r636 1 1 MAGGTUP ;WOIFO/GEK - Imaging System User preferences ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**7,8,48,45,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,48,45**;Sep 12, 2005 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 116 115 S ARR($J,"GROUP")="2^24^231^427^457^110^70^^1^2^24^2^1^0" 117 116 S ARR($J,"DOC")="2^298^24^729^429^0^0^3^1^2^4^2^0" 118 S ARR($J,"CAPCONFIG")="1^1^1^0^0^0^0^1^0^1^0^0^1^1^0^0^1^1^1^1^1^1^200^400^300^100^500^0^0^1^0^1" 119 ; 1 2 3 4 5 6 7 8 9 0 1 2 3 456 7 8 120 S ARR($J,"CAPTIU")="261^414^455^654^66^67^280^1^1^~^1^100^-12^^^1^1^^" 117 S ARR($J,"CAPCONFIG")="1^1^1^0^0^0^0^1^0^1^0^0^1^1^0^0^1^1^1^1^1^1^200^400^300^100^500^0^0^1^" 118 S ARR($J,"CAPTIU")="5^369^760^654^289^67^170^1^1^" 121 119 S ARR($J,"RIVER")="1^0^0^0^" 122 S ARR($J,"APPMSG")="0^0^"123 120 S ARR($J,"APPPREFS")="1^7^7^10" 124 121 S ARR($J,"LISTWIN1")="1^1^^1^1" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJEX1B.m
r628 r636 1 1 MAGJEX1B ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 9:58 AM 2 ;;3.0;IMAGING;**16,22,18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**16,22,18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 115 115 . D LOCKOUT^MAGJEX1A(RARPT,DAYCASE,.LOCKLEV,.MYLOCK,ACTION,.RESULT) ; 1st, lock to me 116 116 . K LOCKLEV,MYLOCK D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; then, clear the lock 117 S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)117 S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X 118 118 S ^XTMP("MAGJ",0)=TS_U_"VistaRad Locks" 119 119 Q -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJEX2.m
r628 r636 1 1 MAGJEX2 ;;WIRMFO/JHC Rad. Workstation RPC calls;[ 02/25/2000 4:40 PM ] ; 09 Jun 2003 2:58 PM 2 ;;3.0;IMAGING;**51,18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**51,18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 87 86 S X=$G(^MAG(2006.69,1,0)) 88 87 S LIMYRS=+$P(X,U,14),LIMEXAMS=+$P(X,U,15) 89 S:'LIMYRS LIMYRS= 7 S:'LIMEXAMS LIMEXAMS=50 ; default limit # Exams88 S:'LIMYRS LIMYRS=10 S:'LIMEXAMS LIMEXAMS=100 ; default limit # Exams 90 89 S BEGDT=($E(DT,1,3)-LIMYRS)_$E(DT,4,7) 91 90 I BEGDT<2950101 S BEGDT=2950101 ; 2 yrs prior to earliest VistaPACS … … 137 136 ; 138 137 Q:'MAGMATCH 139 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM140 ; 6 RADATE RADTE RACN RAPRC RARPT141 ; 11 RAST DAYCASE RAELOC RASTP RASTORD142 ; 16 RADTPRT RACPT RAIMGTYP143 S MAGDTH=$$FMTH^XLFDT($P(RADATA,U,7),1)138 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM 139 ; 6 RADATE RADTE RACN RAPRC RARPT 140 ; 11 RAST DAYCASE RAELOC RASTP RASTORD 141 ; 16 RADTPRT RACPT RAIMGTYP 142 S X=$P(RADATA,U,7) D H^%DTC S MAGDTH=+%H 144 143 S X=$P(RADATA,U,18) 145 144 S RAIMGTYP=$S(X]"":$O(^RA(79.2,"C",X,"")),1:X) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJLS2.m
r628 r636 1 1 MAGJLS2 ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 9:58 AM 2 ;;3.0;IMAGING;**22,18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**22,18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 19 18 Q 20 19 ; ACTIVE -- list exams (Unread, Recent, &/or Pending) for input Imaging Type(s) 21 ; RPC Call: MAGJ RADACTIVEEXAMS20 ; RPC Call: MAGJ RADACTIVEEXAMS 22 21 ; BKGND -- EP for Bkgnd Compile of UNREAD list 23 22 ; BKGND2 -- EP for Bkgnd Compile of RECENT list … … 39 38 S X=$P(DATA,U) D PARAMS^MAGJLS2B(X) 40 39 I 'LSTID S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with Exams List Compile--"_DATA_"." Q 41 I MAGJOB("P32"),+$G(MAGJOB("P32STOP")) S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~VistARad Patch 32 is no longer supported. Contact Imaging support for the current version of the VistARad client software." Q ; <*>42 40 I BKGND,LSTREQ="U" D BKREQU Q ; UNREAD in bkgnd 43 41 I BKGND,LSTREQ="R" D BKREQR Q ; RECENT in bkgnd … … 89 87 I +$G(COMPFAIL) S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Unable to Compile Unread Exams list" 90 88 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 91 K LSTAGE92 89 Q 93 90 ; … … 100 97 I 'LSTNUM S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with "_LSTNM_" List Compile program (age="_LSTAGE_" for "_LSTNAM_")"_$S(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"") 101 98 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 102 K LSTAGE103 99 Q 104 100 ; … … 117 113 . D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^TMP($J,"MAGJ"))) 118 114 I 'ALLGO S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with ALL Exams List Compile "_DATA_". "_REPLY 119 K LSTAGE120 115 Q 121 116 ; … … 151 146 D LSTCOMP() 152 147 I LSTREQ="R" D NEWINT 153 I LSTREQ="U" D UPDR ^MAGJLS2BG BKLOOP ;UNREAD loops; RECENT uses TaskMan148 I LSTREQ="U" D UPDR G BKLOOP ;UNREAD loops; RECENT uses TaskMan 154 149 BKGNDZ I LSTREQ="U" L -^XTMP("MAGJ2","BKGND2","RUN") 155 150 N ZTREQ S ZTREQ="@" ; clean up task entry 156 K BKLOOP,DELTA ,LSTAGE151 K BKLOOP,DELTA 157 152 Q ; Exit bkgnd 158 153 ; 159 NEWINT ; Add exams newly Interp since Recent Compile started to Recent List 160 ; 1st, get list of candidates: 154 UPDR ; Add Newly Interp exams to Recent 155 D PARAMS^MAGJLS2B(9995) 156 I 'LSTID G UPDRZ 157 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 158 D LSTCOMP() 159 UPDRZ Q ; 160 ; 161 NEWINT ; Exams newly Interp since Recent Compile started 162 ; are added to Recent List (add to "RECENT" index) 163 ; 1st, get list of all potential candidates: 161 164 N INDX L +^XTMP("MAGJ2","RECENT"):15 162 165 E Q 163 166 S INDX=+$G(^TMP($J,"NEWINT")) ; counter when Recent Compile started 164 167 I INDX S INDX=INDX-1 F S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX S X=^(INDX) I X S ^TMP($J,"NEWINT",0,INDX)=X 165 K ^XTMP("MAGJ2","RECENT") S ^("RECENT",0)=0 168 K ^XTMP("MAGJ2","RECENT") S ^("RECENT",0)=0 ; init this index 166 169 L -^XTMP("MAGJ2","RECENT") 167 ; if not in Recent Compile,add to index170 ;find those not included in Recent Compile, and add to index 168 171 S INDX="" 169 172 F S INDX=$O(^TMP($J,"NEWINT",0,INDX)) Q:'INDX S X=^(INDX) D 170 . I $D(^TMP($J,"NEWINT",$P(X,U,1,3))) Q ; already there173 . I $D(^TMP($J,"NEWINT",$P(X,U,1,3))) Q ; already in the compile 171 174 . L +^XTMP("MAGJ2","RECENT"):15 172 175 . E Q 173 . S I=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=I,^(I)=X ; add176 . S I=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=I,^(I)=X ; add to indx 174 177 . L -^XTMP("MAGJ2","RECENT") 175 178 K ^TMP($J,"NEWINT") … … 178 181 LSTCOMP(COMPFAIL) ; Compile new list; subrtn used by Active and Bkgnd tags 179 182 S COMPFAIL=0 ; Return T/F for "Executed a List Compile?" 180 L +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60 183 L +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60 ; shouldn't need any time 181 184 E S COMPFAIL=1 G LSTCOMZ 182 S NEWLIST=$S(LSTNUM=1:2,1:1) ; toggle node to use 185 S NEWLIST=$S(LSTNUM=1:2,1:1) ; toggle node to use for new compile 183 186 N TS,COMTIM 184 S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)187 S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X 185 188 S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile" 186 189 S ^XTMP("MAGJ2",0,LSTNAM,NEWLIST)=$H … … 194 197 LSTCOMZ L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE") 195 198 Q ; 196 CURLIST(LSTNAM,WAIT) ; return cur. list & age in secs 199 ; 200 CURLIST(LSTNAM,WAIT) ; return current list & its age in seconds 201 ; 197 202 S WAIT=+$G(WAIT) 198 203 N X,RET,AGE,TRY,START,EXTRATIM … … 204 209 CURLISZ Q RET 205 210 ; 206 DELTA(X,Y) ; calc # sec s bet 2 $h values; dflt 2nd value = now211 DELTA(X,Y) ; calc # seconds between 2 $h values; default 2nd value = now 207 212 ; useful limit is one day 208 213 I $G(Y)="" S Y=$H 209 214 I +Y=+X 210 215 E D 211 . I Y-X=1 S $P(Y,",",2)=86400+$P(Y,",",2) ; midnight boundary212 . E S $P(X,",",2)=0,$P(Y,",",2)=86400 ; >one day216 . I Y-X=1 S $P(Y,",",2)=86400+$P(Y,",",2) ; cross midnight boundary 217 . E S $P(X,",",2)=0,$P(Y,",",2)=86400 ; more than one day 213 218 Q ($P(Y,",",2)-$P(X,",",2)) 214 219 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJLS2B.m
r628 r636 1 1 MAGJLS2B ;WIRMFO/JHC VistARad RPC calls ; 29 Jul 2003 9:59 AM 2 ;;3.0;IMAGING;**16,22,18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 188 187 Q 189 188 ; 190 UPDR ; Add Newly Interp exams to Recent; called from magjls2 191 D PARAMS(9995) 192 I LSTID D 193 . S X=$$CURLIST^MAGJLS2(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 194 . D LSTCOMP^MAGJLS2() 195 UPDRZ Q 189 END Q ; 196 190 ; 197 END ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJLS4.m
r628 r636 1 1 MAGJLS4 ;WIRMFO/JHC VistARad RPCs--History List ; 29 Jul 2003 10:00 AM 2 ;;3.0;IMAGING;**18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 57 56 ; 58 57 HISTADD(DATA,TXDUZ,TXDIV) ; add records 59 N IDATA,ILOOP,CT,NOGO,EXID,HISDAT,HISTIEN,MAGRACNT ,TS58 N IDATA,ILOOP,CT,NOGO,EXID,HISDAT,HISTIEN,MAGRACNT 60 59 S IDATA="",CT=0,NOGO=0 61 60 F ILOOP=0:1 S IDATA=$O(DATA(IDATA)) Q:IDATA="" D … … 72 71 S MAGRACNT=0 D ACTIVE^MAGJLS2(.MAGGRY,9996) 73 72 S X=@MAGGRY@(0),X=+X_U_"1~"_$$HISTTL(TXDUZ,TXDIV),@MAGGRY@(0)=X 74 S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)73 N TS S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X 75 74 S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile" 76 75 S REPLY=1 … … 134 133 . S HDATE=$P(XX2,U,13) D Q:DELETED 135 134 . . S DELETED=0,HDATE=$P(HDATE,"@") 136 . . S X=HDATE,%DT="" D ^%DT K %DT137 . . I $$FMTH^XLFDT(Y,1)<($H-3) K ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN) S DELETED=1 Q135 . . S X=HDATE,%DT="" D ^%DT S X=Y D H^%DTC K %DT 136 . . I %H<($H-3) K ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN) S DELETED=1 Q 138 137 . ; <*> End of temp change 139 138 . I RARPT,RADFN,RADTI,RACNI -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJLST1.m
r628 r636 1 1 MAGJLST1 ;WIRMFO/JHC VistARad RPC calls ; 29 Jul 2003 10:01 AM 2 ;;3.0;IMAGING;**16,22,18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**16,22,18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 43 43 ; 44 44 ; MAGGRY - indirect reference to return array of exams for a patient 45 ; DATA - DFN ^ LIMYEARS ^ LIMEXAMS ^ BEGDT ^ ONESHOT45 ; DATA - DFN ^ LIMYEARS ^ LIMEXAMS ^ BEGDT 46 46 ; DFN--Patient's DFN 47 ; LIMYRS--Restrict exams up to # Years back (defunct)47 ; LIMYRS--Restrict exams up to # Years back 48 48 ; LIMEXAMS--Restrict exams up to # of exams 49 49 ; BEGDT--Begin date for exam fetch (Patch 18 addition--see below) 50 ; ONESHOT--Number days back to search, in one fell swoop51 50 ; Returns data in ^TMP($J,"MAGRAEX",0:n) 52 51 ; RPC Call: MAGJ PTRADEXAMS … … 64 63 N CNT,DFN,ISS,PATNAME,DIQUIET,MAGRACNT,MAGRET,REPLY,REMOTE,SNDREMOT 65 64 N DAYCASE,DIV,EXCAT,MAGDT,XX,XX2,WHOLOCK,MODALITY,MYLOCK,PLACE,ENDLOOP 66 N LIM EXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,SHOWPLAC,RDRIST,PSSN,CPT,PARAM67 N CURPRIO,STATUS,RARPT,KEY,X 2,REMOTE2,ONESHOT,LIMDAYS65 N LIMYRS,LIMEXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,SHOWPLAC,RDRIST,PSSN,CPT,PARAM 66 N CURPRIO,STATUS,RARPT,KEY,X1,X2,REMOTE2,ONESHOT,LIMDAYS 68 67 N IMGCNT,LRFLAG,MSG,ONL,PROCMOD,RASTCAT,RASTORD 69 68 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1" … … 79 78 E S BEGDT=$P(DATA,U,4),ONESHOT=$P(DATA,U,5) ; P65 chg 80 79 K MAGGRY S DFN=+DATA 80 ;<*> 81 ; I DUZ=131 G MANYTST^ZMAGJTST ; <*> TEST ONLY !!! 37=RadRes 82 ;<*> 81 83 S SHOWPLAC=$$SHOWPLAC^MAGJLS2B("") 82 84 S MAGRACNT=1,CNT=0 K ^TMP($J,"MAGRAEX"),^("MAGRAEX2") … … 84 86 I DFN,$D(^DPT(DFN,0)) S PATNAME=$P(^(0),U),PSSN=$P(^(0),U,9) D 85 87 . S ENDLOOP=0,BEGDT=$S(+BEGDT:BEGDT,1:"") 86 . I MAGJOB("P32"),+$G(MAGJOB("P32STOP")) S REPLY="0^4~VistARad Patch 32 is no longer supported; contact Imaging Support for the current version of the VistARad client software." Q ; <*> 87 . F D Q:'MORE Q:ENDLOOP S BEGDT=MORE+1 88 . F D Q:'MORE Q:ENDLOOP 88 89 . . I 'BEGDT S BEGDT=DT,X2=0 89 90 . . E S X2=-1 90 . . S LIMDAYS=365,MORE=1 91 . . I 'MAGJOB("P32") I ONESHOT,(ONESHOT>0) S LIMDAYS=+ONESHOT 92 . . S ENDDT=$$FMADD^XLFDT(BEGDT,X2) 93 . . S BEGDT=$$FMADD^XLFDT(ENDDT,-LIMDAYS) 91 . . S LIMDAYS=365 92 . . I 'MAGJOB("P32"),ONESHOT,(ONESHOT>0) S LIMDAYS=+ONESHOT 93 . . S X1=BEGDT D C^%DTC S (ENDDT,X1)=X,X2=-LIMDAYS D C^%DTC S BEGDT=X K %,%H,%T 94 94 . . D GETEXAM3^MAGJUTL1(DFN,BEGDT,ENDDT,.MAGRACNT,.MAGRET,.MORE) 95 95 . . I MAGJOB("P32") S ENDLOOP=(MAGRACNT>LIMEXAMS) … … 109 109 . E S REPLY=REPLY_" -- "_MSG 110 110 . S ^TMP($J,"MAGRAEX2",1)="^Day/Case~S3~1^Lock~~2^Procedure~~6^Modifier~~25^Image Date/Time~S1~7^Status~~8^# Img~S2~9^Onl~~10"_$S($G(SNDREMOT):"^RC~~12",1:"")_$S(SHOWPLAC:"^Site~~23",1:"")_"^Mod~~15^Interp By~~20^Imaging Loc~~11^CPT~~27" 111 I MAGJOB("P32"),+$G(MAGJOB("P32STOP")) S ^TMP($J,"MAGRAEX2",1)="^^"112 111 I 'MAGJOB("P32") S $P(REPLY,"|",2)=SAVBEGDT 113 112 S ^TMP($J,"MAGRAEX2",0)=REPLY -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJMN1.m
r628 r636 1 1 MAGJMN1 ;WIRMFO/JHC VRad Maint functions ; 29 Jul 2003 4:02 PM 2 ;;3.0;IMAGING;**16,9,22,18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**16,9,22,18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 31 31 D ENSRCH 32 32 D BLDDEF(MAGIEN) 33 S $P(^MAG(2006.631,MAGIEN,0),U,5)=$$NOW^XLFDT()33 D NOW^%DTC S $P(^MAG(2006.631,MAGIEN,0),U,5)=% 34 34 W !!,"List Definition complete!" R X:2 35 35 G SVRLIST … … 115 115 . S STR=STR_$S(STR="":"",1:U)_X 116 116 S ^MAG(2006.631,LSTID,"DEF",2)=STR 117 S $P(^MAG(2006.631,LSTID,"DEF",0),U)=$$NOW^XLFDT()117 D NOW^%DTC S $P(^MAG(2006.631,LSTID,"DEF",0),U)=% 118 118 Q 119 119 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUPD1.m
r628 r636 1 1 MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003 10:02 AM 2 ;;3.0;IMAGING;**16,22,18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 45 44 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value 46 45 S DIQUIET=1 D DT^DICRW 47 S TIMESTMP=$$NOW^XLFDT()46 D NOW^%DTC S TIMESTMP=% 48 47 S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6) 49 48 S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUPD2.m
r628 r636 1 1 MAGJUPD2 ;WIRMFO/JHC VistaRad RPCs-Update PS & KEY Img ; 14 July 2004 10:05 AM 2 ;;3.0;IMAGING;**18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 33 32 S (IMGCT,PSTOT,PSLINCT,KEYCT,INTCT,PSKILCT)=0 34 33 S IMGREF="",SAVOP="NOOP" 35 I '$D(TIMESTMP) N TIMESTMP S TIMESTMP=$$NOW^XLFDT()34 I '$D(TIMESTMP) N TIMESTMP D NOW^%DTC S TIMESTMP=% 36 35 ; 1st, process input in DATA 37 36 S IDATA="" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUTL1.m
r628 r636 1 1 MAGJUTL1 ;WIRMFO/JHC VistARad subroutines for RPC calls ; 29 Jul 2003 10:03 AM 2 ;;3.0;IMAGING;**22,18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**22,18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 25 25 ; 26 26 GETEXAM3(DFN,BEGDT,ENDT,MAGRACNT,MAGRET,MORE,LIMEXAMS) ; Get data for all exams for a 27 ; pt within a date range 28 ; limit to LIMEXAMS entries--note, only PREFETCH & Auto-route Priors use this 27 ; pt within a date range (default all dates); limit returned list to LIMEXAMS 29 28 ; Input: 30 29 ; DFN -- Patient DFN … … 32 31 ; ENDT -- Opt, latest date desired 33 32 ; MAGRACNT -- Opt, pass by ref to init counter to ref return data in ^TMP (see GETEXSET) 34 ; MORE -- Opt, If True, check for additional exams for pt35 33 ; LIMEXAMS -- Opt, limit # exams to return 36 34 ; Return: … … 41 39 ; 42 40 I '$D(DT) N DIQUIET S DIQUIET=1 D DT^DICRW 41 N MORECHK 43 42 S LIMEXAMS=+$G(LIMEXAMS) 43 S MORECHK=BEGDT!LIMEXAMS 44 44 S:$G(BEGDT)="" BEGDT=2010101 S:$G(ENDT)="" ENDT=DT ; default all dates 45 N MORECHK S MORECHK=+$G(MORE)46 45 S MAGRACNT=+$G(MAGRACNT),MAGRET=0,MORE=0 ; Init return data 47 46 I BEGDT>ENDT S X=ENDT,ENDT=BEGDT,BEGDT=X … … 54 53 K ^TMP($J,"RAE1") 55 54 I 'MORECHK Q ; all done; else indicate if pt has more exams 56 N DTI,CNI,STS ,DTCHK55 N DTI,CNI,STS 57 56 I 'MAGRET S DTI=9999999.9999-BEGDT,CNI=0 ; no exam found in orig dt range 58 57 E S X=^TMP($J,"MAGRAEX",MAGRACNT,1),DTI=$P(X,U,2),CNI=$P(X,U,3) ; last exam processed 59 58 ; loop thru addl exams til find one that is NOT Cancelled 60 59 MORE1 F S CNI=$O(^RADPT(DFN,"DT",DTI,"P",CNI)) Q:'CNI S STS=$P($G(^(CNI,0)),U,3) I STS]"" D Q:MORE 61 . Q:($P($G(^RA(72,STS,0)),U,3)=0) ; Canceled--keep looking 62 . S DTCHK=9999999.9999-DTI D EN1^RAO7PC1(DFN,DTCHK,DTCHK,1) ; verify there is at least one "good" exam for this date (Remedy #200480) 63 . I +$O(^TMP($J,"RAE1",DFN,0)) S MORE=1 64 . K ^TMP($J,"RAE1") 60 . S MORE='($P($G(^RA(72,STS,0)),U,3)=0) ; True if sts is NOT Canc 65 61 I 'MORE S DTI=$O(^RADPT(DFN,"DT",DTI)),CNI=0 G MORE1:DTI 66 62 I MORE S MORE=9999999.9999-DTI\1 … … 131 127 . S IEN=0 132 128 . F S IEN=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",IEN)) Q:'IEN S X=$P($G(^(IEN,0)),U) I X D 133 . . S X=$P($ $MOD^ICPTMOD(X,"I"),U,3) Q:X="" S X=$$TRIM(X)129 . . S X=$P($G(^DIC(81.3,X,0)),U,2) Q:X="" S X=$$TRIM(X) 134 130 . . S X=$S(X="LEFT SIDE":"LEFT",X="RIGHT SIDE":"RIGHT",X="BILATERAL PROCEDURE":"BILAT",1:X) 135 131 . . S CT=CT+1,MODS(CT)=X -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUTL2.m
r628 r636 1 1 MAGJUTL2 ;WIRMFO/JHC VistRad subroutines for RPC calls[ 2/21/97 10:53 AM ] ; 22 Mar 2001 2:24 PM 2 ;;3.0;IMAGING;**18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 40 40 . I STIEN S T=$O(^MAG(2005,STIEN,205,0)) I T S KEY=1 41 41 S IRPT=0 F S IRPT=$O(^RARPT(RARPT,2005,IRPT)) Q:'IRPT S MAGIEN=$P(^(IRPT,0),U) D 42 . Q:'$D(^MAG(2005,MAGIEN,0)) 43 . I MAGDT="" S MAGDT=$P($G(^MAG(2005,MAGIEN,100)),U,6) S:MAGDT="" MAGDT=$P($G(^(2)),U) 42 . Q:'$D(^MAG(2005,MAGIEN,0)) I MAGDT="" S MAGDT=$P($G(^(2)),U) 44 43 . I $O(^MAG(2005,MAGIEN,1,0)) S CT=CT+$P(^(0),U,4),Y=$P(^(0),U,3),MAGIEN2=$P($G(^(Y,0)),U) S:(MAGIEN2]"") ONLCHK=$$ONLCHK(MAGIEN2),REMCHK=$$REMOTE(MAGIEN2) ; last image in group 45 44 . E S CT=CT+1,ONLCHK=$$ONLCHK(MAGIEN),REMCHK=$$REMOTE(MAGIEN) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUTL3.m
r628 r636 1 1 MAGJUTL3 ;WIRMFO/JHC VistARad subrtns & RPCs ; 29 Jul 2003 10:03 AM 2 ;;3.0;IMAGING;**16,9,22,18,65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**16,9,22,18,65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 137 137 I $G(MAGJOB("VRVERSION")) S X=MAGJOB("VRVERSION") 138 138 E S X="" ; non-client processes assume post-P32 logic 139 S MAGJOB("P32")=(X="3.0.41.17") ; P32 Client? 140 I MAGJOB("P32") D P32STOP^MAGJUTL5(.X) S MAGJOB("P32STOP")=X ; STOP support when P76 releases 139 S MAGJOB("P32")=(X="3.0.41.17") ; support back-compatible P32 Client 141 140 D USERKEYS 142 141 S MAGJOB("CONSOLIDATED")=($G(^MAG(2006.1,"CONSOLIDATED"))="YES") … … 171 170 Q RSL 172 171 ; 173 USERKEYS ; Store Security Keys in MagJob 172 USERKEYS ; Store VRad Security Keys in MagJob 173 ; 174 174 N I,X,Y 175 N MAGKS ; keys to send to XUS KEY CHECK176 N MAGKG ; returned175 N MAGKS ; list of keys to send to XUS KEY CHECK 176 N MAGKG ; list returned 177 177 K MAGJOB("KEYS") 178 178 S X="MAGJ",I=0 … … 184 184 Q 185 185 ; 186 Q 186 187 PINF1(MAGGRY,MAGDFN) ;RPC Call MAGJ PT INFO -- Get pt info 187 188 S X="ERR3^MAGJUTL3",@^%ZOSF("TRAP") … … 189 190 Q 190 191 ; 191 USERINF2(MAGGRY,DATA) ; rpc: MAGJ USER2--get user info 192 ; Input= unused ^ Client Vs ^ Client O/S Vs 193 ; Reply= 194 ; 0) = 1/0^code~Msg | DUZ ^ NAME ^ INITIALS ^ REQFLAG 195 ; 1)= Net UserName ^ PSW ^ UserType ^ SYSADMIN 196 ; 1/0=Success/Fail flag for vs chk 197 ; code=4 if fail 198 ; Msg=Disp msg if fail 199 ; REQFLAG = 1/0 (Ena/Disa Requisition for non-rad staff) 200 ; UserType = 3: Staff R'ist; 2: Resident R'ist; 1: Rad Tech; 0: Non-Rad 201 ; SYSADMIN = 1/0 1=user has System User privileges 202 ; 2:N)=Sec Keys 203 ; 192 USERINF2(MAGGRY,DATA) ; rpc: MAGJ USER2 -- Return user info 193 ; Input = unused ^ Client Vrad Vs ^ Client O/S Vs 194 ; Reply = 195 ; (0) = 1/0^code~Msg | DUZ ^ NAME ^ INITIALS ^ REQ_FLAG 196 ; (1)= Net UserName ^ PSW ^ UserType ^ SYSADMIN 197 ; 1/0=Success/Failure flag for vs compatibility 198 ; code=4 if failure condition 199 ; Msg=Display msg if failure condition 200 ; REQ_FLAG = 1/0 (Enable/Disable Requisition for non-rad staff) 201 ; UserType = 3: Staff R'ist; 2: Resident R'ist; 1: Rad Tech; 0: Non-Rad 202 ; SYSADMIN = 1/0 1=user has Vrad System User privileges 203 ; 204 204 S X="ERR2^MAGJUTL3",@^%ZOSF("TRAP") 205 205 K MAGGRY S MAGGRY(0)="",MAGGRY(1)="" … … 225 225 S X=+MAGJOB("USER",1),X=$S(X=15:3,X=12:2,+RADTECH:1,1:0) 226 226 S MAGGRY(1)=MAGGRY(1)_U_X_U_$D(MAGJOB("KEYS","MAGJ SYSTEM USER")) 227 S MAGGRY(2)="*KEYS",X="" F I=3:1 S X=$O(MAGJOB("KEYS",X)) Q:X="" S MAGGRY(I)=X228 S MAGGRY(I)="*END"229 227 USERIN2Z Q 230 228 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUTL4.m
r628 r636 1 1 MAGJUTL4 ;WIRMFO/JHC VistARad subroutines for RPC calls ; 15 Jul 2004 4:34 PM 2 ;;3.0;IMAGING;**18,76**;Jun 22, 2007;Build 19 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**18**;Mar 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 66 65 S IEN=0 F S IEN=$O(RET(IEN)) Q:'IEN D 67 66 . N LIN S X=$G(@CPTGLB@(IEN,0)) 68 . Q:'(X]"") S TCPT=$P(X,U),LIN=TCPT_U_$P($ $CPT^ICPTCOD(TCPT),U,3) ; _U_$$BODPART(IEN,"~")_U_$$MDLLST(IEN,"~")67 . Q:'(X]"") S TCPT=$P(X,U),LIN=TCPT_U_$P($G(^ICPT(TCPT,0)),U,2) ; _U_$$BODPART(IEN,"~")_U_$$MDLLST(IEN,"~") 69 68 . S CT=CT+1,@MAGGRY@(CT)=LIN 70 69 S REPLY=CT_U_"1~ "_CT_" CPT Matches returned for "_CPTIN -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGJUTL5.m
r628 r636 1 1 MAGJUTL5 ;WOIFO/JHC - VistARad RPCs ; [ 07/3/2006 17:17 ] 2 ;;3.0;IMAGING;**65 ,76**;Jun 22, 2007;Build 192 ;;3.0;IMAGING;**65**;Jul 27, 2006;Build 28 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 4 ;; +---------------------------------------------------------------+ … … 24 24 ; released Client will have the T version that the server expects 25 25 ; 26 S SVRVER="3.0. 76",SVRTVER=14; <*> Edit this line for each patch/T-version26 S SVRVER="3.0.65",SVRTVER=12 ; <*> Edit this line for each patch/T-version 27 27 ; 28 S ALLOWCL="|3.0. 65|" ;28 S ALLOWCL="|3.0.18|" ; note--patch 32 is numbered funny, so is hard-coded below 29 29 Q 30 30 ; … … 68 68 S SVERSION=SV 69 69 I TESTFLAG S SVERSION=SV_"."_ST 70 ; Check Version differences: 70 ; 71 ; Patch 32 client is OK: 72 I CLVER="3.0.41.17" S MAGRY="1^1~P32 Client Version Check OK. Server: "_SVERSION_" Client: "_CLVER Q 73 ; Other Version differences: 71 74 I (CV'=SV) D Q 72 75 . I '(ALLOWV[("|"_CV_"|")) D Q 73 76 . . S MAGRY="0^4~VistARad Workstation software version "_CLVER_" is not compatible with the VistA server version "_SVERSION_". Contact Imaging support. (CNA)" 77 . ; Don't allow Test versions of P18 78 . I CP=18,(CT'=132) D Q 79 . . S MAGRY="0^4~VistARad Workstation software version "_CLVER_" is not compatible with the VistA server version "_SVERSION_". Contact Imaging support. (C18T)" 74 80 . ; Warn the Client, allow to continue 75 81 . I TESTFLAG S MAGRY="2^3~VistARad Workstation software version "_CLVER_" is running with VistA server TEST Version "_SVERSION_" -- VistARad will Continue, but contact Imaging Support if problems occur. (Pdif)" … … 89 95 Q 90 96 ; 91 P32STOP(RET) ; logic to indicate P32 should no longer function, once the RELEASED P76 is installed92 ; This is invoked from magjutl3, P76 version, if a P32 client is launched93 ; RET=1/0 ^ text -- 0 = OK to run P32; 1 = Not OK94 N SV,ST,ALLOWV,SVSTAT,RELEASED95 S RET="0^P32 supported" ; init return to allow p32 to function96 D GETVER(.SV,.ST,.ALLOWV)97 D VERSTAT(.SVSTAT,SV)98 I 'SVSTAT S RET="0^Error, but on side of caution, allow running." Q ; KIDS status for this version indeterminate99 S RELEASED=(+SVSTAT=2)100 I RELEASED!(SV'="3.0.76") S RET="1^P32 support over" ; don't allow P32 to function101 Q102 ;103 97 VERSTAT(MAGRY,MAGVER) ; 104 98 ; Returns the status of an Imaging Version … … 109 103 N VERI,TVER,MAGERR 110 104 I +MAGVER S MAGVER="MAG*"_$P(MAGVER,".",1,2)_"*"_$P(MAGVER,".",3) 111 S VERI=$$FIND1^DIC(9.6,""," O",MAGVER,"","","MAGERR")105 S VERI=$$FIND1^DIC(9.6,"","",MAGVER,"","","MAGERR") 112 106 I 'VERI S MAGRY="0^4~There is No KIDs Install record." 113 107 E D -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGLOG.m
r628 r636 1 1 MAGLOG ;WOIFO/RED,SRR,MLH - Log image access ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**17,8,20,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**17,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 39 38 I $D(MAGAD) S ^MAG(2006.95,MAGC,100)=MAGAD 40 39 S ^MAG(2006.95,"B",MAGC,MAGC)="" 41 D ACCESS(MAGO) ; This should be here. Can now search 2006.95 from "Last Access Date" to "Capture Date" to42 ; get all Actions logged. We Don't have to search entire Image File.43 40 I $G(MAGJOB("SESSION")) S ^MAG(2006.95,"AS",+$G(MAGJOB("SESSION")),MAGC)="" 44 41 Q 45 42 ACCESS(MAGO) ; Update Field "Last Access Date" in Image File. 46 Q:'$G(MAGO)47 43 I '$D(^MAG(2005,MAGO,0)) D Q 48 44 . I $D(^MAG(2005.1,MAGO,0)) S $P(^MAG(2005.1,MAGO,0),"^",9)=$$NOW^XLFDT -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBPG1.m
r628 r636 1 1 MAGQBPG1 ;WOIFO/RMP - REMOTE Task SERVER Program [ 11/08/2001 17:18 ] 2 ;;3.0;IMAGING;**7,8,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 79 79 CNP2(RESULT,IEN,START,STOP) ;[MAGQ JBSCN] 80 80 S X="ERR^MAGQBTM",@^%ZOSF("TRAP") 81 N FNAME,PIECE,ZNODE,NODE2,BNODE,BNAME,PTR,HASH,TEMP,ORDER,RDATE,PLACE,OFFLINE,PLACEOK,GL,END ,ACQSITE81 N FNAME,PIECE,ZNODE,NODE2,BNODE,BNAME,PTR,HASH,TEMP,ORDER,RDATE,PLACE,OFFLINE,PLACEOK,GL,END 82 82 S (RESULT,GL)="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),(OFFLINE,PLACEOK)=0 83 83 S:START="" START=$O(^MAG(2005,0)) S:STOP="" STOP=$O(^MAG(2005,"A"),-1) … … 91 91 . Q 92 92 S IEN=+IEN 93 F D SCAN^MAGQBPG1(.IEN,ORDER,.GL) D Q:((('OFFLINE)&PLACEOK)!('IEN)!($P(RESULT,U,21)="DUPE") !'$G(ACQSITE))93 F D SCAN^MAGQBPG1(.IEN,ORDER,.GL) D Q:((('OFFLINE)&PLACEOK)!('IEN)!($P(RESULT,U,21)="DUPE")) 94 94 . Q:'IEN 95 . S ZNODE=$G(@(GL_IEN_",0)")) ,ACQSITE=$P($G(@(GL_IEN_",100)")),U,3)96 . S PLACEOK=$S($ $PLACE^MAGBAPI(+ACQSITE)=$$PLACE^MAGBAPI($G(DUZ(2))):1,1:"")95 . S ZNODE=$G(@(GL_IEN_",0)")) 96 . S PLACEOK=$S($P($G(@(GL_IEN_",100)")),U,3)=$G(DUZ(2)):1,1:"") 97 97 . I $P(ZNODE,U,2)'="" S OFFLINE=$$IMOFFLN^MAGFILEB($P(ZNODE,U,2)) ; Only check the offline status of image files 98 98 . I ($D(^MAG(2005.1,IEN,0))&$D(^MAG(2005,IEN,0))) D Q ; Image is duplicated in the Archive file … … 133 133 . I $D(@(GL_IEN_",""FBIG"")")),'$P(BNODE,U),'$P(BNODE,U,2) S $P(RESULT,U,22)="EMPTY_FBIG" 134 134 . Q 135 I '$P($G(@(GL_IEN_",100)")),U,3) S $P(RESULT,U,23)=-1 ;"NO ACQ SITE VALUE"136 ;137 135 I GL[("^MAG(2005.1,") S $P(RESULT,U,21)="ARCH" 138 136 E S $P(RESULT,U,12,17)=$$CHKIMG^MAGQBUT2(IEN) … … 187 185 . D ^XMD 188 186 . K ^TMP($J,"MAGQDFN") 189 . K XMSUB190 187 . Q 191 188 E S CNT=CNT+1,^TMP($J,"MAGQDFN",CNT)=INPUT -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBPRG.m
r628 r636 1 1 MAGQBPRG ;WOIOFO/RMP Magnetic Server Purge processes [ 06/29/2001 18:28 ] 2 ;;3.0;IMAGING;**7,3,8,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,3,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way | … … 54 54 ; 17 = Jukebox offline 55 55 N FILEXT,IEN,SITEID,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,PACS,RIEN,ZNODE 56 N FILETYPE,CPTR,JBPTR,CPOK,BNODE,ALTPATH,NMSPC,PLACE,RDHOLD ,XX56 N FILETYPE,CPTR,JBPTR,CPOK,BNODE,ALTPATH,NMSPC,PLACE,RDHOLD 57 57 S X="ERR^MAGQBTM",@^%ZOSF("TRAP") 58 58 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))) … … 84 84 . E S RESULT="1^^9^^^"_IEN 85 85 . Q 86 I PLACE'=$$PLACE^MAGBAPI( +$P($G(^MAG(2005,IEN,100)),U,3)) D Q86 I PLACE'=$$PLACE^MAGBAPI($P($G(^MAG(2005,IEN,100)),U,3)) D Q 87 87 . S RESULT="-3^^15" Q ;Foreign Place 88 88 S ZNODE=^MAG(2005,IEN,0) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBTM.m
r628 r636 1 1 MAGQBTM ;WOIFO/RMP - REMOTE Task SERVER Program [ 03/25/2001 11:20 ] 2 ;;3.0;IMAGING;**1,7,8,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**1,7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 18 18 ; 19 19 ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP] 20 N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE ,VOK20 N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE 21 21 D NOW^%DTC 22 22 S X="ERR^MAGQBTM",@^%ZOSF("TRAP") 23 S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))) ,VOK=""23 S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))) 24 24 S $P(RESULT(0),U,6)=$D(^XUSEC("MAG SYSTEM",DUZ)) 25 25 Q:'$P(RESULT(0),U,6) … … 38 38 S $P(^MAG(2006.8,SYSIEN,1),U,4)=WSOS 39 39 S VERS=$P(VERS,".",1,2)_"P"_$P(VERS,".",3) 40 D VOKR^MAGQBUT4(.VOK,VERS) 41 Q:'$P(VOK,U) 40 Q:'$$VOK^MAGQBUT4(VERS) 42 41 S ^TMP("MAGQN",$J,0)=SYSIEN_"^"_WSTAT 43 42 S NODE=^MAG(2006.8,SYSIEN,0) -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBUT1.m
r628 r636 1 1 MAGQBUT1 ;WOIFO/RP; Utilities for Background [ 03/25/2001 11:20 ] 2 ;;3.0;IMAGING;**7,8,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 180 180 F INC=FROM:1:TO D 181 181 . I ('$D(^MAG(2005,INC,0))&('$D(^MAG(2005.1,INC,0)))) Q 182 . I ($ $PLACE^MAGBAPI(+$P($G(^MAG(2005,INC,100)),U,3))'=PLACE)&($$PLACE^MAGBAPI(+$P($G(^MAG(2005.1,INC,100)),U,3)'=PLACE)) Q182 . I ($P($G(^MAG(2005,INC,100)),U,3)'=INST)&($P($G(^MAG(2005.1,INC,100)),U,3)'=INST) Q 183 183 . I ($P($G(^MAG(2005,INC,0)),"^",2)="")&($P($G(^MAG(2005.1,INC,0)),"^",2)="") Q ;No full filename attribute 184 184 . I (+$P($G(^MAG(2005,INC,1,0)),"^",4)>0)!(+$P($G(^MAG(2005.1,INC,1,0)),"^",4)>0) Q ;GROUP PARENT -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBUT2.m
r628 r636 1 1 MAGQBUT2 ;WOIFO/SRR/RMP -IMAGE SITE PARAMETERS COMPANION [ 11/08/2001 17:18 ] 2 ;;3.0;IMAGING;**7,8,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 16 16 ;; +---------------------------------------------------------------+ 17 17 ;; 18 VSTAV() ; 19 N VER,IEN,ARRAY,VALUE,LATEST 20 S VER=$$VERSION^XPDUTL("IMAGING") 21 S:$T(LAST^XPDUTL)]"" VER=VER_"^"_$$LAST^XPDUTL("IMAGING",VER) 22 Q VER 23 IWSV(WSD,WSC,WSV,PLACE) ;IMAGE WORKSTATION VERSIONS 24 N IEN,NODE,RD,OS 25 S RD=$$FMADD^XLFDT($$NOW^XLFDT,-180,"","","") 26 S IEN=0 27 F S IEN=$O(^MAG(2006.81,"C",PLACE,IEN)) Q:IEN'?1N.N D 28 . S NODE=^MAG(2006.81,IEN,0) 29 . Q:($P(NODE,U,3)<RD) 30 . S OS=$P($G(^MAG(2006.81,IEN,1)),U,2) 31 . I $P(NODE,"^",9)'="" D 32 . . S INDEX=$P(NODE,"^",9),INDEX=$S(OS="":INDEX,1:INDEX_U_OS) 33 . . S WSD(INDEX)=$G(WSD(INDEX))+1 34 . I $P(NODE,"^",13)'="" D 35 . . S INDEX=$P(NODE,"^",13),INDEX=$S(OS="":INDEX,1:INDEX_U_OS) 36 . . S WSC(INDEX)=$G(WSC(INDEX))+1 37 . I $P(NODE,"^",15)'="" D 38 . . S INDEX=$P(NODE,"^",15),INDEX=$S(OS="":INDEX,1:INDEX_U_OS) 39 . . S WSV(INDEX)=$G(WSV(INDEX))+1 40 Q 41 DICOMV(DCMG) ;Version of DICOM 42 N X,ARRAY,IEN,NAME 43 S X="" 44 F S X=$O(^MAG(2006.83,"B",X)) Q:X="" D 45 . S IEN=$O(^MAG(2006.83,"B",X,"")) Q:IEN'?1N.N 46 . S DCMG($P(^MAG(2006.83,IEN,0),U,3))=$G(DCMG($P(^MAG(2006.83,IEN,0),U,3)))+1 47 Q $S($D(DCMG):1,1:0) 48 VISTARV() ; 49 Q $$VERSION^XPDUTL("MAGJ RADIOLOGY") 18 50 MAGSYS(LIST) ; 19 ; RPC[MAGQ SYSTEM]20 51 N VAIEN,NODE,MGIEN,UNAME,TDATE 21 52 S MGIEN=$$FIND1^DIC(3.8,"","MX","MAG SERVER","","","ERR") … … 31 62 . S LIST(VAIEN)=VAIEN_"^"_UNAME 32 63 Q 33 IMPAR(RESULT,QIEN) ; Import Array64 IMPAR(RESULT,QIEN) ; 34 65 N INDX,CNT 35 66 S (INDX,CNT)=0 … … 40 71 E S RESULT(0)="1" 41 72 Q 73 SNS(PLACE) ; 74 N RESULT,INDEX 75 S INDEX=0 76 S RESULT=$P(^MAG(2006.1,PLACE,0),U,2) 77 F S INDEX=$O(^MAG(2006.1,PLACE,4,INDEX)) Q:INDEX'?1N.N D 78 . S RESULT=RESULT_U_$P($G(^MAG(2006.1,PLACE,4,INDEX,0)),U) 79 Q RESULT 42 80 CHKIMG(IEN) ; 43 81 ; Given an Image IEN, return: … … 84 122 S IDFN=$P(X0,"^",7),$P(R,"^",4)=IDFN 85 123 S PT(3.9)="^XMB(3.9,PD0,|Mail message||2|^XMB(3.9,PD0,2005,|MAIL" 86 ; The following 5 Lab subsections must be in-synch with FILE+42^MAGGTLB187 124 S PT(63)="^LR(PD0,GF,PD1,|Autopsy (microscopic)|AY|1|^LR(PD0,GF,PD1,2005,|AUM" 88 125 S PT(63.02)="^LR(PD0,GF,PD1,|Electron microscopy|EM|1|^LR(PD0,GF,PD1,2005,|EM" 89 126 S PT(63.08)="^LR(PD0,GF,PD1,|Surgical pathology|SP|1|^LR(PD0,GF,PD1,2005,|SP" 90 127 S PT(63.09)="^LR(PD0,GF,PD1,|Cytology|CY|1|^LR(PD0,GF,PD1,2005,|CY|" 91 S PT(63.2)="^LR(PD0,GF,PD1,|Autopsy (gross)|A Y|1|^LR(PD0,GF,PD1,2005,|AUG"128 S PT(63.2)="^LR(PD0,GF,PD1,|Autopsy (gross)|AU|1|^LR(PD0,GF,PD1,2005,|AUG" 92 129 S PT(70)="^RADPT(PDFN,|Radiology Patient||1|" 93 130 S PT(74)="^RARPT(PD0,|Radiology||2|^RARPT(PD0,2005,|RAD" -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBUT4.m
r628 r636 1 1 MAGQBUT4 ;WOIFO/RMP - BP Utilities ;19 Nov 2001 1:23 PM 2 ;;3.0;IMAGING;**7,8,48,20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**7,8,48,20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 83 83 . Q 84 84 Q 85 ; 86 VOKR(RESULT,VER) ; RPC for VOK [MAGQ VOK] 87 N CVERS,PNUM,SLINE 88 S X="ERR^MAGQBTM",@^%ZOSF("TRAP") 89 S SLINE=$T(+2) 85 VOK(VER) ; Check for the appropriate BP Queue processor version 86 ; This routine MAGQBUT4 will need to be released with each BP Update 87 ; The variable CVERS will contain the current BP server version 88 ; ;;3.0;IMAGING;**7,13,8**;Jul 26, 2004 89 N VN,I,CVERS,PNUM,SLINE,ALTVER 90 S SLINE=$T(+2),ALTVER=","_$$TRIM($P(SLINE,"**",2))_"," 90 91 S PNUM=$$TRIM($P(SLINE,"**",2)),PNUM=$$TRIM($P(PNUM,",",$L(PNUM,","))) 91 92 S CVERS=$$TRIM($P(SLINE,";",3))_"P"_PNUM 92 S RESULT=$S(CVERS=VER:1,1:0)_U_CVERS 93 Q 93 Q $S(CVERS=VER:1,$P(VER,"P",2)["13":1,ALTVER[(","_$P(VER,"P",2)_","):1,1:0) 94 94 ; 95 95 TRIM(X) ; remove both leading and trailing blanks -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBUT5.m
r628 r636 1 1 MAGQBUT5 ;WOIFO/RMP - BP Utilities ;Oct 21, 2005 1:23 PM 2 ;;3.0;IMAGING;**20,81**;May 17, 2007 3 ;; Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**20**;Apr 12, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed | … … 66 66 D MAILSHR^MAGQBUT1 67 67 Q 68 RMRPC(NAME) ; Removing an RPC in order to revise69 N MW,RPC,MWE,DIERR70 S MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")71 D CLEAN^DILF72 Q:'MW73 S RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")74 D CLEAN^DILF75 Q:'RPC76 S MWE=$$FIND1^DIC(19.05,","_MW_",","X",NAME,"","","")77 D CLEAN^DILF78 Q:'MWE79 S DA=MWE,DA(1)=MW,DIK="^DIC(19,"_DA(1)_",""RPC"","80 D ^DIK81 K DA,DIK82 S DA=RPC,DIK="^XWB(8994,"83 D ^DIK84 K DA,DIK85 Q86 68 ; -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGSIXG1.m
r628 r636 1 1 MAGSIXG1 ;WOIFO/EdM/GEK/SEB - RPCs for Document Imaging ; 04/29/2002 16:15 2 ;;3.0;IMAGING;**8,48,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8,48**;Jan 11, 2005 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 19 18 Q 20 19 ; 21 ; OUT = Output array. 22 ; OUT(0) -> 1|0 ^ message 23 ; OUT(1) -> Field Headers 24 ; '^' delimited list of column headers used in cMagListView 25 ; OUT(2..n) -> each line is information on 1 image. 26 ; piece '|' 1 is '^' delimited data to be displayed in columns. 27 ; piece '|' 2 is data that is used internally by App. 28 ; 29 ; PKG - Package fld 40 30 ; CLS - Class fld 41 31 ; TYPE - Type fld 42 32 ; EVENT - Proc/Event fld 43 33 ; SPEC - Spec/SubSpecialty fld 44 34 ; FROM - Date to search from 35 ; UNTIL - Date to search to 36 ; ORIGIN - Origin fld 45 37 ; DATA - Future 38 ; FLGS - Future 39 ; 40 PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN,DATA,FLGS) ;RPC [MAG4 PAT GET IMAGES] 20 ; OUT ;--- Output array 21 ; CLS ;--- Class 22 ; TYPE ;-- Type (of what?) 23 ; SPEC ;-- Specialty or SubSpecialty 24 ; EVENT ;- Event or Procedure or Action 25 PGI(OUT,DFN,PKG,CLS,TYPE,EVENT,SPEC,FROM,UNTIL,ORIGIN) ;RPC [MAG4 PAT GET IMAGES] 41 26 ; Get Images for Patient. 42 27 ; New call in Patch 3.0.8 uses Image Filter to get list of images 28 ; 43 29 N C,DAT1,DAT2,E,IMAGE,N,OK,P,RDT,RESULT,S,T,V,CT,PKG1,CLS1,TYPE1,EVENT1,SPEC1,FLTX,FLTY,CAPDUZ,CAPDT,MAGVR,FNL 44 30 S FROM=$G(FROM),UNTIL=$G(UNTIL) … … 56 42 S N=0 57 43 D NETPLCS^MAGGTU6 44 ;S RDT="" F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:RDT="" D 58 45 ;3.0.8/gek, Quit searching all images, just do the date range. 59 46 S RDT=DAT1 F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:(RDT="")!(RDT>DAT2) D 60 . K ^TMP($J,"MAGSIX")61 47 . N COUNT,PRX,X0,X2,X40,I1,X01 62 . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX="" M ^TMP($J,"MAGSIX")=^MAG(2005,"APDTPX",DFN,RDT,PRX) 63 . S IMAGE="" F S IMAGE=$O(^TMP($J,"MAGSIX",IMAGE),-1) Q:IMAGE="" D 64 . . S X0=$G(^MAG(2005,IMAGE,0)) 65 . . Q:$P(X0,"^",10) ; child of Group 66 . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0)) 67 . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5) 68 . . ;Patch 59. Treat Class as a computed Field. Arrange with Mike to change DB. 69 . . S C=$S('T:"",'$D(^MAG(2005.83,T,0)):"",1:$P(^(0),"^",2)) 70 . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null 71 . . D CHK^DIE(2005,45,"E",V,.MAGVR) I MAGVR'="^" S V=MAGVR(0) ; P48T1 show External Value 72 . . I PKG'="",P'="",'$D(OK(5,P)) Q 73 . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q 74 . . I CLS'="",C'="",'$D(OK(1,C)) Q 75 . . I EVENT'="",E,'$D(OK(2,E)) Q 76 . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs 77 . . I EVENT'="",E="" Q 78 . . I SPEC'="",S,'$D(OK(3,S)) Q 79 . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs 80 . . I SPEC'="",S="" Q 81 . . I TYPE'="",T,'$D(OK(4,T)) Q 82 . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple 83 . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1) 84 . . S FLTX="" 85 . . ; PUT in Site Code as 2nd piece. 86 . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0) 87 . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5)) 88 . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2) 89 . . I FLTX="" S FLTX=$G(MAGJOB("PLCODE")) 90 . . S FLTX=FLTX_"^"_$$RPTITLE($P(X2,"^",6),$P(X2,"^",7)) 91 . . S X=$$FMTE^XLFDT($P(X2,"^",5),"5Z") 92 . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01") 93 . . S FLTX=FLTX_"^"_X 94 . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4) 95 . . S FLTX=FLTX_"^"_P 96 . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1) 97 . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1) 98 . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1) 99 . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1) 100 . . S FLTX=FLTX_"^"_V 101 . . ;S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1) 102 . . S X=$$FMTE^XLFDT($P(X2,"^",1),"5Z") 103 . . S X=$P(X,"@",1)_" "_$S($L($P(X,"@",2)):$P(X,"@",2),1:"00:01") 104 . . S FLTX=FLTX_"^"_X 105 . . ;;;;;;;;; 106 . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null 107 . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01) 108 . . N MAGFILE,MAGXX 109 . . S MAGXX=IMAGE D INFO^MAGGTII 110 . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1) 111 . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE 112 . . Q:N<76 Q:RESULT["^" 113 . . ; Image count is getting big, switch from array to Global return type 114 . . S ^TMP($T(+0),$J)="" 115 . . M ^TMP($T(+0),$J)=OUT 116 . . K OUT 117 . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1) 118 . . S RESULT=$NA(^TMP($T(+0),$J)) 119 . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02 48 . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX="" D 49 . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX,IMAGE)) Q:IMAGE="" D 50 . . . S X0=$G(^MAG(2005,IMAGE,0)) 51 . . . Q:$P(X0,"^",10) ; child of Group 52 . . . S X2=$G(^MAG(2005,IMAGE,2)),X40=$G(^MAG(2005,IMAGE,40)),I1=$O(^MAG(2005,IMAGE,1,0)) 53 . . . S P=$P(X40,U),C=$P(X40,"^",2),T=$P(X40,"^",3),E=$P(X40,"^",4),S=$P(X40,"^",5) 54 . . . S V=$S($P(X40,"^",6)="":"V",1:$P(X40,"^",6)) ; P48T1 show VA for Null 55 . . . D CHK^DIE(2005,45,"E",V,.MAGVR) S V=MAGVR(0) ; P48T1 show External Value 56 . . . I PKG'="",P'="",'$D(OK(5,P)) Q 57 . . . I ORIGIN'="",V'="",'$D(OK(6,V)) Q 58 . . . I CLS'="",C'="",'$D(OK(1,C)) Q 59 . . . I EVENT'="",E,'$D(OK(2,E)) Q 60 . . . ;3.0.8 Stop list entries with no Event, if Event is in Search Specs 61 . . . I EVENT'="",E="" Q 62 . . . I SPEC'="",S,'$D(OK(3,S)) Q 63 . . . ;3.0.8 Stop list entries with no Spec, if Spec is in Search Specs 64 . . . I SPEC'="",S="" Q 65 . . . I TYPE'="",T,'$D(OK(4,T)) Q 66 . . . ; Get Count of Images in Group, use 4th piece of ,1,0) multiple 67 . . . S COUNT=$S($P($G(^MAG(2005,IMAGE,1,0)),"^",4):$P($G(^MAG(2005,IMAGE,1,0)),"^",4),1:1) 68 . . . S FLTX="" 69 . . . ; PUT in Site Code as 2nd piece. 70 . . . S X01=$S(I1:$G(^MAG(2005,+$G(^MAG(2005,IMAGE,1,I1,0)),0)),1:X0) 71 . . . S FNL=$S(+$P(X01,"^",3):$P(X01,"^",3),1:+$P(X01,"^",5)) 72 . . . S FLTX=$P($G(MAGJOB("NETPLC",FNL)),"^",2) 73 . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",5),"5Z"),"@",1) 74 . . . S FLTX=FLTX_"^"_$P(X0,"^",8)_"^"_COUNT_"^"_$P(X2,"^",4) 75 . . . S FLTX=FLTX_"^"_P 76 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.82,+C,0)),"^",1) 77 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.83,+T,0)),"^",1) 78 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.84,+S,0)),"^",1) 79 . . . S FLTX=FLTX_"^"_$P($G(^MAG(2005.85,+E,0)),"^",1) 80 . . . S FLTX=FLTX_"^"_V 81 . . . S FLTX=FLTX_"^"_$P($$FMTE^XLFDT($P(X2,"^",1),"5Z"),"@",1) 82 . . . ; P8T36 gek. Fix Error caused if $P(X2,"^",2) "ImageSavedBy" is null 83 . . . S FLTX=FLTX_"^"_$$GET1^DIQ(200,+$P(X2,"^",2)_",",.01) 84 . . . N MAGFILE,MAGXX 85 . . . S MAGXX=IMAGE D INFO^MAGGTII 86 . . . S FLTX=FLTX_"^"_$P(MAGFILE,"^",1) 87 . . . S N=N+1,@RESULT@(N+1)=N_"^"_FLTX_"|"_MAGFILE 88 . . . Q:N<101 Q:RESULT["^" 89 . . . ; Image count is getting big, switch from array to Global return type 90 . . . S ^TMP($T(+0),$J)="" 91 . . . M ^TMP($T(+0),$J)=OUT 92 . . . K OUT 93 . . . S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1) 94 . . . S RESULT=$NA(^TMP($T(+0),$J)) 95 . . . S OUT=$NA(^TMP($T(+0),$J)) ;GEK 10/01/02 96 . . . Q 120 97 . . Q 121 . ;Q122 98 . Q 123 99 S FLTY=$$FLTDESC(X) 124 100 I 'N S @RESULT@(0)="0^No images for filter: "_FLTY Q 125 101 S @RESULT@(0)="1^"_FLTY 126 S @RESULT@(1)="Item~S2^Site^Note Title~~W0^Proc DT~S1^Procedure^# Img~S2^Short Desc^Pkg^Class^Type^Specialty^Event^Origin^Cap Dt~S1~W0^Cap by~~W0^Image ID~S2~W0" 127 ;S @RESULT@(1)="Item~S2^Site^Proc DT~S1^Procedure^# Img~S2^Short Desc^Pkg^Class^Type^Specialty^Event^Origin^Cap Dt~S1~W0^Cap by~~W0^Image ID~S2~W0" 102 S @RESULT@(1)="Item~S2^Site^Proc DT~S1^Procedure^# Img~S2^Short Desc^Pkg^Class^Type^Specialty^Event^Origin^Cap Dt~S1~W0^Cap by~~W0^Image ID~S2~W0" 128 103 Q 129 RPTITLE(FILE,IEN) ;130 I FILE=8925,$D(^TIU(8925,IEN,0)) Q $P(^TIU(8925.1,$P(^TIU(8925,IEN,0),"^",1),0),"^",1)131 ;I FILE=8925,$D(^TIU(8925,IEN,0)) Q $$GET1^DIQ(FILE,IEN,".01:.01")132 E Q " "133 104 FLTDESC(X) ; 134 105 N FLT … … 153 124 . S $P(EVENT,",",CT)=$E(EVENT1)_$$LOW^XLFSTR($E(EVENT1,2,999)) 154 125 S FLT=FLT_$S(EVENT="":"",1:"Event: "_EVENT_" - ") 155 ; Or igin126 ; Orgin 156 127 S FLT=FLT_$S(ORIGIN="":"",1:"Origin: "_ORIGIN_" - ") 157 128 ; Date Range - From -
FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGSIXGT.m
r628 r636 1 1 MAGSIXGT ;WOIFO/EdM/GEK/SEB - RPC for Document Imaging ; 04/29/2002 16:15 2 ;;3.0;IMAGING;**8,48,61,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 2 ;;3.0;IMAGING;**8,48,61**;Feb 07, 2006 4 3 ;; +---------------------------------------------------------------+ 5 4 ;; | Property of the US Government. | … … 9 8 ;; | Development Office of the Department of Veterans Affairs, | 10 9 ;; | telephone (301) 734-0100. | 10 ;; | | 11 11 ;; | The Food and Drug Administration classifies this software as | 12 12 ;; | a medical device. As such, it may not be changed in any way. | … … 29 29 N MAGX 30 30 K OUT 31 S CLS=$G(CLS),FLGS=$ P($G(FLGS),"|")31 S CLS=$G(CLS),FLGS=$G(FLGS) 32 32 ; Capture app will send CLS as ADMIN,ADMIN/CLIN for admin 33 33 ; or CLIN,CLIN/ADMIN for clinical … … 69 69 N C,D0,D1,LOC,N,NO,OK,S,X,NODE 70 70 K OUT 71 S CLS=$G(CLS),SPEC=$G(SPEC),FLGS=$ P($G(FLGS),"|")71 S CLS=$G(CLS),SPEC=$G(SPEC),FLGS=$G(FLGS) 72 72 S IGN=$P(FLGS,"^",1),INCL=$P(FLGS,"^",2),INST=$P(FLGS,"^",3) 73 73 D CLS Q:$D(OUT(0)) … … 116 116 N C,D0,D1,E,LOC,N,OK,X 117 117 K OUT 118 S CLS=$G(CLS),EVENT=$G(EVENT),FLGS=$ P($G(FLGS),"|")118 S CLS=$G(CLS),EVENT=$G(EVENT),FLGS=$G(FLGS) 119 119 S IGN=$P(FLGS,"^",1),INCL=$P(FLGS,"^",2),INST=$P(FLGS,"^",3),INSP=$P(FLGS,"^",4) 120 120 I CLS'="" D CLS Q:$D(OUT(0))
Note:
See TracChangeset
for help on using the changeset viewer.
