KIDS Distribution saved on Jul 12, 2011@10:38:15 VistA Imaging V3.0 - Patch 104 - 07/12/2011 10:38AM **KIDS**:MAG*3.0*104^ **INSTALL NAME** MAG*3.0*104 "BLD",3463,0) MAG*3.0*104^IMAGING^0^3110712^y "BLD",3463,1,0) ^^13^13^3110712^ "BLD",3463,1,1,0) Version 3.0 Patch 104 - Central VistA Imaging Exchange Server "BLD",3463,1,2,0) "BLD",3463,1,3,0) "BLD",3463,1,4,0) Routines: "BLD",3463,1,5,0) MAGDQR21 new value = 159758067 "BLD",3463,1,6,0) MAGIP104 new value = 4514377 "BLD",3463,1,7,0) MAGJEX1 new value = 67789912 "BLD",3463,1,8,0) MAGJEX1B new value = 25186309 "BLD",3463,1,9,0) MAGJUTL2 new value = 45983614 "BLD",3463,1,10,0) MAGJUTL5 new value = 38131193 "BLD",3463,1,11,0) "BLD",3463,1,12,0) Please note that routine MAGIP104 is deleted after the KIDS Build is "BLD",3463,1,13,0) installed. "BLD",3463,4,0) ^9.64PA^^0 "BLD",3463,6.3) V3.0p104Build2225_T5 "BLD",3463,"ABNS",0) ^9.66A^^ "BLD",3463,"ABPKG") n^n^G.IMAGING DEVELOPMENT TEAM@DOMAIN.EXT "BLD",3463,"INI") PRE^MAGIP104 "BLD",3463,"INID") n^y^y "BLD",3463,"INIT") POS^MAGIP104 "BLD",3463,"KRN",0) ^9.67PA^8994^19 "BLD",3463,"KRN",.4,0) .4 "BLD",3463,"KRN",.4,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.401,0) .401 "BLD",3463,"KRN",.401,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.402,0) .402 "BLD",3463,"KRN",.402,"NM",0) ^9.68A^^ "BLD",3463,"KRN",.403,0) .403 "BLD",3463,"KRN",.5,0) .5 "BLD",3463,"KRN",.84,0) .84 "BLD",3463,"KRN",.84,"NM",0) ^9.68A^^ "BLD",3463,"KRN",3.6,0) 3.6 "BLD",3463,"KRN",3.8,0) 3.8 "BLD",3463,"KRN",9.2,0) 9.2 "BLD",3463,"KRN",9.8,0) 9.8 "BLD",3463,"KRN",9.8,"NM",0) ^9.68A^5^5 "BLD",3463,"KRN",9.8,"NM",1,0) MAGDQR21^^0^B159758067 "BLD",3463,"KRN",9.8,"NM",2,0) MAGJEX1^^0^B67789912 "BLD",3463,"KRN",9.8,"NM",3,0) MAGJEX1B^^0^B25186309 "BLD",3463,"KRN",9.8,"NM",4,0) MAGJUTL2^^0^B45983614 "BLD",3463,"KRN",9.8,"NM",5,0) MAGJUTL5^^0^B38131193 "BLD",3463,"KRN",9.8,"NM","B","MAGDQR21",1) "BLD",3463,"KRN",9.8,"NM","B","MAGJEX1",2) "BLD",3463,"KRN",9.8,"NM","B","MAGJEX1B",3) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL2",4) "BLD",3463,"KRN",9.8,"NM","B","MAGJUTL5",5) "BLD",3463,"KRN",19,0) 19 "BLD",3463,"KRN",19,"NM",0) ^9.68A^^ "BLD",3463,"KRN",19.1,0) 19.1 "BLD",3463,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3463,"KRN",101,0) 101 "BLD",3463,"KRN",101,"NM",0) ^9.68A^^ "BLD",3463,"KRN",409.61,0) 409.61 "BLD",3463,"KRN",771,0) 771 "BLD",3463,"KRN",771,"NM",0) ^9.68A^^ "BLD",3463,"KRN",870,0) 870 "BLD",3463,"KRN",870,"NM",0) ^9.68A^^ "BLD",3463,"KRN",8989.51,0) 8989.51 "BLD",3463,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",3463,"KRN",8989.52,0) 8989.52 "BLD",3463,"KRN",8994,0) 8994 "BLD",3463,"KRN",8994,"NM",0) ^9.68A^^ "BLD",3463,"KRN","B",.4,.4) "BLD",3463,"KRN","B",.401,.401) "BLD",3463,"KRN","B",.402,.402) "BLD",3463,"KRN","B",.403,.403) "BLD",3463,"KRN","B",.5,.5) "BLD",3463,"KRN","B",.84,.84) "BLD",3463,"KRN","B",3.6,3.6) "BLD",3463,"KRN","B",3.8,3.8) "BLD",3463,"KRN","B",9.2,9.2) "BLD",3463,"KRN","B",9.8,9.8) "BLD",3463,"KRN","B",19,19) "BLD",3463,"KRN","B",19.1,19.1) "BLD",3463,"KRN","B",101,101) "BLD",3463,"KRN","B",409.61,409.61) "BLD",3463,"KRN","B",771,771) "BLD",3463,"KRN","B",870,870) "BLD",3463,"KRN","B",8989.51,8989.51) "BLD",3463,"KRN","B",8989.52,8989.52) "BLD",3463,"KRN","B",8994,8994) "BLD",3463,"REQB",0) ^9.611^3^3 "BLD",3463,"REQB",1,0) MAG*3.0*115^2 "BLD",3463,"REQB",2,0) MAG*3.0*83^2 "BLD",3463,"REQB",3,0) MAG*3.0*93^2 "BLD",3463,"REQB","B","MAG*3.0*115",1) "BLD",3463,"REQB","B","MAG*3.0*83",2) "BLD",3463,"REQB","B","MAG*3.0*93",3) "INI") PRE^MAGIP104 "INIT") POS^MAGIP104 "MBREQ") 0 "PKG",454,-1) 1^1 "PKG",454,0) IMAGING^MAG^Imaging Release History "PKG",454,22,0) ^9.49I^1^1 "PKG",454,22,1,0) 3.0^3020328^3020328^.5 "PKG",454,22,1,"PAH",1,0) 104^3110712^.5 "PKG",454,22,1,"PAH",1,1,0) ^9.49011^12^12^3110712 "PKG",454,22,1,"PAH",1,1,1,0) Routines for Patch 104, Test Build 5. "PKG",454,22,1,"PAH",1,1,2,0) "PKG",454,22,1,"PAH",1,1,3,0) Routines: "PKG",454,22,1,"PAH",1,1,4,0) MAGDQR21 value = 22992217 "PKG",454,22,1,"PAH",1,1,5,0) MAGIP104 value = 3117560 "PKG",454,22,1,"PAH",1,1,6,0) MAGJEX1 value = 22704581 "PKG",454,22,1,"PAH",1,1,7,0) MAGJEX1B value = 9507612 "PKG",454,22,1,"PAH",1,1,8,0) MAGJUTL2 value = 14194819 "PKG",454,22,1,"PAH",1,1,9,0) MAGJUTL5 value = 16389058 "PKG",454,22,1,"PAH",1,1,10,0) "PKG",454,22,1,"PAH",1,1,11,0) Please note that routine MAGIP104 is deleted after the KIDS Build is "PKG",454,22,1,"PAH",1,1,12,0) installed. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","MAGDQR21") 0^1^B159758067 "RTN","MAGDQR21",1,0) MAGDQR21 ;WOIFO/EdM,NST,MLH - RPCs for Query/Retrieve SetUp ; 09 May 2011 4:27 PM "RTN","MAGDQR21",2,0) ;;3.0;IMAGING;**83,104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGDQR21",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGDQR21",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR21",5,0) ;; | Property of the US Government. | "RTN","MAGDQR21",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGDQR21",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGDQR21",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGDQR21",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGDQR21",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGDQR21",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGDQR21",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGDQR21",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGDQR21",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGDQR21",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGDQR21",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR21",17,0) ;; "RTN","MAGDQR21",18,0) Q "RTN","MAGDQR21",19,0) ; "RTN","MAGDQR21",20,0) GET(OUT,DEST,GATEWAY) ; RPC = MAG GET DICOM DEST "RTN","MAGDQR21",21,0) N D0,D1,N,OK,X "RTN","MAGDQR21",22,0) I $G(DEST)="" D Q "RTN","MAGDQR21",23,0) . S N=1 "RTN","MAGDQR21",24,0) . S X="" F S X=$O(^MAG(2006.587,"B",X)) Q:X="" S N=N+1,OUT(N)="B^"_X "RTN","MAGDQR21",25,0) . S X="" F S X=$O(^MAG(2006.587,"D",X)) Q:X="" S N=N+1,OUT(N)="D^"_X "RTN","MAGDQR21",26,0) . S OUT(1)=N "RTN","MAGDQR21",27,0) . Q "RTN","MAGDQR21",28,0) ; "RTN","MAGDQR21",29,0) S GATEWAY=$G(GATEWAY) S:GATEWAY="--All DICOM Gateways--" GATEWAY="" "RTN","MAGDQR21",30,0) S D0=0,OK=0 F S D0=$O(^MAG(2006.587,D0)) Q:'D0 D Q:OK "RTN","MAGDQR21",31,0) . S X=$G(^MAG(2006.587,D0,0)) "RTN","MAGDQR21",32,0) . Q:$P(X,"^",1)'=DEST "RTN","MAGDQR21",33,0) . I GATEWAY'="",$P(X,"^",5)'=GATEWAY Q "RTN","MAGDQR21",34,0) . S OK=1,N=6 "RTN","MAGDQR21",35,0) . S OUT(2)="2^"_$P(X,"^",2) "RTN","MAGDQR21",36,0) . S OUT(3)="3^"_$P(X,"^",3) "RTN","MAGDQR21",37,0) . S OUT(4)="4^"_$P(X,"^",4) "RTN","MAGDQR21",38,0) . S OUT(5)="5^"_$P(X,"^",6) "RTN","MAGDQR21",39,0) . S OUT(6)="6^"_$P(X,"^",7) "RTN","MAGDQR21",40,0) . S D1=0 F S D1=$O(^MAG(2006.587,D0,1,D1)) Q:'D1 D "RTN","MAGDQR21",41,0) . . S X=$G(^MAG(2006.587,D0,1,D1,0)) Q:$P(X,"^",1)="" "RTN","MAGDQR21",42,0) . . S N=N+1,OUT(N)=X "RTN","MAGDQR21",43,0) . . Q "RTN","MAGDQR21",44,0) . Q "RTN","MAGDQR21",45,0) S OUT(1)=N "RTN","MAGDQR21",46,0) Q "RTN","MAGDQR21",47,0) ; "RTN","MAGDQR21",48,0) SET(OUT,DATA,DEST,GATEWAY) ; RPC = MAG SET DICOM DEST "RTN","MAGDQR21",49,0) N D0,D1,I,N,P,Q,O1,O5,O7,OK,T,X "RTN","MAGDQR21",50,0) I $G(DEST)="" S OUT="-1,No Destination Specified." Q "RTN","MAGDQR21",51,0) ; "RTN","MAGDQR21",52,0) S I="" F S I=$O(DATA(I)) Q:I="" D "RTN","MAGDQR21",53,0) . S T=DATA(I) Q:T'["^" "RTN","MAGDQR21",54,0) . I +T=2 S P(2)=$P(T,"^",2) Q "RTN","MAGDQR21",55,0) . I +T=3 S P(3)=$P(T,"^",2) Q "RTN","MAGDQR21",56,0) . I +T=4 S P(4)=$P(T,"^",2) Q "RTN","MAGDQR21",57,0) . I +T=5 S P(6)=$P(T,"^",2) Q "RTN","MAGDQR21",58,0) . I +T=6 S P(7)=$P(T,"^",2) Q "RTN","MAGDQR21",59,0) . S Q($P(T,"^",1))=(+$P(T,"^",2))_"^"_(+$P(T,"^",3)) "RTN","MAGDQR21",60,0) . Q "RTN","MAGDQR21",61,0) ; "RTN","MAGDQR21",62,0) S OUT=0 "RTN","MAGDQR21",63,0) S GATEWAY=$G(GATEWAY) S:GATEWAY="--All DICOM Gateways--" GATEWAY="" "RTN","MAGDQR21",64,0) S D0=0,OK=0 F S D0=$O(^MAG(2006.587,D0)) Q:'D0 D Q:OK "RTN","MAGDQR21",65,0) . S X=$G(^MAG(2006.587,D0,0)),O1=$P(X,"^",1),O5=$P(X,"^",5),O7=$P(X,"^",7) "RTN","MAGDQR21",66,0) . Q:O1'=DEST "RTN","MAGDQR21",67,0) . I GATEWAY'="",O5'=GATEWAY Q "RTN","MAGDQR21",68,0) . S:GATEWAY'="" OK=1 S OUT=OUT+1 "RTN","MAGDQR21",69,0) . I O1'="",O5'="",O7'="" K ^MAG(2006.587,"C",O1,O7,O5,D0) "RTN","MAGDQR21",70,0) . I O5'="",O7'="" K ^MAG(2006.587,"D",O5,O7,D0) "RTN","MAGDQR21",71,0) . S I="" F S I=$O(P(I)) Q:I="" S:P(I)'="" $P(X,"^",I)=P(I) "RTN","MAGDQR21",72,0) . S:$G(P(7))'="" O7=P(7) "RTN","MAGDQR21",73,0) . S ^MAG(2006.587,D0,0)=X "RTN","MAGDQR21",74,0) . I O1'="",O5'="",O7'="" S ^MAG(2006.587,"C",O1,O7,O5,D0)="" "RTN","MAGDQR21",75,0) . I O5'="",O7'="" S ^MAG(2006.587,"D",O5,O7,D0)="" "RTN","MAGDQR21",76,0) . K ^MAG(2006.587,D0,1) "RTN","MAGDQR21",77,0) . S D1=0,I="" F S I=$O(Q(I)) Q:I="" D "RTN","MAGDQR21",78,0) . . S D1=D1+1,^MAG(2006.587,D0,1,D1,0)=I_"^"_Q(I) "RTN","MAGDQR21",79,0) . . S ^MAG(2006.587,D0,1,"B",I,D1)="" "RTN","MAGDQR21",80,0) . . Q "RTN","MAGDQR21",81,0) . S:D1 ^MAG(2006.587,D0,1,0)="^2006.5871SA^"_D1_"^"_D1 "RTN","MAGDQR21",82,0) . Q "RTN","MAGDQR21",83,0) Q "RTN","MAGDQR21",84,0) ; "RTN","MAGDQR21",85,0) TMPOUT(NAME) N X "RTN","MAGDQR21",86,0) S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1) "RTN","MAGDQR21",87,0) S X=$NA(^TMP("MAG",$J,NAME)) "RTN","MAGDQR21",88,0) K @X "RTN","MAGDQR21",89,0) Q X "RTN","MAGDQR21",90,0) ; "RTN","MAGDQR21",91,0) STUDY1(OUT,STUDIES) ; RPC = MAG DOD GET STUDIES UID "RTN","MAGDQR21",92,0) N I,N,STUDY,UID "RTN","MAGDQR21",93,0) S N=1 S OUT=$$TMPOUT("STUDY") "RTN","MAGDQR21",94,0) S UID=$G(STUDIES) S:UID'="" STUDY(UID)="" "RTN","MAGDQR21",95,0) S I="" F S I=$O(STUDIES(I)) Q:I="" S UID=$G(STUDIES(I)) S:UID'="" STUDY(UID)="" "RTN","MAGDQR21",96,0) S UID="" F S UID=$O(STUDY(UID)) Q:UID="" D STUDY(UID) "RTN","MAGDQR21",97,0) S @OUT@(1)=N-1 "RTN","MAGDQR21",98,0) Q "RTN","MAGDQR21",99,0) ; "RTN","MAGDQR21",100,0) STUDY2(OUT,GROUPS,REQDFN,IMGLESS) ; RPC = MAG DOD GET STUDIES IEN "RTN","MAGDQR21",101,0) ; CR, 5-28-09 "RTN","MAGDQR21",102,0) ; IMGLESS is a new flag to speed up queries: if=1 (true), just get study-level "RTN","MAGDQR21",103,0) ; data, if null or zero get everything. This new flag is optional. "RTN","MAGDQR21",104,0) N I0,I,N,P0,STUDY,UID "RTN","MAGDQR21",105,0) S REQDFN=$G(REQDFN),IMGLESS=$G(IMGLESS) "RTN","MAGDQR21",106,0) S N=1 S OUT=$$TMPOUT("STUDY") "RTN","MAGDQR21",107,0) S I0=$G(GROUPS) D S I="" F S I=$O(GROUPS(I)) Q:I="" S I0=$G(GROUPS(I)) D "RTN","MAGDQR21",108,0) . Q:'I0 "RTN","MAGDQR21",109,0) . F S P0=$P($G(^MAG(2005,+I0,0)),"^",10) Q:'P0 S I0=P0 "RTN","MAGDQR21",110,0) . S UID=$P($G(^MAG(2005,+I0,"PACS")),"^",1) S:UID="" UID="?" "RTN","MAGDQR21",111,0) . S STUDY(UID,I0)="" "RTN","MAGDQR21",112,0) . Q "RTN","MAGDQR21",113,0) S UID="" F S UID=$O(STUDY(UID)) Q:UID="" D "RTN","MAGDQR21",114,0) . I UID="?" D Q "RTN","MAGDQR21",115,0) . . S I0="" "RTN","MAGDQR21",116,0) . . F S I0=$O(STUDY(UID,I0)) Q:I0="" D STUDY("",I0,REQDFN,IMGLESS) "RTN","MAGDQR21",117,0) . . Q "RTN","MAGDQR21",118,0) . D STUDY(UID,"",REQDFN,IMGLESS) ; UID is not "?" "RTN","MAGDQR21",119,0) . Q "RTN","MAGDQR21",120,0) S @OUT@(1)=N-1 "RTN","MAGDQR21",121,0) Q "RTN","MAGDQR21",122,0) ; "RTN","MAGDQR21",123,0) STUDY(UID,IEN,REQDFN,IMGLESS) ; "RTN","MAGDQR21",124,0) N D0,D1,DFN,F1,F2,F3,I0,IMGCNT,IMGINFO,MAGR0,OBJGRP,OVRDDFN,PAT,QINTEG,STUDY,STUMO,X "RTN","MAGDQR21",125,0) N SERIESARRAY ; array of series numbers for this study "RTN","MAGDQR21",126,0) N TOTIMAGES ; total number of images for all series in this study "RTN","MAGDQR21",127,0) N PATCOUNT ; array of patients having studies with the requested study instance UID "RTN","MAGDQR21",128,0) ; "RTN","MAGDQR21",129,0) S N=N+1,@OUT@(N)="NEXT_STUDY|"_UID_"|"_IEN "RTN","MAGDQR21",130,0) I UID'="" S D0="" F S D0=$O(^MAG(2005,"P",UID,D0)) Q:D0="" D "RTN","MAGDQR21",131,0) . S:'$P($G(^MAG(2005,D0,0)),"^",10) STUDY(D0)="" ; Get only image IEN "RTN","MAGDQR21",132,0) . Q "RTN","MAGDQR21",133,0) D:$G(IEN) "RTN","MAGDQR21",134,0) . S:'$P($G(^MAG(2005,IEN,0)),"^",10) STUDY(IEN)="" ; Get only image IEN "RTN","MAGDQR21",135,0) . Q "RTN","MAGDQR21",136,0) Q:'$O(STUDY("")) "RTN","MAGDQR21",137,0) S TOTIMAGES=0 "RTN","MAGDQR21",138,0) S D0="" F S D0=$O(STUDY(D0)) Q:D0="" D "RTN","MAGDQR21",139,0) . S DFN=+$P($G(^MAG(2005,D0,0)),"^",7),PATCOUNT(DFN)="" "RTN","MAGDQR21",140,0) . D ; add to patient array unless single pt was requested and this isn't that pt "RTN","MAGDQR21",141,0) . . I REQDFN'=DFN Q "RTN","MAGDQR21",142,0) . . S:'$D(^MAG(2005,D0,1)) TOTIMAGES=TOTIMAGES+1 ; a single image (e.g., photo ID), not a group "RTN","MAGDQR21",143,0) . . S PAT(DFN,D0)="" "RTN","MAGDQR21",144,0) . . Q "RTN","MAGDQR21",145,0) . S D1=0 F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D "RTN","MAGDQR21",146,0) . . S I0=+$G(^MAG(2005,D0,1,D1,0)) Q:'I0 "RTN","MAGDQR21",147,0) . . S DFN=+$P($G(^MAG(2005,I0,0)),"^",7),PATCOUNT(DFN)="" ; Group DFN "RTN","MAGDQR21",148,0) . . D ; increment image count unless single pt was requested and this isn't that pt "RTN","MAGDQR21",149,0) . . . I REQDFN'=DFN Q "RTN","MAGDQR21",150,0) . . . S TOTIMAGES=TOTIMAGES+1 "RTN","MAGDQR21",151,0) . . . Q "RTN","MAGDQR21",152,0) . . Q "RTN","MAGDQR21",153,0) . Q "RTN","MAGDQR21",154,0) ; "RTN","MAGDQR21",155,0) S PAT=0,DFN="" F S DFN=$O(PATCOUNT(DFN)) Q:DFN="" S PATCOUNT=$G(PATCOUNT)+1 "RTN","MAGDQR21",156,0) I PATCOUNT>1 D Q:'REQDFN Q:'$D(PAT(REQDFN)) "RTN","MAGDQR21",157,0) . ; duplicate study instance UID? "RTN","MAGDQR21",158,0) . S N=N+1,@OUT@(N)="STUDY_ERR|"_UID_"|"_PATCOUNT_" different patients" "RTN","MAGDQR21",159,0) . Q "RTN","MAGDQR21",160,0) ; "RTN","MAGDQR21",161,0) S:UID'="" N=N+1,@OUT@(N)="STUDY_UID|"_UID "RTN","MAGDQR21",162,0) S I0=$O(PAT(REQDFN,"")) "RTN","MAGDQR21",163,0) I 'I0 S N=N+1,@OUT@(N)="STUDY_ERR|"_UID_"|Matching study not found for patient "_REQDFN Q "RTN","MAGDQR21",164,0) S OBJGRP=$$ONEGROUP(I0) ; get the first image IEN for group/image I0 "RTN","MAGDQR21",165,0) S N=N+1,@OUT@(N)="STUDY_IEN|"_I0_"|"_TOTIMAGES_"|"_OBJGRP_"|"_$$CPTCODE(I0)_"|"_$$GETSITE1(OBJGRP) "RTN","MAGDQR21",166,0) ; "RTN","MAGDQR21",167,0) ; check integrity of study record, bail out unless DFN is specified "RTN","MAGDQR21",168,0) ; and matches study DFN (VA internal use only!) "RTN","MAGDQR21",169,0) D CHK^MAGGSQI(.X,I0) S QINTEG='$G(X(0)) D:QINTEG "RTN","MAGDQR21",170,0) . S @OUT@(N)=@OUT@(N)_"|"_$P($G(X(0)),"^",2) "RTN","MAGDQR21",171,0) . Q "RTN","MAGDQR21",172,0) ; override QI check only if image DFN = DFN specified in call "RTN","MAGDQR21",173,0) ; (VA internal only!) "RTN","MAGDQR21",174,0) I QINTEG Q:'REQDFN Q:$P($G(^MAG(2005,I0,0)),"^",7)'=REQDFN "RTN","MAGDQR21",175,0) ; "RTN","MAGDQR21",176,0) S N=N+1,@OUT@(N)="STUDY_PAT|"_REQDFN_"|"_$$GETICN^MPIF001(REQDFN)_"|"_$P($G(^DPT(REQDFN,0)),"^",1) "RTN","MAGDQR21",177,0) ; "RTN","MAGDQR21",178,0) ; CR, 5-28-09 "RTN","MAGDQR21",179,0) ; For study-level data stop here without additional checks "RTN","MAGDQR21",180,0) Q:IMGLESS=1 "RTN","MAGDQR21",181,0) ;end of check above "RTN","MAGDQR21",182,0) ; "RTN","MAGDQR21",183,0) S D0="" F S D0=$O(PAT(REQDFN,D0)) Q:D0="" D "RTN","MAGDQR21",184,0) . N ANY,I,INUM,SERID,SERIES,SNUM,STS,TMP,U1 "RTN","MAGDQR21",185,0) . K ^TMP("MAG",$J,"S") "RTN","MAGDQR21",186,0) . K ^TMP("MAG",$J,"M") "RTN","MAGDQR21",187,0) . D ; retrieve info for either single or group image "RTN","MAGDQR21",188,0) . . I $D(^MAG(2005,D0,1)) D Q ; image is part of a group "RTN","MAGDQR21",189,0) . . . ; allow return of info if DFN defined "RTN","MAGDQR21",190,0) . . . D GROUP^MAGGTIG(.TMP,D0,REQDFN) "RTN","MAGDQR21",191,0) . . . Q "RTN","MAGDQR21",192,0) . . D ; DEFAULT - image is a single "RTN","MAGDQR21",193,0) . . . N X "RTN","MAGDQR21",194,0) . . . D IMAGEINF^MAGGTU3(.X,D0,REQDFN) "RTN","MAGDQR21",195,0) . . . S TMP=$NA(^TMP("MAGGTIG",$J)) "RTN","MAGDQR21",196,0) . . . K @TMP S @TMP@(0)="1^1",@TMP@(1)=X(0) "RTN","MAGDQR21",197,0) . . . Q "RTN","MAGDQR21",198,0) . . Q "RTN","MAGDQR21",199,0) . D:$E($G(TMP),1,5)="^TMP(" "RTN","MAGDQR21",200,0) . . N D,G,M,P,X "RTN","MAGDQR21",201,0) . . K @TMP@(0) "RTN","MAGDQR21",202,0) . . S I="" F S I=$O(@TMP@(I)) Q:I="" D "RTN","MAGDQR21",203,0) . . . S X=$G(@TMP@(I)),D=$P(X,"^",2) Q:'D "RTN","MAGDQR21",204,0) . . . ; Only if those two pieces really aren't used: "RTN","MAGDQR21",205,0) . . . ;;S $P(X,"^",3)="" "RTN","MAGDQR21",206,0) . . . ;;S $P(X,"^",4)="" "RTN","MAGDQR21",207,0) . . . S ^TMP("MAG",$J,"S",D)=X "RTN","MAGDQR21",208,0) . . . S X=$G(^MAG(2005,D,0)),G=+$P(X,"^",10) "RTN","MAGDQR21",209,0) . . . S M=$P(X,"^",8) S:$E(M,1,4)="RAD " M=$E(M,5,$L(M)) Q:M="" "RTN","MAGDQR21",210,0) . . . S G=$P($G(^MAG(2005,G,2)),"^",6),P=$P($G(^MAG(2005,D,2)),"^",6) "RTN","MAGDQR21",211,0) . . . I P'=74,G'=74 Q "RTN","MAGDQR21",212,0) . . . S ^TMP("MAG",$J,"M",1,D)=M,STUMO(M)="" "RTN","MAGDQR21",213,0) . . . S G=$G(^MAG(2005,D,"SERIESUID")) "RTN","MAGDQR21",214,0) . . . S:G'="" ^TMP("MAG",$J,"M",2,G,M)="" "RTN","MAGDQR21",215,0) . . . Q "RTN","MAGDQR21",216,0) . . Q "RTN","MAGDQR21",217,0) . S (ANY,D1)=0 F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D "RTN","MAGDQR21",218,0) . . S X=$G(^MAG(2005,D0,1,D1,0)),I0=+X Q:'I0 "RTN","MAGDQR21",219,0) . . S ANY=1,I0=+X,SNUM=$P(X,"^",2),INUM=$P(X,"^",3) "RTN","MAGDQR21",220,0) . . S U1=$G(^MAG(2005,I0,"SERIESUID")) "RTN","MAGDQR21",221,0) . . S:SNUM="" SNUM="?" S:INUM="" INUM="?" S:U1="" U1="?" "RTN","MAGDQR21",222,0) . . S SERIES(U1_"_"_SNUM,INUM,I0)="",SERID(U1_"_"_SNUM,U1)="" "RTN","MAGDQR21",223,0) . . Q "RTN","MAGDQR21",224,0) . D:'ANY "RTN","MAGDQR21",225,0) . . S U1=$G(^MAG(2005,D0,"SERIESUID")) S:U1="" U1="?" "RTN","MAGDQR21",226,0) . . S SERIES(U1_"_1",1,D0)="",SERID(U1_"_1",U1)="" "RTN","MAGDQR21",227,0) . . Q "RTN","MAGDQR21",228,0) . S SNUM="" F S SNUM=$O(SERIES(SNUM)) Q:SNUM="" D "RTN","MAGDQR21",229,0) . . ; refresh temp image index "RTN","MAGDQR21",230,0) . . N MAGTI S MAGTI=0 ; temp image index "RTN","MAGDQR21",231,0) . . K ^TMP("MAG",$J,"TI") "RTN","MAGDQR21",232,0) . . ; "RTN","MAGDQR21",233,0) . . ; seek qualifying images (no QI or matching known DFN) "RTN","MAGDQR21",234,0) . . S INUM="" F S INUM=$O(SERIES(SNUM,INUM)) Q:INUM="" D "RTN","MAGDQR21",235,0) . . . S I0="" F S I0=$O(SERIES(SNUM,INUM,I0)) Q:I0="" D "RTN","MAGDQR21",236,0) . . . . ; if dup study instance UID, purge image info and bail out "RTN","MAGDQR21",237,0) . . . . ; unless pt is specified and this image is for that pt "RTN","MAGDQR21",238,0) . . . . S MAGR0=$G(^MAG(2005,I0,0)) "RTN","MAGDQR21",239,0) . . . . I REQDFN,$P(MAGR0,"^",7)'=REQDFN K ^TMP("MAG",$J,"S",I0) Q "RTN","MAGDQR21",240,0) . . . . ; "RTN","MAGDQR21",241,0) . . . . S X=$P($G(^MAG(2005,I0,"PACS")),"^",1) "RTN","MAGDQR21",242,0) . . . . S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="NEXT_IMAGE" "RTN","MAGDQR21",243,0) . . . . S:X'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_UID|"_X "RTN","MAGDQR21",244,0) . . . . S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_IEN|"_I0 "RTN","MAGDQR21",245,0) . . . . S X=$P(MAGR0,"^",10) "RTN","MAGDQR21",246,0) . . . . S:X MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="GROUP_IEN|"_X "RTN","MAGDQR21",247,0) . . . . ; QI check - override only if DFN specified in call "RTN","MAGDQR21",248,0) . . . . ; (VA internal only!) "RTN","MAGDQR21",249,0) . . . . D CHK^MAGGSQI(.X,I0) I '$G(X(0)) D Q:'REQDFN "RTN","MAGDQR21",250,0) . . . . . S MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_ERR|"_$P($G(X(0)),"^",2) "RTN","MAGDQR21",251,0) . . . . . Q "RTN","MAGDQR21",252,0) . . . . ; "RTN","MAGDQR21",253,0) . . . . S:INUM'="?" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_NUMBER|"_INUM "RTN","MAGDQR21",254,0) . . . . S IMGINFO=$G(^TMP("MAG",$J,"S",I0)) K ^TMP("MAG",$J,"S",I0) "RTN","MAGDQR21",255,0) . . . . ; Get Site image parameters IEN from 16^ piece of IMGINFO "RTN","MAGDQR21",256,0) . . . . S:IMGINFO'="" MAGTI=MAGTI+1,^TMP("MAG",$J,"TI",MAGTI)="IMAGE_INFO|"_IMGINFO_"|"_$$GETSNUM($P(IMGINFO,"^",16)) "RTN","MAGDQR21",257,0) . . . . Q "RTN","MAGDQR21",258,0) . . . Q "RTN","MAGDQR21",259,0) . . D:$D(^TMP("MAG",$J,"TI")) ; qualifying images were found "RTN","MAGDQR21",260,0) . . . S U1="" F S U1=$O(SERID(SNUM,U1)) Q:U1="" D "RTN","MAGDQR21",261,0) . . . . N M,X "RTN","MAGDQR21",262,0) . . . . S N=N+1,@OUT@(N)="NEXT_SERIES" "RTN","MAGDQR21",263,0) . . . . S:U1'="?" N=N+1,@OUT@(N)="SERIES_UID|"_U1 "RTN","MAGDQR21",264,0) . . . . S N=N+1,@OUT@(N)="SERIES_IEN|"_D0 "RTN","MAGDQR21",265,0) . . . . ; Officially, there can be only one modality per series, "RTN","MAGDQR21",266,0) . . . . ; so stop when the first modality is found... "RTN","MAGDQR21",267,0) . . . . S X="",M="" F S M=$O(^TMP("MAG",$J,"M",2,U1,M)) Q:M="" D Q:X'="" "RTN","MAGDQR21",268,0) . . . . . S X=$S(X'="":"\",1:"")_M "RTN","MAGDQR21",269,0) . . . . . Q "RTN","MAGDQR21",270,0) . . . . S:X'="" N=N+1,@OUT@(N)="SERIES_MODALITY|"_X "RTN","MAGDQR21",271,0) . . . . Q "RTN","MAGDQR21",272,0) . . . D:SNUM'="?" ; assign the series number "RTN","MAGDQR21",273,0) . . . . N SERIESNUM "RTN","MAGDQR21",274,0) . . . . D ; - get series no from study itself if possible, else generate "RTN","MAGDQR21",275,0) . . . . . N SERIESTEST,SGN "RTN","MAGDQR21",276,0) . . . . . S SERIESTEST=$P(SNUM,"_",2) "RTN","MAGDQR21",277,0) . . . . . Q:"+-1234567890"'[$E(SERIESTEST,1) ; invalid number "RTN","MAGDQR21",278,0) . . . . . S:"+-"[$E(SERIESTEST,1) SGN=$E(SERIESTEST,1) "RTN","MAGDQR21",279,0) . . . . . S:$D(SGN) SERIESTEST=$E(SERIESTEST,2,$L(SERIESTEST)) "RTN","MAGDQR21",280,0) . . . . . Q:SERIESTEST'?1.12N "RTN","MAGDQR21",281,0) . . . . . S SERIESTEST=$G(SGN)_SERIESTEST "RTN","MAGDQR21",282,0) . . . . . Q:$D(SERIESARRAY(SERIESTEST)) "RTN","MAGDQR21",283,0) . . . . . S SERIESNUM=SERIESTEST "RTN","MAGDQR21",284,0) . . . . . Q "RTN","MAGDQR21",285,0) . . . . D:'$D(SERIESNUM) ; still need to generate "RTN","MAGDQR21",286,0) . . . . . F SERIESNUM=1:1 Q:'$D(SERIESARRAY(SERIESNUM)) "RTN","MAGDQR21",287,0) . . . . . Q "RTN","MAGDQR21",288,0) . . . . S N=N+1,@OUT@(N)="SERIES_NUMBER|"_SERIESNUM "RTN","MAGDQR21",289,0) . . . . S SERIESARRAY(SERIESNUM)="" "RTN","MAGDQR21",290,0) . . . . Q "RTN","MAGDQR21",291,0) . . . S MAGTI="" "RTN","MAGDQR21",292,0) . . . F S MAGTI=$O(^TMP("MAG",$J,"TI",MAGTI)) Q:'MAGTI D "RTN","MAGDQR21",293,0) . . . . S N=N+1,@OUT@(N)=^TMP("MAG",$J,"TI",MAGTI) "RTN","MAGDQR21",294,0) . . . . Q "RTN","MAGDQR21",295,0) . . . K ^TMP("MAG",$J,"TI") "RTN","MAGDQR21",296,0) . . . Q "RTN","MAGDQR21",297,0) . . Q "RTN","MAGDQR21",298,0) . S I="" F S I=$O(^TMP("MAG",$J,"S",I)) Q:I="" D "RTN","MAGDQR21",299,0) . . S N=N+1,@OUT@(N)="UNUSED_GROUP_INFO|"_^TMP("MAG",$J,"S",I) "RTN","MAGDQR21",300,0) . . Q "RTN","MAGDQR21",301,0) . K ^TMP("MAG",$J,"S") "RTN","MAGDQR21",302,0) . K ^TMP("MAG",$J,"M") "RTN","MAGDQR21",303,0) . Q "RTN","MAGDQR21",304,0) D ; list all modalities "RTN","MAGDQR21",305,0) . N M,X "RTN","MAGDQR21",306,0) . S X="",M="" F S M=$O(STUMO(M)) Q:M="" S X=X_$S(X'="":",",1:"")_M "RTN","MAGDQR21",307,0) . S:X'="" N=N+1,@OUT@(N)="STUDY_MODALITY|"_X "RTN","MAGDQR21",308,0) . Q "RTN","MAGDQR21",309,0) Q "RTN","MAGDQR21",310,0) ; "RTN","MAGDQR21",311,0) ONEGROUP(GROUP) ; Get the first IMAGE_IEN for this group "RTN","MAGDQR21",312,0) N D1,IMGIEN "RTN","MAGDQR21",313,0) I '$D(^MAG(2005,GROUP,1)) Q GROUP ; a single image (e.g., photo ID), not a group "RTN","MAGDQR21",314,0) S IMGIEN="" "RTN","MAGDQR21",315,0) S D1=$O(^MAG(2005,GROUP,1,0)) "RTN","MAGDQR21",316,0) I D1>0 S IMGIEN=+$G(^MAG(2005,GROUP,1,D1,0)) "RTN","MAGDQR21",317,0) I IMGIEN'>0 S IMGIEN="0^Error 1 - First Image not available" "RTN","MAGDQR21",318,0) Q IMGIEN "RTN","MAGDQR21",319,0) ; "RTN","MAGDQR21",320,0) CPTCODE(MAGIEN) ; Returns CPT code by IEN (image pointer) in IMAGE file (#2005) "RTN","MAGDQR21",321,0) ; MAGIEN = IEN in IMAGE file (#2005) "RTN","MAGDQR21",322,0) N RAIEN,CPTCODE "RTN","MAGDQR21",323,0) S RAIEN=+$$GET1^DIQ(2005,MAGIEN,62,"I") ; Get PACS PROCEDURE field #62 "RTN","MAGDQR21",324,0) S CPTCODE=$P($G(^RAMIS(71,RAIEN,0)),"^",9) ; IA # 1174 get CPT Code "RTN","MAGDQR21",325,0) Q:CPTCODE="" "" ; quit with empty code "RTN","MAGDQR21",326,0) S CPTCODE=$$CPT^ICPTCOD(CPTCODE) ; IA # 1995, supported reference "RTN","MAGDQR21",327,0) Q $P(CPTCODE,"^",2) ; Return the code "RTN","MAGDQR21",328,0) ; "RTN","MAGDQR21",329,0) GETSITE1(MAGIEN) ; Returns STATION NUMBER where the image is stored "RTN","MAGDQR21",330,0) ; MAGIEN = IEN in IMAGE file (#2005) "RTN","MAGDQR21",331,0) N MAGNODE,TMP,NLOCIEN,PLC "RTN","MAGDQR21",332,0) N SITEIEN,SITENUM "RTN","MAGDQR21",333,0) I MAGIEN'>0 Q "" "RTN","MAGDQR21",334,0) D:'$D(MAGJOB("NETPLC")) NETPLCS^MAGGTU6 ; Initialize MAGJOB("NETPLC") "RTN","MAGDQR21",335,0) S MAGNODE=$$NODE^MAGGI11(MAGIEN) "RTN","MAGDQR21",336,0) I MAGNODE="" Q "" "RTN","MAGDQR21",337,0) S TMP=$G(@MAGNODE@(0)) "RTN","MAGDQR21",338,0) S NLOCIEN=+$S($P(TMP,U,3):$P(TMP,U,3),1:$P(TMP,U,5)) ; Get IEN in NETWORK LOCATION file (#2005.2) "RTN","MAGDQR21",339,0) S PLC=$P($G(MAGJOB("NETPLC",NLOCIEN)),U,1) ; Imaging Site Parameters IEN "RTN","MAGDQR21",340,0) Q $$GETSNUM(PLC) ; Return STATION NUMBER "RTN","MAGDQR21",341,0) ; "RTN","MAGDQR21",342,0) GETSNUM(MAGPLC) ; Returns STATION NUMBER by Image Site Parameters IEN "RTN","MAGDQR21",343,0) ; MAGPLC - IEN in IMAGING SITE PARAMETERS file (#2006.1) "RTN","MAGDQR21",344,0) I MAGPLC'>0 Q "" "RTN","MAGDQR21",345,0) N SITEIEN,SITENUM "RTN","MAGDQR21",346,0) S SITEIEN=$P($G(^MAG(2006.1,MAGPLC,0)),U,1) ; Get Station IEN in INSTITUTION file (#4) "RTN","MAGDQR21",347,0) Q:SITEIEN="" "" ; if SITE IEN is not defined return blank "RTN","MAGDQR21",348,0) S SITENUM=$P($$NS^XUAF4(SITEIEN),U,2) ; IA #2171 Get Station Number "RTN","MAGDQR21",349,0) Q SITENUM "RTN","MAGIP104") 0^^B4514377 "RTN","MAGIP104",1,0) MAGIP104 ;WOIFO/NST - INSTALL CODE FOR MAG*3.0*104 ; 20 Oct 2010 3:22 PM "RTN","MAGIP104",2,0) ;;3.0;IMAGING;**104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGIP104",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGIP104",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGIP104",5,0) ;; | Property of the US Government. | "RTN","MAGIP104",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGIP104",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGIP104",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGIP104",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGIP104",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGIP104",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGIP104",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGIP104",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGIP104",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGIP104",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGIP104",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGIP104",17,0) ;; "RTN","MAGIP104",18,0) ; There are no environment checks here but the MAGIP104 has to be "RTN","MAGIP104",19,0) ; referenced by the "Environment Check Routine" field of the KIDS "RTN","MAGIP104",20,0) ; build so that entry points of the routine are available to the "RTN","MAGIP104",21,0) ; KIDS during all installation phases. "RTN","MAGIP104",22,0) Q "RTN","MAGIP104",23,0) ; "RTN","MAGIP104",24,0) ;+++++ INSTALLATION ERROR HANDLING "RTN","MAGIP104",25,0) ERROR ; "RTN","MAGIP104",26,0) S:$D(XPDNM) XPDABORT=1 "RTN","MAGIP104",27,0) ;--- Display the messages and store them to the INSTALL file "RTN","MAGIP104",28,0) D DUMP^MAGUERR1(),ABTMSG^MAGKIDS() "RTN","MAGIP104",29,0) Q "RTN","MAGIP104",30,0) ; "RTN","MAGIP104",31,0) ;***** POST-INSTALL CODE "RTN","MAGIP104",32,0) POS ; "RTN","MAGIP104",33,0) N CALLBACK "RTN","MAGIP104",34,0) D CLEAR^MAGUERR(1) "RTN","MAGIP104",35,0) ; "RTN","MAGIP104",36,0) ;--- Restart the Imaging Utilization Report task "RTN","MAGIP104",37,0) I $$CP^MAGKIDS("MAG REPORT TASK","$$RPTSKCP^"_$T(+0))<0 D ERROR Q "RTN","MAGIP104",38,0) ; "RTN","MAGIP104",39,0) ;--- Send the notification e-mail "RTN","MAGIP104",40,0) I $$CP^MAGKIDS("MAG NOTIFICATION","$$NOTIFY^MAGKIDS1")<0 D ERROR Q "RTN","MAGIP104",41,0) Q "RTN","MAGIP104",42,0) ; "RTN","MAGIP104",43,0) ;***** PRE-INSTALL CODE "RTN","MAGIP104",44,0) PRE ; "RTN","MAGIP104",45,0) ;--- "RTN","MAGIP104",46,0) Q "RTN","MAGIP104",47,0) ; "RTN","MAGIP104",48,0) ;+++++ RESTARTS THE IMAGING UTILIZATION REPORT TASK "RTN","MAGIP104",49,0) RPTSKCP() ; "RTN","MAGIP104",50,0) D REMTASK^MAGQE4,STTASK^MAGQE4 "RTN","MAGIP104",51,0) Q 0 "RTN","MAGJEX1") 0^2^B67789912 "RTN","MAGJEX1",1,0) MAGJEX1 ;WIRMFO/JHC VistARad RPC calls ; 21 Apr 2011 5:33 PM "RTN","MAGJEX1",2,0) ;;3.0;IMAGING;**16,22,18,65,101,115,104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGJEX1",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJEX1",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1",5,0) ;; | Property of the US Government. | "RTN","MAGJEX1",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJEX1",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJEX1",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJEX1",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJEX1",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJEX1",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJEX1",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJEX1",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJEX1",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJEX1",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJEX1",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1",17,0) ;; "RTN","MAGJEX1",18,0) Q "RTN","MAGJEX1",19,0) ; "RTN","MAGJEX1",20,0) ; "RTN","MAGJEX1",21,0) ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR "RTN","MAGJEX1",22,0) D @^%ZOSF("ERRTN") "RTN","MAGJEX1",23,0) Q:$Q 1 Q "RTN","MAGJEX1",24,0) ; "RTN","MAGJEX1",25,0) ;***** Open an exam. "RTN","MAGJEX1",26,0) ; RPC: MAGJ RADCASEIMAGES "RTN","MAGJEX1",27,0) ; "RTN","MAGJEX1",28,0) OPENCASE(MAGGRY,DATA) ; "RTN","MAGJEX1",29,0) ; MAGGRY holds $NA reference to ^TMP for rpc return "RTN","MAGJEX1",30,0) ; all ref's to MAGGRY use subscript indirection "RTN","MAGJEX1",31,0) ; input in DATA: "RTN","MAGJEX1",32,0) ; OPEN_FLAG ^ RADFN^RADTI^RACNI^RARPT ^ PSINDGET ^ ^ USETGA "RTN","MAGJEX1",33,0) ; OPEN_FLAG = 0: Open, view only "RTN","MAGJEX1",34,0) ; 1: Open, lock the case for status update "RTN","MAGJEX1",35,0) ; 2: Open, Reserve for Interpretation "RTN","MAGJEX1",36,0) ; VIX: Fetching metadata only; Jukebox retrieval occurs (P115 & earlier) "RTN","MAGJEX1",37,0) ; VIX-Metadata: Fetching metadata only; no JB Retrieval (P104,ff) "RTN","MAGJEX1",38,0) ; VIX-Open: Fetching metadata with JB Retrieval (P104,ff) "RTN","MAGJEX1",39,0) ; RADFN^RADTI^RACNI^RARPT = Exam ID string, specifies case of interest "RTN","MAGJEX1",40,0) ; PSINDGET= Presentation State indicators of interest to client "RTN","MAGJEX1",41,0) ; K/I/U for Key Image/ Interpretation/ User PS types "RTN","MAGJEX1",42,0) ; USETGA = 1: Open TGA (downsampled) file; 0: Open BIG file "RTN","MAGJEX1",43,0) ; "RTN","MAGJEX1",44,0) ; Details of Reply message are below tag OPENCASZ "RTN","MAGJEX1",45,0) ; "RTN","MAGJEX1",46,0) N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1" "RTN","MAGJEX1",47,0) N RARPT,RADFN,RADTI,RACNI,RADIV "RTN","MAGJEX1",48,0) N DAYCASE,CURCASE,REPLY,CT,MAGS,STARTNOD,LOCKED,DATAOUT,RADATA,RIST,MDL "RTN","MAGJEX1",49,0) N IMAG,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,MAGFILE3,MAGLST,MAGOBJT,MODALITY "RTN","MAGJEX1",50,0) N MAGSTRT,MAGEND,CURPATHS "RTN","MAGJEX1",51,0) N MIXEDUP,VIEWOK,USETGA,USELORES,IMGST,REMOTE,DIQUIET "RTN","MAGJEX1",52,0) N LOGDATA,MODIF,EXCAT,RADATA2,PSIND,RACPT,RASTCAT,RASTORD,ACQSITE,ALTPATH,PROCDT "RTN","MAGJEX1",53,0) N YNMAMMO,YNREVANN,PSINDGET,JBDISABLE,STANUM "RTN","MAGJEX1",54,0) S DIQUIET=1 D DT^DICRW "RTN","MAGJEX1",55,0) S (CT,MIXEDUP)=0,MODALITY="",DATAOUT="",DAYCASE="",MAGLST="MAGJOPENCASE",(ACQSITE,ALTPATH,PROCDT,STANUM)="" "RTN","MAGJEX1",56,0) S VIEWOK=1 "RTN","MAGJEX1",57,0) K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)),STARTNOD=0 K @MAGGRY ; assign MAGGRY value "RTN","MAGJEX1",58,0) S CURCASE=$P(DATA,U),RARPT=+$P(DATA,U,5),PSINDGET=+$P(DATA,U,6) "RTN","MAGJEX1",59,0) S PSIND="" I PSINDGET]"" F I="K","I","U" I $F(PSINDGET,I) S PSIND(I)="" "RTN","MAGJEX1",60,0) S USETGA=+$P(DATA,U,8) "RTN","MAGJEX1",61,0) S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4) "RTN","MAGJEX1",62,0) I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X) "RTN","MAGJEX1",63,0) I 'X S REPLY="4~Request Contains Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G OPENCASZ "RTN","MAGJEX1",64,0) S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)) "RTN","MAGJEX1",65,0) K ^TMP($J,"MAGRAEX") "RTN","MAGJEX1",66,0) S RADIV=$P(RADATA2,U,5),MODIF=$P(RADATA2,U,8),RASTCAT=$P(RADATA2,U,11),RASTORD=$P(RADATA,U,15) "RTN","MAGJEX1",67,0) S RARPT=+$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),RACPT=$P(RADATA,U,17) "RTN","MAGJEX1",68,0) I 'RARPT!'$D(^RARPT(RARPT,2005)) S REPLY="4~This exam has no report entry for associating images; no images can be accessed." G OPENCASZ "RTN","MAGJEX1",69,0) D CKINTEG^MAGJRPT(.X,RADFN,RADTI,RACNI,RARPT,RADATA) "RTN","MAGJEX1",70,0) I X]"" S MIXEDUP=1,MIXEDUP("REPLY")=X ; DB corruption "RTN","MAGJEX1",71,0) S REPLY="4~Attempting to open/display case #"_DAYCASE "RTN","MAGJEX1",72,0) S JBDISABLE=0 "RTN","MAGJEX1",73,0) I CURCASE="VIX-Metadata" S JBDISABLE=1 ; metadata only, do not trigger JB fetches "RTN","MAGJEX1",74,0) ; "RTN","MAGJEX1",75,0) ; Note in several reply messages below the use of "2~" "RTN","MAGJEX1",76,0) ; This value triggers specific behaviors in vrad client and VIX "RTN","MAGJEX1",77,0) ; -- client displays an Information message box "RTN","MAGJEX1",78,0) ; -- VIX 'tags' the exam to refresh the file list metadata from the source "RTN","MAGJEX1",79,0) ; on any subsequent access for this exam "RTN","MAGJEX1",80,0) ; These respective behaviours are mutually appropriate for both parts of "RTN","MAGJEX1",81,0) ; the system for all the messages involved; avoid using "2~" unless the "RTN","MAGJEX1",82,0) ; same functionality applies for any given new functionality "RTN","MAGJEX1",83,0) ; "RTN","MAGJEX1",84,0) S IMGST=$$JBFETCH^MAGJUTL2(RARPT,.MAGS,USETGA,JBDISABLE) ; open only if NOT on JB "RTN","MAGJEX1",85,0) I +IMGST D G OPENCASZ ; some images are on JB "RTN","MAGJEX1",86,0) . I $D(MAGS("OFFLN")) N T,TT S T="",TT="" D "RTN","MAGJEX1",87,0) . . F S T=$O(MAGS("OFFLN",T)) Q:T="" S TT=TT_$S(TT="":"",1:", ")_T "RTN","MAGJEX1",88,0) . . S REPLY="2~Case #"_DAYCASE_"--Images for this exam are stored OFF-LINE. To view these images, contact your Imaging Coordinator, and request mounting of the following platters: "_TT "RTN","MAGJEX1",89,0) . E I JBDISABLE S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images are on Jukebox." "RTN","MAGJEX1",90,0) . E S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images have been requested from Jukebox; try again later." "RTN","MAGJEX1",91,0) I '$P(IMGST,U,2) S REPLY="2~No Images exist for Case #"_DAYCASE_"." G OPENCASZ "RTN","MAGJEX1",92,0) S USELORES=+$P(IMGST,U,3)_U_$P(IMGST,U,2) "RTN","MAGJEX1",93,0) S MAGSTRT=1,MAGEND=MAGS D IMGLOOP^MAGJEX1B "RTN","MAGJEX1",94,0) ; "RTN","MAGJEX1",95,0) I ACQSITE="" S ACQSITE=RADIV "RTN","MAGJEX1",96,0) ; "RTN","MAGJEX1",97,0) ; Conditionally support revising an unlocked exam's annotations as a function "RTN","MAGJEX1",98,0) ; of exam status and credentials of (current & original) interpreter (P101). "RTN","MAGJEX1",99,0) S YNREVANN=$$ZRUREVAN^MAGJUTL4(RADFN,RADTI,RACNI) "RTN","MAGJEX1",100,0) ; "RTN","MAGJEX1",101,0) ; Return flag to allow display of disclaimer text if ExamType="Mammogram". "RTN","MAGJEX1",102,0) ; Note the VRad client may override based on image metadata (P101). "RTN","MAGJEX1",103,0) S YNMAMMO=$$ZRUMAMMO^MAGJUTL4(RACPT) "RTN","MAGJEX1",104,0) ; "RTN","MAGJEX1",105,0) ; "RTN","MAGJEX1",106,0) S REPLY="0~Images for Case #"_DAYCASE "RTN","MAGJEX1",107,0) ; "RTN","MAGJEX1",108,0) OPENCASZ I 'CT,(REPLY["Attempting") S REPLY="4~Unable to retrieve images for Case #"_DAYCASE_"." "RTN","MAGJEX1",109,0) ; "RTN","MAGJEX1",110,0) ; Contents of successful reply = 4 pipe-delimited ("|") pieces: "RTN","MAGJEX1",111,0) ; 1: # Image nodes ^ Reply Msg Type ~ Reply Msg display text "RTN","MAGJEX1",112,0) ; 2: RADFN^RADTI^RACNI^RARPT --> Exam ID String "RTN","MAGJEX1",113,0) ; 3: Pt Name ^ CASE # ^ Proc. Name ^ Exam Date ^ Time ^ Modality ^ "RTN","MAGJEX1",114,0) ; SSN ^ ^ LOCKED Status ^ Modifier ^ Exam Status Category "RTN","MAGJEX1",115,0) ; 4: Is Radiologist? ^ Alt_Path Flag ^ Acquisition Site ^ Procedure Date ^ "RTN","MAGJEX1",116,0) ; Revise Annotations? ^ Mammography? ^ Station Number "RTN","MAGJEX1",117,0) ; "RTN","MAGJEX1",118,0) S REMOTE=+MAGJOB("REMOTE") "RTN","MAGJEX1",119,0) S LOCKED=0 "RTN","MAGJEX1",120,0) I MIXEDUP D "RTN","MAGJEX1",121,0) . N IMIX,XDFN,XPTS S VIEWOK=$S($D(MAGJOB("KEYS","MAGJ SEE BAD IMAGES")):1,1:0) "RTN","MAGJEX1",122,0) . I MIXEDUP>1 D "RTN","MAGJEX1",123,0) . . S XPTS="",XDFN=0 F IMIX=0:1 S XDFN=$O(MIXEDUP(XDFN)) Q:'XDFN S XPTS=XPTS_$S(IMIX:" and ",1:" ")_$$PNAM(XDFN) "RTN","MAGJEX1",124,0) . . S XPTS=$S(IMIX=1:" ",1:"s ")_XPTS "RTN","MAGJEX1",125,0) . . S REPLY=(7-VIEWOK)_"~This exam is registered for "_$$PNAM(RADFN)_"; however, it is linked to images for patient"_XPTS_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!" "RTN","MAGJEX1",126,0) . E S REPLY=(7-VIEWOK)_"~"_MIXEDUP("REPLY") "RTN","MAGJEX1",127,0) . I CURCASE S REPLY=REPLY_" The exam is NOT Locked." S CURCASE=0 "RTN","MAGJEX1",128,0) I CT D "RTN","MAGJEX1",129,0) . S RIST=$S(+MAGJOB("USER",1):1,1:0),EXCAT="" "RTN","MAGJEX1",130,0) . S LOGDATA=RADFN_U_+$P(MAGS(1),U,4)_U_+MAGS_U_REMOTE ; for Img Access log "RTN","MAGJEX1",131,0) . I CURCASE D "RTN","MAGJEX1",132,0) . . I $G(MAGJOB("CONSOLIDATED")),'$D(MAGJOB("DIVSCRN",RADIV)) D S CURCASE=0 Q "RTN","MAGJEX1",133,0) . . . S REPLY="5~Exam is for Station #"_$$STATN(RADIV)_"; you are logged on to #"_$$STATN(DUZ(2))_". Exam is NOT Locked." "RTN","MAGJEX1",134,0) . . S XX=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3) "RTN","MAGJEX1",135,0) . . I '$D(^RA(72,"AVC","E",XX)) D S CURCASE=0 Q "RTN","MAGJEX1",136,0) . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated "RTN","MAGJEX1",137,0) . . . I +RESULT(1)!+RESULT(2) D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve "RTN","MAGJEX1",138,0) . . . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,XX,0),U)_"; Lock or Reserve NOT allowed." "RTN","MAGJEX1",139,0) . . E S EXCAT="E" "RTN","MAGJEX1",140,0) . . I RIST,'USELORES D ; lock only for Current Case, Radiologist, & Full Res images "RTN","MAGJEX1",141,0) . . . ; save data needed to later log Interpreted event "RTN","MAGJEX1",142,0) . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY,LOGDATA) "RTN","MAGJEX1",143,0) . . . S LOCKED=$S(+RESULT:1,+$P(RESULT,U,2):2,1:0) "RTN","MAGJEX1",144,0) . I EXCAT="" D "RTN","MAGJEX1",145,0) . . I RASTORD=9 S EXCAT="C" Q ; Complete "RTN","MAGJEX1",146,0) . . E S EXCAT=RASTCAT "RTN","MAGJEX1",147,0) . . I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted "RTN","MAGJEX1",148,0) . S DATAOUT=$P(RADATA,U,4)_U_DAYCASE_U_$P(RADATA,U,9) "RTN","MAGJEX1",149,0) . S X=$P(RADATA,U,6),T=$L(X," "),X=$P(X," ",1,T-1)_U_$P(X," ",T) "RTN","MAGJEX1",150,0) . S DATAOUT=DATAOUT_U_X "RTN","MAGJEX1",151,0) . S DATAOUT=DATAOUT_U_MODALITY_U_$P(RADATA,U,5)_U_U_LOCKED "RTN","MAGJEX1",152,0) . S DATAOUT=DATAOUT_U_MODIF_U_EXCAT_U_"|"_RIST_U_ALTPATH_U_ACQSITE_U_PROCDT_U_YNREVANN_U_YNMAMMO_U_STANUM "RTN","MAGJEX1",153,0) . I USELORES D "RTN","MAGJEX1",154,0) . . I +USELORES=+$P(USELORES,U,2) S X="All" "RTN","MAGJEX1",155,0) . . E S X=+USELORES_" of "_+$P(USELORES,U,2) "RTN","MAGJEX1",156,0) . . I $E(REPLY,1,8)="0~Images" S REPLY="3~" "RTN","MAGJEX1",157,0) . . E S REPLY=REPLY_" -- " "RTN","MAGJEX1",158,0) . . S REPLY=REPLY_"Note: "_X_" images for Case #"_DAYCASE_" are REDUCED RESOLUTION images, using parameters set by your site Imaging Manager; to view full-resolution images, disable the Reduced Resolution option setting. Exam NOT Locked." "RTN","MAGJEX1",159,0) S @MAGGRY@(STARTNOD)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"|"_DATAOUT "RTN","MAGJEX1",160,0) ; if mixedup & not have keys to see images, delete image refs "RTN","MAGJEX1",161,0) ; & send only reply msg "RTN","MAGJEX1",162,0) I MIXEDUP,('VIEWOK) S CT=0 K @MAGGRY S @MAGGRY@(0)=CT_U_REPLY "RTN","MAGJEX1",163,0) E S $P(@MAGGRY@(0),U)=CT+STARTNOD "RTN","MAGJEX1",164,0) I CT,(LOCKED'=2),(CURCASE'["VIX") D LOG^MAGJUTL3("VR-VW",LOGDATA) ; Image access log "RTN","MAGJEX1",165,0) Q "RTN","MAGJEX1",166,0) ; "RTN","MAGJEX1",167,0) PNAM(X) ; return pt name for input DFN "RTN","MAGJEX1",168,0) I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U) "RTN","MAGJEX1",169,0) E S X="UNKNOWN" "RTN","MAGJEX1",170,0) Q X "RTN","MAGJEX1",171,0) ; "RTN","MAGJEX1",172,0) STATN(X) ; get station #, else return input value "RTN","MAGJEX1",173,0) N T "RTN","MAGJEX1",174,0) I X]"" D GETS^DIQ(4,X,99,"","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T "RTN","MAGJEX1",175,0) Q X "RTN","MAGJEX1",176,0) ; "RTN","MAGJEX1",177,0) END Q ; "RTN","MAGJEX1",178,0) ; "RTN","MAGJEX1B") 0^3^B25186309 "RTN","MAGJEX1B",1,0) MAGJEX1B ;WIRMFO/JHC Rad. Workstation RPC calls ; 21 Apr 2011 5:32 PM "RTN","MAGJEX1B",2,0) ;;3.0;IMAGING;**16,22,18,65,76,104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGJEX1B",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJEX1B",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1B",5,0) ;; | Property of the US Government. | "RTN","MAGJEX1B",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJEX1B",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJEX1B",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJEX1B",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJEX1B",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJEX1B",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJEX1B",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJEX1B",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJEX1B",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJEX1B",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJEX1B",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJEX1B",17,0) ;; "RTN","MAGJEX1B",18,0) Q "RTN","MAGJEX1B",19,0) ; Subroutines for fetch exam images, exam lock/reserve, remove dangling locks "RTN","MAGJEX1B",20,0) ; "RTN","MAGJEX1B",21,0) IMGLOOP ; get data for all the images "RTN","MAGJEX1B",22,0) ; This subroutine is called from MAGJEX1 "RTN","MAGJEX1B",23,0) ; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled; "RTN","MAGJEX1B",24,0) ; all references to MAGGRY use subscript indirection "RTN","MAGJEX1B",25,0) N DFN,IMGREC,P18ALTP "RTN","MAGJEX1B",26,0) I '$D(MAGJOB("ALTPATH")) S MAGJOB("ALTPATH")=0 ; facilitates testing "RTN","MAGJEX1B",27,0) F IMAG=MAGSTRT:1:MAGEND S MAGIEN=$P(MAGS(IMAG),U,4) D "RTN","MAGJEX1B",28,0) . S DFN=$P(MAGS(IMAG),U,8) "RTN","MAGJEX1B",29,0) . I DFN=RADFN S MIXEDUP(RADFN)="" ;ok "RTN","MAGJEX1B",30,0) . E S:'DFN DFN=0 S MIXEDUP=MIXEDUP+2,MIXEDUP(DFN)="" ; database corruption "RTN","MAGJEX1B",31,0) . S MDL=$P(MAGS(IMAG),U,3) "RTN","MAGJEX1B",32,0) . I MDL="DR" S MDL="CR" ; for now, hard code cx of non-standard code "RTN","MAGJEX1B",33,0) . S MAGXX=MAGIEN D "RTN","MAGJEX1B",34,0) . . I 'USETGA,($P(MAGS(IMAG),U,2)["BIG") D BIG^MAGFILEB Q "RTN","MAGJEX1B",35,0) . . E D VST^MAGFILEB "RTN","MAGJEX1B",36,0) . I MAGJOB("ALTPATH") S X=$P(MAGS(IMAG),U,6),P18ALTP="" I X]"" D "RTN","MAGJEX1B",37,0) . . F I=1:1:$L(X,",") S T=$P(X,",",I) I T S CURPATHS(T)="" I $D(MAGJOB("LOC",T)) S P18ALTP=P18ALTP_$S(P18ALTP="":"",1:",")_T "RTN","MAGJEX1B",38,0) . S IMGREC="B2^"_MAGIEN_U_MAGFILE2 "RTN","MAGJEX1B",39,0) . S T="",X=$P(MAGS(IMAG),U,11) I X]"" F I="K","I","U" I X[I,$D(PSIND(I)) S T=T_$S(T="":"",1:",")_I ; PS_Indicators "RTN","MAGJEX1B",40,0) . S IMGREC=IMGREC_U_T_U_$S(MAGJOB("ALTPATH"):P18ALTP,1:"") ; AltPaths for this img "RTN","MAGJEX1B",41,0) . I '(PROCDT]"") D ; Img Process Date "RTN","MAGJEX1B",42,0) . . S X=$P(MAGS(IMAG),U,12) I X]"" S T=$S($E(X)=3:20,$E(X)=2:19,1:"") I T S PROCDT=T_$E(X,2,7) "RTN","MAGJEX1B",43,0) . I '(ACQSITE]"") D ; Acq Site "RTN","MAGJEX1B",44,0) . . S X=$P(MAGS(IMAG),U,13) I X]"" S ACQSITE=X "RTN","MAGJEX1B",45,0) . I '(STANUM]"") D ; Station Number "RTN","MAGJEX1B",46,0) . . S X=$P(MAGS(IMAG),U,5) I X]"" S STANUM=X "RTN","MAGJEX1B",47,0) . S CT=CT+1,@MAGGRY@(CT+STARTNOD)=IMGREC "RTN","MAGJEX1B",48,0) . I MODALITY="" S MODALITY=MDL "RTN","MAGJEX1B",49,0) ; "RTN","MAGJEX1B",50,0) I 'MAGJOB("ALTPATH") S ALTPATH=-1 "RTN","MAGJEX1B",51,0) E D "RTN","MAGJEX1B",52,0) . S T=0 F S T=$O(CURPATHS(T)) Q:'T I $D(MAGJOB("LOC",T)) Q "RTN","MAGJEX1B",53,0) . S ALTPATH=$S('T:0,1:1) "RTN","MAGJEX1B",54,0) . I ALTPATH=$P(MAGJOB("ALTPATH"),U,2) S ALTPATH=-1 "RTN","MAGJEX1B",55,0) . E S $P(MAGJOB("ALTPATH"),U,2)=ALTPATH "RTN","MAGJEX1B",56,0) IMGLOOPZ Q "RTN","MAGJEX1B",57,0) ; "RTN","MAGJEX1B",58,0) ; "RTN","MAGJEX1B",59,0) LOCKIN(RARPT,LOCKLEV,MYLOCK,LOCKCHK) ; init lock-related info B4 do any lock actions "RTN","MAGJEX1B",60,0) ; called from UTL3 & EX1A "RTN","MAGJEX1B",61,0) ; if LOCKCHK="STATUS", only return current status "RTN","MAGJEX1B",62,0) ; Input RARPT (required) and LOCKCHK (opt) "RTN","MAGJEX1B",63,0) ; Output: LOCKLEV & MYLOCK array; successful LOCKS left intact, unless LOCKCHK="STATUS" "RTN","MAGJEX1B",64,0) ; M LOCKS det. what Actions are possible by calling program modules "RTN","MAGJEX1B",65,0) ; MYLOCK(1/2)= Lock_is_Mine ^ DUZ ^ $J ^ User Name ^ User Init ^ Case # "RTN","MAGJEX1B",66,0) ; LOCKLEV=0:3--is/not 1-Lockable/2-Reservable/3-Both to user "RTN","MAGJEX1B",67,0) ; MYLOCK=0:3--is/not already 1-Locked/2-Reserved/3-Both by user "RTN","MAGJEX1B",68,0) ; "RTN","MAGJEX1B",69,0) N CKMINE,CASENO,XX,XY,ILOCK "RTN","MAGJEX1B",70,0) S LOCKCHK=$G(LOCKCHK)="STATUS" "RTN","MAGJEX1B",71,0) S LOCKLEV=0 K MYLOCK S MYLOCK=0 "RTN","MAGJEX1B",72,0) L +^XTMP("MAGJ","LOCK",RARPT):0 "RTN","MAGJEX1B",73,0) I S LOCKLEV=3 "RTN","MAGJEX1B",74,0) L +^XTMP("MAGJ","LOCK",RARPT,1):0 ; "1" for Exam "LOCK" "RTN","MAGJEX1B",75,0) I S:'LOCKLEV LOCKLEV=1 "RTN","MAGJEX1B",76,0) L +^XTMP("MAGJ","LOCK",RARPT,2):0 ; "2" for Exam "RESERVE" "RTN","MAGJEX1B",77,0) I S LOCKLEV=$S('LOCKLEV:2,1:3) "RTN","MAGJEX1B",78,0) L -^XTMP("MAGJ","LOCK",RARPT) "RTN","MAGJEX1B",79,0) S CKMINE=DUZ_U_$J "RTN","MAGJEX1B",80,0) F ILOCK=1,2 D "RTN","MAGJEX1B",81,0) . S XX="",XY="",CASENO=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK)) "RTN","MAGJEX1B",82,0) . I CASENO]"" S XX=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK,CASENO)),XY=$P(XX,"|",2),XX=$P(XX,"|") "RTN","MAGJEX1B",83,0) . S X=$P(XX,U,1,2),MYLOCK(ILOCK)=(X=CKMINE) "RTN","MAGJEX1B",84,0) . S X=$P(XX,U)_U_$P(XX,U,2)_U_$P(XX,U,4)_U_$P(XX,U,5)_U_CASENO_U_"|"_XY "RTN","MAGJEX1B",85,0) . S MYLOCK(ILOCK)=MYLOCK(ILOCK)_U_X "RTN","MAGJEX1B",86,0) . I MYLOCK(ILOCK) S MYLOCK=MYLOCK+ILOCK "RTN","MAGJEX1B",87,0) I LOCKCHK,LOCKLEV D ; reset locks for Lock check "RTN","MAGJEX1B",88,0) . I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1) "RTN","MAGJEX1B",89,0) . I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2) "RTN","MAGJEX1B",90,0) Q "RTN","MAGJEX1B",91,0) ; "RTN","MAGJEX1B",92,0) REMLOCK ; Remove dangling exam locks; this is run only at Logon "RTN","MAGJEX1B",93,0) ; If a recorded lock is found that a new job (logon) can M-Lock "RTN","MAGJEX1B",94,0) ; then that is a dangling lock that must be removed "RTN","MAGJEX1B",95,0) N RARPT,TS,LOCKLEV,MYLOCK,ACTION,DAYCASE,ILOCK,RESULT "RTN","MAGJEX1B",96,0) S RARPT="" "RTN","MAGJEX1B",97,0) F S RARPT=$O(^XTMP("MAGJ","LOCK",RARPT)) Q:'RARPT D ; loop thru recorded locks "RTN","MAGJEX1B",98,0) . D LOCKIN(RARPT,.LOCKLEV,.MYLOCK) "RTN","MAGJEX1B",99,0) . I 'LOCKLEV Q ;unable to lock--is ok "RTN","MAGJEX1B",100,0) . S ACTION="",DAYCASE="" "RTN","MAGJEX1B",101,0) . F ILOCK=1,2 I $D(^XTMP("MAGJ","LOCK",RARPT,ILOCK)) S XX=^(ILOCK) D "RTN","MAGJEX1B",102,0) . . I DAYCASE="" S DAYCASE=$P(XX,U) "RTN","MAGJEX1B",103,0) . . I ILOCK=1,(LOCKLEV=1!(LOCKLEV=3)) S $P(ACTION,U,1)=1 "RTN","MAGJEX1B",104,0) . . I ILOCK=2,(LOCKLEV=2!(LOCKLEV=3)) S $P(ACTION,U,2)=1 "RTN","MAGJEX1B",105,0) . I 'ACTION,'+$P(ACTION,U,2),(DAYCASE="") D Q ; should never occur, but "RTN","MAGJEX1B",106,0) . . I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1) "RTN","MAGJEX1B",107,0) . . I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2) "RTN","MAGJEX1B",108,0) . D LOCKOUT^MAGJEX1A(RARPT,DAYCASE,.LOCKLEV,.MYLOCK,ACTION,.RESULT) ; 1st, lock to me "RTN","MAGJEX1B",109,0) . K LOCKLEV,MYLOCK D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; then, clear the lock "RTN","MAGJEX1B",110,0) S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0) "RTN","MAGJEX1B",111,0) S ^XTMP("MAGJ",0)=TS_U_"VistaRad Locks" "RTN","MAGJEX1B",112,0) Q "RTN","MAGJEX1B",113,0) ; "RTN","MAGJEX1B",114,0) ; "RTN","MAGJEX1B",115,0) END ; "RTN","MAGJUTL2") 0^4^B45983614 "RTN","MAGJUTL2",1,0) MAGJUTL2 ;WIRMFO/JHC VistRad subroutines for RPC calls ; 21 Apr 2011 5:34 PM "RTN","MAGJUTL2",2,0) ;;3.0;IMAGING;**18,65,76,104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGJUTL2",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUTL2",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL2",5,0) ;; | Property of the US Government. | "RTN","MAGJUTL2",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUTL2",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUTL2",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUTL2",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUTL2",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUTL2",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUTL2",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUTL2",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUTL2",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUTL2",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUTL2",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL2",17,0) ;; "RTN","MAGJUTL2",18,0) Q "RTN","MAGJUTL2",19,0) IMGINFO(RARPT,RET) ; Fetch info from Image File for input RARPT: "RTN","MAGJUTL2",20,0) ; Input: RARPT: Rad Report pointer "RTN","MAGJUTL2",21,0) ; RET contents delimited by ^: "RTN","MAGJUTL2",22,0) ; CT = # of images for case "RTN","MAGJUTL2",23,0) ; ONL = Image Storage status (Y=On Magnetic disk, N=Jukebox "RTN","MAGJUTL2",24,0) ; "n/a" for not available, e.g., film only) "RTN","MAGJUTL2",25,0) ; note -- if last image in group is Online, considers ALL online "RTN","MAGJUTL2",26,0) ; MAGDT = Date/Time of Image Capture "RTN","MAGJUTL2",27,0) ; REMOTE = 1/0 to Indicate images were remotely cached "RTN","MAGJUTL2",28,0) ; MODALITY = Modality abbrev "RTN","MAGJUTL2",29,0) ; PLACE = Image storage PLace (ptr to 2006.1 entry) "RTN","MAGJUTL2",30,0) ; KEY = 1/0 ind. Key Images exist for this exam "RTN","MAGJUTL2",31,0) ; "RTN","MAGJUTL2",32,0) N IRPT,MAGIEN,MAGIEN2,ONLCHK,NETLOC,STIEN "RTN","MAGJUTL2",33,0) N CT,ONL,MAGDT,REMOTE,MODALITY,PLACE,REMCHK,KEY,TDT "RTN","MAGJUTL2",34,0) S CT="",ONL="",MAGDT="",RET="",REMOTE="",MODALITY="",PLACE="",KEY=0 ; init return vars "RTN","MAGJUTL2",35,0) G IMGINFQ:'RARPT G IMGINFQ:'$D(^RARPT(RARPT,2005,0)) "RTN","MAGJUTL2",36,0) S STIEN=$$STUDYID^MAGJUPD2("",RARPT,1) "RTN","MAGJUTL2",37,0) I STIEN S T=$O(^MAG(2005,STIEN,205,0)) I T S KEY=1 "RTN","MAGJUTL2",38,0) S IRPT=0 F S IRPT=$O(^RARPT(RARPT,2005,IRPT)) Q:'IRPT S MAGIEN=$P(^(IRPT,0),U) D "RTN","MAGJUTL2",39,0) . Q:'$D(^MAG(2005,MAGIEN,0)) "RTN","MAGJUTL2",40,0) . S TDT=$P($G(^MAG(2005,MAGIEN,100)),U,6) S:TDT="" TDT=$P($G(^(2)),U) "RTN","MAGJUTL2",41,0) . I TDT S MAGDT=$S(MAGDT="":TDT,TDT add logic here to put multiple modalities into preferred sequence "RTN","MAGJUTL2",52,0) ; N T,TMDL S T=$P("^RF^XA^CT^CR^DX^MG^US^MR^PT^NM^AS^CD^CS^DG^EC^FA^LP^MA^ST^OT^BI^CP^DD^DM^ES^FS^LS^MS^RG^TG^HC^IO^PX",U_TMDL_U,1) "RTN","MAGJUTL2",53,0) S RET=CT_U_ONL_U_MAGDT_U_REMOTE_U_MODALITY_U_PLACE_U_KEY "RTN","MAGJUTL2",54,0) Q "RTN","MAGJUTL2",55,0) ; "RTN","MAGJUTL2",56,0) ONLCHK(MAGIEN,USETGA) ; "RTN","MAGJUTL2",57,0) ; Input: MAGIEN: Image pointer "RTN","MAGJUTL2",58,0) ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file "RTN","MAGJUTL2",59,0) ;Return: ^-delimited pieces: "RTN","MAGJUTL2",60,0) ; 1 - 1/0 for Full-Res image on Mag. Disk that is Online "RTN","MAGJUTL2",61,0) ; 2 - File type (BIG/FULL) "RTN","MAGJUTL2",62,0) ; 3 - Modality "RTN","MAGJUTL2",63,0) ; 4 - Place "RTN","MAGJUTL2",64,0) ; 5 - DFN "RTN","MAGJUTL2",65,0) ; 6 - File Name IFF this image is stored Off-Line (else null) "RTN","MAGJUTL2",66,0) ; 7 - USETGA * as calculated in the logic below "RTN","MAGJUTL2",67,0) ; 8 - PROCDT = Img Processing DtTime "RTN","MAGJUTL2",68,0) ; 9 - ACQSITE = Acquisition site code "RTN","MAGJUTL2",69,0) ; 10 - STANUM = Station Number where Magnetic Network Loc'n exists "RTN","MAGJUTL2",70,0) ; * USETGA is set to False (0) if a low-resolution image (TGA) is "RTN","MAGJUTL2",71,0) ; requested, but none exists; calling routine would call by ref. "RTN","MAGJUTL2",72,0) ; "RTN","MAGJUTL2",73,0) N BIG,X,NOD,MAG0,MODALITY,RET,PLACE,DFN,FILNAM,MAG2,PROCDT,ACQSITE,MAG100,STANUM "RTN","MAGJUTL2",74,0) S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined "RTN","MAGJUTL2",75,0) S RET="",MODALITY="",PLACE="",ACQSITE="",STANUM="" "RTN","MAGJUTL2",76,0) S MAG0=^MAG(2005,MAGIEN,0),BIG=$D(^("FBIG")),NOD=$S(BIG:^("FBIG"),1:MAG0) "RTN","MAGJUTL2",77,0) S MAG2=^MAG(2005,MAGIEN,2),PROCDT=$P(MAG2,U) "RTN","MAGJUTL2",78,0) S MAG100=$G(^MAG(2005,MAGIEN,100)),ACQSITE=$P(MAG100,U,3) "RTN","MAGJUTL2",79,0) I USETGA D "RTN","MAGJUTL2",80,0) . I 'BIG S USETGA=0 ; reply no low-res image available "RTN","MAGJUTL2",81,0) . I BIG S NOD=MAG0,BIG=0 ; enable correct logic inside this subroutine "RTN","MAGJUTL2",82,0) S MODALITY=$P(MAG0,U,8),DFN=$P(MAG0,U,7) "RTN","MAGJUTL2",83,0) I BIG S X=+$P(NOD,U) ; $p 1 is Magnetic Disk/Volume (.big) "RTN","MAGJUTL2",84,0) E S X=+$P(NOD,U,3) ; $p 3 is Magnetic Disk/Volume (.tga) "RTN","MAGJUTL2",85,0) I X D "RTN","MAGJUTL2",86,0) . I '$D(NETLOC(X)) S NETLOC(X)=+$P(^MAG(2005.2,X,0),U,6)_U_$P(^(0),U,10)_U_$$STANUM(X) "RTN","MAGJUTL2",87,0) . S RET=+NETLOC(X),PLACE=$P(NETLOC(X),U,2),STANUM=$P(NETLOC(X),U,3) ; NETLOC is global to this subrtn "RTN","MAGJUTL2",88,0) . S FILNAM="" "RTN","MAGJUTL2",89,0) E D "RTN","MAGJUTL2",90,0) . S RET=0,FILNAM=$P(MAG0,U,2) "RTN","MAGJUTL2",91,0) . S T=$S(BIG:$P(NOD,U,2),1:$P(NOD,U,5)) "RTN","MAGJUTL2",92,0) . I T S PLACE=$P(^MAG(2005.2,T,0),U,10) "RTN","MAGJUTL2",93,0) S RET=RET_U_$S(BIG:"BIG",1:"FULL")_U_MODALITY_U_PLACE_U_DFN_U_FILNAM_U_USETGA_U_PROCDT_U_ACQSITE_U_STANUM "RTN","MAGJUTL2",94,0) Q RET "RTN","MAGJUTL2",95,0) ; "RTN","MAGJUTL2",96,0) REMOTE(MAGIEN) ;Return list of remote Cache Locations "RTN","MAGJUTL2",97,0) ; else, return "" if none "RTN","MAGJUTL2",98,0) N RET,LOC "RTN","MAGJUTL2",99,0) S RET="" "RTN","MAGJUTL2",100,0) I $D(^MAG(2005,MAGIEN,4,"LOC")) S LOC=0 D "RTN","MAGJUTL2",101,0) . F S LOC=$O(^MAG(2005,MAGIEN,4,"LOC",LOC)) Q:'LOC S RET=RET_$S(RET="":"",1:",")_LOC "RTN","MAGJUTL2",102,0) Q RET "RTN","MAGJUTL2",103,0) ; "RTN","MAGJUTL2",104,0) STANUM(NETLOC) ; Return Station Number for input Network Location "RTN","MAGJUTL2",105,0) N X,STANUM "RTN","MAGJUTL2",106,0) S STANUM="" "RTN","MAGJUTL2",107,0) I +$G(NETLOC) D "RTN","MAGJUTL2",108,0) . S X=$P($G(^MAG(2005.2,NETLOC,0)),"^",10) "RTN","MAGJUTL2",109,0) . I X S STANUM=$$GETSNUM^MAGDQR21(X) "RTN","MAGJUTL2",110,0) Q STANUM "RTN","MAGJUTL2",111,0) ; "RTN","MAGJUTL2",112,0) IMGINF2(RARPT,RET,USETGA) ; Fetch info from Image File for input RARPT: "RTN","MAGJUTL2",113,0) ; Input: RARPT: Rad Report pointer "RTN","MAGJUTL2",114,0) ; RET: see below "RTN","MAGJUTL2",115,0) ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file "RTN","MAGJUTL2",116,0) ; RET holds array of return values: "RTN","MAGJUTL2",117,0) ; RET = # Images stored for the case "RTN","MAGJUTL2",118,0) ; RET(1:n) = ^-delimited pieces: "RTN","MAGJUTL2",119,0) ; 1 - 1/0 for Full-Res image on Mag. Disk that is Online "RTN","MAGJUTL2",120,0) ; 2 - FULL/BIG "RTN","MAGJUTL2",121,0) ; 3 - Modality "RTN","MAGJUTL2",122,0) ; 4 - Image IEN "RTN","MAGJUTL2",123,0) ; 5 - Station # "RTN","MAGJUTL2",124,0) ; 6 - Routed-to Locations (IENs) "RTN","MAGJUTL2",125,0) ; 7 - PLACE "RTN","MAGJUTL2",126,0) ; 8 - DFN "RTN","MAGJUTL2",127,0) ; 9 - FileName (if OffLine) "RTN","MAGJUTL2",128,0) ; 10 - PS_Indicator -- 1=Image is on Magnetic Disk "RTN","MAGJUTL2",129,0) ; "RTN","MAGJUTL2",130,0) ; * This subroutine may be called by other VistARad routines "RTN","MAGJUTL2",131,0) ; "RTN","MAGJUTL2",132,0) N BIG,IMG,MAGIEN,MAGIEN2,MAGPTR,NETLOC "RTN","MAGJUTL2",133,0) K RET S RET=0 "RTN","MAGJUTL2",134,0) S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined "RTN","MAGJUTL2",135,0) G IMGINF2Q:'RARPT S IMG=0 "RTN","MAGJUTL2",136,0) F S IMG=$O(^RARPT(RARPT,2005,IMG)) Q:'IMG S MAGIEN=$P(^(IMG,0),U) D "RTN","MAGJUTL2",137,0) . ; use group multiple structure when present "RTN","MAGJUTL2",138,0) . Q:'$D(^MAG(2005,MAGIEN,0)) S MAGPTR=0 "RTN","MAGJUTL2",139,0) . I '$O(^MAG(2005,MAGIEN,1,MAGPTR)) D Q "RTN","MAGJUTL2",140,0) . . S T=$$ONLCHK(MAGIEN,USETGA) "RTN","MAGJUTL2",141,0) . . S RET=RET+1,RET(RET)=$P(T,U,1,3)_U_MAGIEN_U_$P(T,U,10)_U_$$REMOTE(MAGIEN)_U_$P(T,U,4,7)_U_$$PSIND(MAGIEN)_U_$P(T,U,8)_U_$P(T,U,9) "RTN","MAGJUTL2",142,0) . E F S MAGPTR=$O(^MAG(2005,MAGIEN,1,MAGPTR)) Q:'MAGPTR S MAGIEN2=$P(^(MAGPTR,0),U) D "RTN","MAGJUTL2",143,0) . . S T=$$ONLCHK(MAGIEN2,USETGA) "RTN","MAGJUTL2",144,0) . . S RET=RET+1,RET(RET)=$P(T,U,1,3)_U_MAGIEN2_U_$P(T,U,10)_U_$$REMOTE(MAGIEN2)_U_$P(T,U,4,7)_U_$$PSIND(MAGIEN2)_U_$P(T,U,8)_U_$P(T,U,9) "RTN","MAGJUTL2",145,0) IMGINF2Q ; "RTN","MAGJUTL2",146,0) Q "RTN","MAGJUTL2",147,0) ; "RTN","MAGJUTL2",148,0) PSIND(MAGIEN) ; return Presentation State Indicator(s) for image "RTN","MAGJUTL2",149,0) ; K=Key Image PStype; I=Interpretation PStyp; U=User PStyp "RTN","MAGJUTL2",150,0) N RSL,IEN,X "RTN","MAGJUTL2",151,0) S RSL="",IEN=0 "RTN","MAGJUTL2",152,0) I $D(^MAG(2005,MAGIEN,210,IEN)) F S IEN=$O(^MAG(2005,MAGIEN,210,IEN)) Q:'IEN S X=$P(^(IEN,0),U,2) Q:RSL[X S RSL=RSL_$S(RSL="":"",1:",")_X "RTN","MAGJUTL2",153,0) Q:$Q RSL Q "RTN","MAGJUTL2",154,0) ; "RTN","MAGJUTL2",155,0) JBFETCH(RARPT,MAGS,USETGA,NOFETCH) ; fetch this case's images from Jukebox, if necessary "RTN","MAGJUTL2",156,0) ; Input: RARPT: Rad Report pointer "RTN","MAGJUTL2",157,0) ; MAGS: see below "RTN","MAGJUTL2",158,0) ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file "RTN","MAGJUTL2",159,0) ; NOFETCH: 1/0 -- if 1, metadata get only so do NOT issue Jukebox retrieve "RTN","MAGJUTL2",160,0) ; This is a function that returns a string containing: "RTN","MAGJUTL2",161,0) ; # Images fetched from JB ^ Total # Images for Case ^ # Low Res Imgs "RTN","MAGJUTL2",162,0) ; The MAGS array will be returned to the calling "RTN","MAGJUTL2",163,0) ; routine if MAGS is provided as an input parameter "RTN","MAGJUTL2",164,0) ; MAGS is populated by call to IMGINF2. "RTN","MAGJUTL2",165,0) ; IF any images are stored OffLine, then this node is set here: "RTN","MAGJUTL2",166,0) ; MAGS("OFFLN",JBOFFLN)="" JBOFFLN = Platter ID from file 2006.033 "RTN","MAGJUTL2",167,0) ; "RTN","MAGJUTL2",168,0) ; * This function may be called by other VistARad routines "RTN","MAGJUTL2",169,0) ; "RTN","MAGJUTL2",170,0) N MAGIEN,FETCH,IMAG,FILNAM,JBOFFLN,LORESCT "RTN","MAGJUTL2",171,0) S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined "RTN","MAGJUTL2",172,0) S NOFETCH=+$G(NOFETCH) "RTN","MAGJUTL2",173,0) S FETCH=0,LORESCT=0 "RTN","MAGJUTL2",174,0) D IMGINF2(RARPT,.MAGS,USETGA) "RTN","MAGJUTL2",175,0) I MAGS F IMAG=1:1:MAGS S X=MAGS(IMAG) D "RTN","MAGJUTL2",176,0) . I USETGA S LORESCT=LORESCT+$P(X,U,10) "RTN","MAGJUTL2",177,0) . I '+X D ; Call params below depend on Consolidated Site status "RTN","MAGJUTL2",178,0) . . S FETCH=FETCH+1 "RTN","MAGJUTL2",179,0) . . Q:NOFETCH ; need the count of images on JB, but not retrieving them "RTN","MAGJUTL2",180,0) . . S FILNAM=$P(X,U,9) "RTN","MAGJUTL2",181,0) . . I FILNAM]"",$D(^MAGQUEUE(2006.033,"B",FILNAM)) S T=$O(^(FILNAM,"")) S JBOFFLN=$P($G(^MAGQUEUE(2006.033,T,0)),U,2),MAGS("OFFLN",JBOFFLN)="" Q ; OffLine Image "RTN","MAGJUTL2",182,0) . . I '$G(MAGJOB("CONSOLIDATED")) S X=$$JBTOHD^MAGBAPI($P(X,U,4)_"^"_$P(X,U,2)) ; pre-consolidation vs "RTN","MAGJUTL2",183,0) . . E S X=$$JBTOHD^MAGBAPI($P(X,U,4)_"^"_$P(X,U,2),$P(X,U,7)) "RTN","MAGJUTL2",184,0) JBFETCHQ Q FETCH_U_MAGS_U_LORESCT "RTN","MAGJUTL2",185,0) ; "RTN","MAGJUTL2",186,0) END Q ; "RTN","MAGJUTL5") 0^5^B38131193 "RTN","MAGJUTL5",1,0) MAGJUTL5 ;WOIFO/JHC - VistARad RPCs ; 21 Apr 2011 5:35 PM "RTN","MAGJUTL5",2,0) ;;3.0;IMAGING;**65,76,101,90,115,104**;Mar 19, 2002;Build 2225;Jul 12, 2011 "RTN","MAGJUTL5",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGJUTL5",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL5",5,0) ;; | Property of the US Government. | "RTN","MAGJUTL5",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGJUTL5",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGJUTL5",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGJUTL5",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGJUTL5",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGJUTL5",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGJUTL5",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGJUTL5",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGJUTL5",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGJUTL5",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGJUTL5",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGJUTL5",17,0) ;; "RTN","MAGJUTL5",18,0) Q "RTN","MAGJUTL5",19,0) ; adapted from MAGGTU4 "RTN","MAGJUTL5",20,0) GETVER(SVRVER,SVRTVER,ALLOWCL,VIXVER) ; "RTN","MAGJUTL5",21,0) ; The Server Version SVRVER is hardcoded to match the Client "RTN","MAGJUTL5",22,0) ; so this Routine must be edited/distributed with a new Client "RTN","MAGJUTL5",23,0) ; released Client will have the T version that the server expects "RTN","MAGJUTL5",24,0) ; "RTN","MAGJUTL5",25,0) ;--- Synchronize the below information with that in MAGJTU4V. "RTN","MAGJUTL5",26,0) ; "RTN","MAGJUTL5",27,0) S SVRVER="3.0.115",SVRTVER=4 ; <*> Edit this line for each patch/T-version "RTN","MAGJUTL5",28,0) ; "RTN","MAGJUTL5",29,0) S ALLOWCL="|3.0.90|" ; back-compatible with P90 client "RTN","MAGJUTL5",30,0) ; "RTN","MAGJUTL5",31,0) S VIXVER="" "RTN","MAGJUTL5",32,0) ; VIX may present versions different from vrad Client/Server versions; this would "RTN","MAGJUTL5",33,0) ; happen if M-only changes are made to vrad Server code as part of a VIX patch "RTN","MAGJUTL5",34,0) ; to support updated VIX-related functionality. VIXVERS contains the verson numbers "RTN","MAGJUTL5",35,0) ; that are to be supported in this fashion; related M changes need to be back-compatible "RTN","MAGJUTL5",36,0) ; with prior vrad versions' behavior in the interface "RTN","MAGJUTL5",37,0) N T,VIXVERS "RTN","MAGJUTL5",38,0) S VIXVERS="|3.0.104|" ; keep compatible with P115 & P90 <*> edit as needed for patches "RTN","MAGJUTL5",39,0) S T=$G(MAGJOB("VIX")) "RTN","MAGJUTL5",40,0) I T,VIXVERS[("|"_T_"|") S ALLOWCL=ALLOWCL_T_"|",VIXVER=T "RTN","MAGJUTL5",41,0) Q "RTN","MAGJUTL5",42,0) ; "RTN","MAGJUTL5",43,0) CHKVER(MAGRY,CLVER,PLC,SVERSION) ; "RTN","MAGJUTL5",44,0) ; Input CLVER is the version of the Client "RTN","MAGJUTL5",45,0) ; format: Major.Minor.Patch.Build# [|VIX] -- eg 3.0.115.4|VIX "RTN","MAGJUTL5",46,0) ; Build # = T-version; VIX string only appears if a VIX session "RTN","MAGJUTL5",47,0) ; 3 possible return codes in MAGRY: "RTN","MAGJUTL5",48,0) ; 2^n~msg : Client displays a message and continues "RTN","MAGJUTL5",49,0) ; 1^1~msg : Client continues without displaying a message "RTN","MAGJUTL5",50,0) ; 0^n~msg : Client displays a message then Aborts "RTN","MAGJUTL5",51,0) ; PLC returns 2006.1 pointer "RTN","MAGJUTL5",52,0) ; "RTN","MAGJUTL5",53,0) S CLVER=$G(CLVER),PLC="",MAGRY="" "RTN","MAGJUTL5",54,0) N SV,ST,CV,CT,CP,ALLOWV,TESTFLAG,SVSTAT,VIXVER "RTN","MAGJUTL5",55,0) ; SVERSION = Full Server Version -> (3.0.18.132 or 3.0.18); test has 4, release has 3 parts "RTN","MAGJUTL5",56,0) ; SV = Server Version -> (3.0.18); only 1st 3 parts "RTN","MAGJUTL5",57,0) ; ST = Server T Version -> defined to always match client part-4 "RTN","MAGJUTL5",58,0) ; CV = Client Version, w/out build # "RTN","MAGJUTL5",59,0) ; CT = Client T Version alone "RTN","MAGJUTL5",60,0) ; CP = Client Patch alone "RTN","MAGJUTL5",61,0) ; ALLOWV = Hard coded string of allowed clients for this KIDS. "RTN","MAGJUTL5",62,0) ; TESTFLAG = 1/0 -- 1=Test vs of server code; 0=Release vs "RTN","MAGJUTL5",63,0) ; get VIX version if a VIX session "RTN","MAGJUTL5",64,0) I $P(CLVER,"|",2)["VIX" S MAGJOB("VIX")=$P(CLVER,"|") ; VIX facade version "RTN","MAGJUTL5",65,0) ; "RTN","MAGJUTL5",66,0) I $G(DUZ(2)) S PLC=$$PLACE^MAGBAPI(DUZ(2)) "RTN","MAGJUTL5",67,0) ; Quit if we don't have a valid DUZ(2) or valid PLACE: ^MAG(2006.1,PLC) "RTN","MAGJUTL5",68,0) I 'PLC S MAGRY="0^4~Error verifying Imaging Site (Place) -- Contact Imaging support." Q "RTN","MAGJUTL5",69,0) ; "RTN","MAGJUTL5",70,0) D GETVER(.SV,.ST,.ALLOWV,.VIXVER) "RTN","MAGJUTL5",71,0) S CLVER=$P(CLVER,"|") "RTN","MAGJUTL5",72,0) S CV=$P(CLVER,".",1,3),CT=+$P(CLVER,".",4),CP=+$P(CLVER,".",3) "RTN","MAGJUTL5",73,0) ; "RTN","MAGJUTL5",74,0) D VERSTAT(.SVSTAT,SV) "RTN","MAGJUTL5",75,0) I 'SVSTAT S MAGRY(0)=SVSTAT Q ; KIDS status for this version indeterminate "RTN","MAGJUTL5",76,0) S TESTFLAG=(+SVSTAT=1) "RTN","MAGJUTL5",77,0) S SVERSION=SV "RTN","MAGJUTL5",78,0) I TESTFLAG S SVERSION=SV_"."_ST "RTN","MAGJUTL5",79,0) ; Check Version differences: "RTN","MAGJUTL5",80,0) I (CV'=SV) D Q "RTN","MAGJUTL5",81,0) . I '(ALLOWV[("|"_CV_"|")) D Q "RTN","MAGJUTL5",82,0) . . S MAGRY="0^4~VistARad Workstation software version "_CLVER_" is not compatible with the VistA server version "_SVERSION_". Contact Imaging support. (CNA)" "RTN","MAGJUTL5",83,0) . ; Warn the Client (unless VIX), allow to continue "RTN","MAGJUTL5",84,0) . 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)" "RTN","MAGJUTL5",85,0) . E I VIXVER]"" S MAGRY="1^1~VIX software vs. "_CLVER_" is running with VistA server vs. "_SVERSION_". (VIXdif)" "RTN","MAGJUTL5",86,0) . E S MAGRY="2^3~VistARad Workstation software version "_CLVER_" is running with VistA server Version "_SVERSION_" -- VistARad will Continue, but contact Imaging Support to install Released Version. (RPdif)" "RTN","MAGJUTL5",87,0) . Q "RTN","MAGJUTL5",88,0) ; Versions are the Same: If T versions are not, warn the Client if needed. "RTN","MAGJUTL5",89,0) ; Released Client (of any version) will have the T version that the server "RTN","MAGJUTL5",90,0) ; expects, and no warning will be displayed. "RTN","MAGJUTL5",91,0) I CT,(CT'=ST) D Q "RTN","MAGJUTL5",92,0) . I TESTFLAG S MAGRY="2^3~VistARad Workstation software vs. "_CLVER_" is running with VistA server TEST vs. "_SVERSION_" -- VistARad will Continue, but contact Imaging Support " D "RTN","MAGJUTL5",93,0) . . I CT