KIDS Distribution saved on Jan 27, 2016@07:59:29 VistA Imaging V3.0 - Patch 162 - Query retrieve **KIDS**:MAG*3.0*162^ **INSTALL NAME** MAG*3.0*162 "BLD",8339,0) MAG*3.0*162^IMAGING^0^3160127^y "BLD",8339,1,0) ^^15^15^3160127^ "BLD",8339,1,1,0) "BLD",8339,1,2,0) VistA Imaging V3.0 - Patch 162 - Query retrieve "BLD",8339,1,3,0) "BLD",8339,1,4,0) Routines: "BLD",8339,1,5,0) MAGDQR03 value = 217560028 "BLD",8339,1,6,0) MAGDRPCA value = 80785193 "BLD",8339,1,7,0) MAGIP162 value = 4110396 "BLD",8339,1,8,0) MAGVAG03 value = 76869387 "BLD",8339,1,9,0) MAGVCWIA value = 117974804 "BLD",8339,1,10,0) MAGVGUID value = 34583705 "BLD",8339,1,11,0) MAGVRS61 value = 95250185 "BLD",8339,1,12,0) MAGDQR72 value = 8819008 "BLD",8339,1,13,0) "BLD",8339,1,14,0) Please note that routine MAGIP162 is deleted after the KIDS build is "BLD",8339,1,15,0) installed "BLD",8339,4,0) ^9.64PA^2006.931^1 "BLD",8339,4,2006.931,0) 2006.931 "BLD",8339,4,2006.931,222) y^n^f^^n^^y^o^n "BLD",8339,4,2006.931,224) "BLD",8339,4,"B",2006.931,2006.931) "BLD",8339,6.3) 22 "BLD",8339,"ABNS",0) ^9.66A^^ "BLD",8339,"ABPKG") n^n^G.IMAGING DEVELOPMENT TEAM@DOMAIN.EXT "BLD",8339,"INID") n^y^n "BLD",8339,"INIT") POS^MAGIP162 "BLD",8339,"KRN",0) ^9.67PA^779.2^20 "BLD",8339,"KRN",.4,0) .4 "BLD",8339,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",8339,"KRN",.401,0) .401 "BLD",8339,"KRN",.401,"NM",0) ^9.68A^^0 "BLD",8339,"KRN",.402,0) .402 "BLD",8339,"KRN",.402,"NM",0) ^9.68A^^ "BLD",8339,"KRN",.403,0) .403 "BLD",8339,"KRN",.5,0) .5 "BLD",8339,"KRN",.84,0) .84 "BLD",8339,"KRN",.84,"NM",0) ^9.68A^^ "BLD",8339,"KRN",3.6,0) 3.6 "BLD",8339,"KRN",3.8,0) 3.8 "BLD",8339,"KRN",3.8,"NM",0) ^9.68A^^ "BLD",8339,"KRN",9.2,0) 9.2 "BLD",8339,"KRN",9.8,0) 9.8 "BLD",8339,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",8339,"KRN",9.8,"NM",1,0) MAGDQR03^^0^B217560028 "BLD",8339,"KRN",9.8,"NM",2,0) MAGDRPCA^^0^B80785193 "BLD",8339,"KRN",9.8,"NM",3,0) MAGVAG03^^0^B76869387 "BLD",8339,"KRN",9.8,"NM",4,0) MAGVCWIA^^0^B117974804 "BLD",8339,"KRN",9.8,"NM",5,0) MAGVGUID^^0^B34583705 "BLD",8339,"KRN",9.8,"NM",6,0) MAGVRS61^^0^B95250185 "BLD",8339,"KRN",9.8,"NM",7,0) MAGIP162^^0^B4110396 "BLD",8339,"KRN",9.8,"NM",8,0) MAGDQR72^^0^B8819008 "BLD",8339,"KRN",9.8,"NM","B","MAGDQR03",1) "BLD",8339,"KRN",9.8,"NM","B","MAGDQR72",8) "BLD",8339,"KRN",9.8,"NM","B","MAGDRPCA",2) "BLD",8339,"KRN",9.8,"NM","B","MAGIP162",7) "BLD",8339,"KRN",9.8,"NM","B","MAGVAG03",3) "BLD",8339,"KRN",9.8,"NM","B","MAGVCWIA",4) "BLD",8339,"KRN",9.8,"NM","B","MAGVGUID",5) "BLD",8339,"KRN",9.8,"NM","B","MAGVRS61",6) "BLD",8339,"KRN",19,0) 19 "BLD",8339,"KRN",19,"NM",0) ^9.68A^^0 "BLD",8339,"KRN",19.1,0) 19.1 "BLD",8339,"KRN",19.1,"NM",0) ^9.68A^^0 "BLD",8339,"KRN",101,0) 101 "BLD",8339,"KRN",101,"NM",0) ^9.68A^^ "BLD",8339,"KRN",409.61,0) 409.61 "BLD",8339,"KRN",771,0) 771 "BLD",8339,"KRN",771,"NM",0) ^9.68A^^ "BLD",8339,"KRN",779.2,0) 779.2 "BLD",8339,"KRN",870,0) 870 "BLD",8339,"KRN",870,"NM",0) ^9.68A^^ "BLD",8339,"KRN",8989.51,0) 8989.51 "BLD",8339,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",8339,"KRN",8989.52,0) 8989.52 "BLD",8339,"KRN",8994,0) 8994 "BLD",8339,"KRN",8994,"NM",0) ^9.68A^1^1 "BLD",8339,"KRN",8994,"NM",1,0) MAGVC WI LIST^^0 "BLD",8339,"KRN",8994,"NM","B","MAGVC WI LIST",1) "BLD",8339,"KRN","B",.4,.4) "BLD",8339,"KRN","B",.401,.401) "BLD",8339,"KRN","B",.402,.402) "BLD",8339,"KRN","B",.403,.403) "BLD",8339,"KRN","B",.5,.5) "BLD",8339,"KRN","B",.84,.84) "BLD",8339,"KRN","B",3.6,3.6) "BLD",8339,"KRN","B",3.8,3.8) "BLD",8339,"KRN","B",9.2,9.2) "BLD",8339,"KRN","B",9.8,9.8) "BLD",8339,"KRN","B",19,19) "BLD",8339,"KRN","B",19.1,19.1) "BLD",8339,"KRN","B",101,101) "BLD",8339,"KRN","B",409.61,409.61) "BLD",8339,"KRN","B",771,771) "BLD",8339,"KRN","B",779.2,779.2) "BLD",8339,"KRN","B",870,870) "BLD",8339,"KRN","B",8989.51,8989.51) "BLD",8339,"KRN","B",8989.52,8989.52) "BLD",8339,"KRN","B",8994,8994) "BLD",8339,"PRE") "BLD",8339,"QDEF") ^^^^^^^^ "BLD",8339,"QUES",0) ^9.62^^ "BLD",8339,"REQB",0) ^9.611^1^1 "BLD",8339,"REQB",1,0) MAG*3.0*157^2 "BLD",8339,"REQB","B","MAG*3.0*157",1) "DATA",2006.931,1,0) STARTUP "DATA",2006.931,2,0) SHUTDOWN "DATA",2006.931,3,0) DICOM QUERY "DATA",2006.931,4,0) DICOM RETRIEVE "DATA",2006.931,5,0) DICOM STORAGE "DATA",2006.931,6,0) DISABLE AUDIT "DATA",2006.931,7,0) ENABLE AUDIT "DATA",2006.931,8,0) AUTHENTICATION FAILURE "DATA",2006.931,9,0) CLIENT LOGIN "DATA",2006.931,10,0) IMPORTER AE SECURITY SUCCESS "DATA",2006.931,11,0) IMPORTER AE SECURITY FAILURE "DATA",2006.931,12,0) DELETE "FIA",2006.931) IMAGING EVENT AUDITABLE ACTION "FIA",2006.931,0) ^MAGV(2006.931, "FIA",2006.931,0,0) 2006.931 "FIA",2006.931,0,1) y^n^f^^n^^y^o^n "FIA",2006.931,0,10) "FIA",2006.931,0,11) "FIA",2006.931,0,"RLRO") "FIA",2006.931,0,"VR") 3.0^MAG "FIA",2006.931,2006.931) 0 "INIT") POS^MAGIP162 "KRN",8994,3403,-1) 0^1 "KRN",8994,3403,0) MAGVC WI LIST^ACTLIST^MAGVCWIA^2^R^0^^0^.9^^1 "KRN",8994,3403,1,0) ^8994.01^20^20^3151129^^ "KRN",8994,3403,1,1,0) +---------------------------------------------------------------+ "KRN",8994,3403,1,2,0) | Property of the US Government. | "KRN",8994,3403,1,3,0) | No permission to copy or redistribute this software is given. | "KRN",8994,3403,1,4,0) | Use of unreleased versions of this software requires the user | "KRN",8994,3403,1,5,0) | to execute a written test agreement with the VistA Imaging | "KRN",8994,3403,1,6,0) | Development Office of the Department of Veterans Affairs, | "KRN",8994,3403,1,7,0) | telephone (301) 734-0100. | "KRN",8994,3403,1,8,0) | | "KRN",8994,3403,1,9,0) | The Food and Drug Administration classifies this software as | "KRN",8994,3403,1,10,0) | a medical device. As such, it may not be changed in any way. | "KRN",8994,3403,1,11,0) | Modifications to this software may result in an adulterated | "KRN",8994,3403,1,12,0) | medical device under 21CFR820, the use of which is considered | "KRN",8994,3403,1,13,0) | to be a violation of US Federal Statutes. | "KRN",8994,3403,1,14,0) +---------------------------------------------------------------+ "KRN",8994,3403,1,15,0) "KRN",8994,3403,1,16,0) Returns an array of MAG WORK ITEM (#2006.941) entries of WORKLIST type StorageCommit, "KRN",8994,3403,1,17,0) optionally filtered by hostname, sorted by inverse ResponseDateTime (MAG*3.0*79). "KRN",8994,3403,1,18,0) The number of returned array elements can optionally be restricted and "KRN",8994,3403,1,19,0) the IEN of the last record returned in the previous RPC call can "KRN",8994,3403,1,20,0) be provided as a starting point for work item look ups. "KRN",8994,3403,2,0) ^8994.02A^3^3 "KRN",8994,3403,2,1,0) HOSTNAME^1^^0^1 "KRN",8994,3403,2,1,1,0) ^8994.021^1^1^3151109^^ "KRN",8994,3403,2,1,1,1,0) If present, names the host used to select entries to return. "KRN",8994,3403,2,2,0) WILIMIT^1^32000^0^2 "KRN",8994,3403,2,2,1,0) ^8994.021^1^1^3151129^^ "KRN",8994,3403,2,2,1,1,0) The maxium number of work items to return in one RPC call. "KRN",8994,3403,2,3,0) LASTIEN^1^32000^0^3 "KRN",8994,3403,2,3,1,0) ^8994.021^1^1^3151129^^ "KRN",8994,3403,2,3,1,1,0) The IEN of the last work item record returned in the previous RPC call. "KRN",8994,3403,2,"B","HOSTNAME",1) "KRN",8994,3403,2,"B","LASTIEN",3) "KRN",8994,3403,2,"B","WILIMIT",2) "KRN",8994,3403,2,"PARAMSEQ",1,1) "KRN",8994,3403,2,"PARAMSEQ",2,2) "KRN",8994,3403,2,"PARAMSEQ",3,3) "KRN",8994,3403,3,0) ^8994.03^2^2^3151129^^^^ "KRN",8994,3403,3,1,0) Returns n < 0`errmsg, or 0`## lines returned, where each line is a "KRN",8994,3403,3,2,0) "|"-delimited list of work item fields. "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "PKG",454,-1) 1^1 "PKG",454,0) IMAGING^MAG^Imaging-V1 to release "PKG",454,20,0) ^9.402P^^ "PKG",454,22,0) ^9.49I^1^1 "PKG",454,22,1,0) 3.0^3020319^3020517^126 "PKG",454,22,1,"PAH",1,0) 162^3160127^126 "PKG",454,22,1,"PAH",1,1,0) ^^15^15^3160127 "PKG",454,22,1,"PAH",1,1,1,0) "PKG",454,22,1,"PAH",1,1,2,0) VistA Imaging V3.0 - Patch 162 - Query retrieve "PKG",454,22,1,"PAH",1,1,3,0) "PKG",454,22,1,"PAH",1,1,4,0) Routines: "PKG",454,22,1,"PAH",1,1,5,0) MAGDQR03 value = 217560028 "PKG",454,22,1,"PAH",1,1,6,0) MAGDRPCA value = 80785193 "PKG",454,22,1,"PAH",1,1,7,0) MAGIP162 value = 4110396 "PKG",454,22,1,"PAH",1,1,8,0) MAGVAG03 value = 76869387 "PKG",454,22,1,"PAH",1,1,9,0) MAGVCWIA value = 117974804 "PKG",454,22,1,"PAH",1,1,10,0) MAGVGUID value = 34583705 "PKG",454,22,1,"PAH",1,1,11,0) MAGVRS61 value = 95250185 "PKG",454,22,1,"PAH",1,1,12,0) MAGDQR72 value = 8819008 "PKG",454,22,1,"PAH",1,1,13,0) "PKG",454,22,1,"PAH",1,1,14,0) Please note that routine MAGIP162 is deleted after the KIDS build is "PKG",454,22,1,"PAH",1,1,15,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") 8 "RTN","MAGDQR03") 0^1^B217560028 "RTN","MAGDQR03",1,0) MAGDQR03 ;WOIFO/EdM,MLH,JSL,SAF,BT,DAC,NST - Imaging RPCs for Query/Retrieve ; 20 Jun 2015 1:36 PM "RTN","MAGDQR03",2,0) ;;3.0;IMAGING;**51,54,66,123,118,138,162**;Mar 19, 2002;Build 22;Jun 20 2015 "RTN","MAGDQR03",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGDQR03",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR03",5,0) ;; | Property of the US Government. | "RTN","MAGDQR03",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGDQR03",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGDQR03",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGDQR03",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGDQR03",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGDQR03",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGDQR03",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGDQR03",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGDQR03",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGDQR03",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGDQR03",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR03",17,0) ;; "RTN","MAGDQR03",18,0) Q "RTN","MAGDQR03",19,0) ; "RTN","MAGDQR03",20,0) ; When RESULT^MAGDQR03 is called, the following input parameters "RTN","MAGDQR03",21,0) ; should be properly defined: "RTN","MAGDQR03",22,0) ; TYPE = R(adiology) or C(onsult) "RTN","MAGDQR03",23,0) ; REQ = array of element tags being queried for "RTN","MAGDQR03",24,0) ; RESULT = pointer into results global (#2006.5732) "RTN","MAGDQR03",25,0) ; MAGIEN = pointer into the Image File (#2005) "RTN","MAGDQR03",26,0) ; MAGDFN = pointer into the Patient File (#2) "RTN","MAGDQR03",27,0) ; MAGRORD = second level pointer into the Rad/Nuc Med Patient File (#70) "RTN","MAGDQR03",28,0) ; (Radiology orders only) "RTN","MAGDQR03",29,0) ; MAGINTERP = third level pointer into the Rad/Nuc Med Patient File (#70) "RTN","MAGDQR03",30,0) ; (Radiology orders only) "RTN","MAGDQR03",31,0) ; "RTN","MAGDQR03",32,0) ; This routine contains code to calculate values for DICOM Tags "RTN","MAGDQR03",33,0) ; that can be derived from those two pointers. "RTN","MAGDQR03",34,0) ; All other DICOM Tags are computed in MAGDQR06. "RTN","MAGDQR03",35,0) ; (This routine does the things that are the same for all images. "RTN","MAGDQR03",36,0) ; MAGDQR06 differentiates between Radiology, Consults, and anything else.) "RTN","MAGDQR03",37,0) ; "RTN","MAGDQR03",38,0) RESULT(TYPE,REQ,RESULT,MAGIEN,MAGDUZ,MAGDFN,MAGRORD,MAGINTERP,ERROR,FATAL) ; "RTN","MAGDQR03",39,0) D ; validate input parameters "RTN","MAGDQR03",40,0) . I "^R^C^N^"'[("^"_TYPE_"^") D ERR^MAGDQRUE("Study type (radiology/consult/new DB) not defined") Q "RTN","MAGDQR03",41,0) . I '$G(RESULT) D ERR^MAGDQRUE("Invalid query result set "_RESULT_" specified") Q "RTN","MAGDQR03",42,0) . I $D(MAGIEN),($D(^MAG(2005,MAGIEN)))!($D(^MAGV(2005.64,MAGIEN))) "RTN","MAGDQR03",43,0) . E D ERR^MAGDQRUE("Invalid image ID "_MAGIEN_" specified for result") Q "RTN","MAGDQR03",44,0) . I $D(MAGDFN),$D(^DPT(MAGDFN)) "RTN","MAGDQR03",45,0) . E D ERR^MAGDQRUE("Invalid patient ID "_MAGDFN_" specified for result") Q "RTN","MAGDQR03",46,0) . I TYPE="R",'$G(MAGRORD) D Q "RTN","MAGDQR03",47,0) . . D ERR^MAGDQRUE("Invalid Radiology order number "_MAGRORD_" specified") "RTN","MAGDQR03",48,0) . . Q "RTN","MAGDQR03",49,0) . I TYPE="R",'$G(MAGINTERP) D Q "RTN","MAGDQR03",50,0) . . D ERR^MAGDQRUE("Invalid Radiology interpretation "_MAGINTERP_" specified") "RTN","MAGDQR03",51,0) . . Q "RTN","MAGDQR03",52,0) . Q "RTN","MAGDQR03",53,0) I $D(^TMP("MAG",$J,"ERR")) D ERRLOG^MAGDQRUE Q "RTN","MAGDQR03",54,0) ; "RTN","MAGDQR03",55,0) N E,L,OK,V,X,T "RTN","MAGDQR03",56,0) N SENSEMP ; ----- sensitive/employee flag "RTN","MAGDQR03",57,0) N ACCESSION ; --- accession number "RTN","MAGDQR03",58,0) N SERIESIX ; ---- new series index "RTN","MAGDQR03",59,0) N STUDYIX ; ----- new study index "RTN","MAGDQR03",60,0) N PROCIX ; ------ new procedure index "RTN","MAGDQR03",61,0) N PROCREC ; ----- new procedure record "RTN","MAGDQR03",62,0) N PROCIDTYP ; --- procedure ID type in new DB "RTN","MAGDQR03",63,0) N Y ; ----------- patient DFN "RTN","MAGDQR03",64,0) N DG1 ; --------- inpatient/outpatient indicator "RTN","MAGDQR03",65,0) N DGOPT ; ------- option Name "RTN","MAGDQR03",66,0) N DIC ; --------- DIC variable for the SETLOG entry point "RTN","MAGDQR03",67,0) S SENSEMP=0,OK=1 "RTN","MAGDQR03",68,0) ; "RTN","MAGDQR03",69,0) ; new specs for sens/emp patients 3/20/09 - data will be picked up, but scrubbed "RTN","MAGDQR03",70,0) ; 01/2010: suspend data suppression "RTN","MAGDQR03",71,0) ; 05/2011: log access using supported PIMS entry point "RTN","MAGDQR03",72,0) ; "RTN","MAGDQR03",73,0) S SENSEMP=SENSEMP+($$EMPL^DGSEC4(MAGDFN)=1) ; IA #3646 "RTN","MAGDQR03",74,0) S SENSEMP=SENSEMP+($P($G(^DGSL(38.1,MAGDFN,0)),"^",2)=1) ; IA #767 "RTN","MAGDQR03",75,0) S Y=MAGDFN,DG1="",DGOPT="MAG DICOM QUERY RETRIEVE^MAG CFIND QUERY",DIC(0)="" "RTN","MAGDQR03",76,0) I SENSEMP D SETLOG^DGSEC "RTN","MAGDQR03",77,0) S SENSEMP=0 ; sensitive/employee data suppression to be suspended as of Jan 2010 "RTN","MAGDQR03",78,0) ; increment (static) dummy Study Instance UID if sensitive/employee "RTN","MAGDQR03",79,0) S:SENSEMP ^("DUMMY SIUID")=^TMP("MAG",$J,"DICOMQR","DUMMY SIUID")+1 "RTN","MAGDQR03",80,0) ; "RTN","MAGDQR03",81,0) ; calculate accession number here 2/17/10, moved from Q0080050^MAGDQR06 "RTN","MAGDQR03",82,0) ; "RTN","MAGDQR03",83,0) D:TYPE="R" "RTN","MAGDQR03",84,0) . S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17) ; IA # 1172 "RTN","MAGDQR03",85,0) . S ^TMP("MAG",$J,"ACCESSION")=$P($G(^RARPT(+X,0)),"^",1) ; IA # 1171 "RTN","MAGDQR03",86,0) . Q "RTN","MAGDQR03",87,0) D:TYPE="C" "RTN","MAGDQR03",88,0) . N R2,TIUNUM,CONSIX "RTN","MAGDQR03",89,0) . S R2=$G(^MAG(2005,MAGIEN,2)) Q:R2="" "RTN","MAGDQR03",90,0) . I $P(R2,"^",6)=2006.5839 D Q "RTN","MAGDQR03",91,0) . . S CONSIX=$P(R2,"^",7) "RTN","MAGDQR03",92,0) . . S ^TMP("MAG",$J,"ACCESSION")=$$GMRCACN^MAGDFCNV(CONSIX) "RTN","MAGDQR03",93,0) . . Q "RTN","MAGDQR03",94,0) . I $P(R2,"^",6)=8925 D Q "RTN","MAGDQR03",95,0) . . S TIUNUM=$P(R2,"^",7) Q:'TIUNUM "RTN","MAGDQR03",96,0) . . S CONSIX=$P($G(^TIU(8925,TIUNUM,14)),"^",5) "RTN","MAGDQR03",97,0) . . S:$P(CONSIX,";",2)="GMR(123," ^TMP("MAG",$J,"ACCESSION")=$$GMRCACN^MAGDFCNV($P(CONSIX,";",1)) "RTN","MAGDQR03",98,0) . . Q "RTN","MAGDQR03",99,0) . Q "RTN","MAGDQR03",100,0) D:TYPE="N" "RTN","MAGDQR03",101,0) . S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX "RTN","MAGDQR03",102,0) . S PROCIX=$P($G(^MAGV(2005.62,STUDYIX,6)),"^",1) Q:'PROCIX "RTN","MAGDQR03",103,0) . S PROCREC=$G(^MAGV(2005.61,PROCIX,0)) Q:PROCREC="" "RTN","MAGDQR03",104,0) . S PROCIDTYP=$P(PROCREC,"^",3) "RTN","MAGDQR03",105,0) . S ^TMP("MAG",$J,"ACCESSION")="" "RTN","MAGDQR03",106,0) . D:"^RAD^CON^"[("^"_PROCIDTYP_"^") "RTN","MAGDQR03",107,0) . . S ^TMP("MAG",$J,"ACCESSION")=$P(PROCREC,"^",1) "RTN","MAGDQR03",108,0) . . Q "RTN","MAGDQR03",109,0) . Q "RTN","MAGDQR03",110,0) ; "RTN","MAGDQR03",111,0) ; retrieve element values, indicate unsupported elements "RTN","MAGDQR03",112,0) S T="" F S T=$O(REQ(T)) Q:T="" D "RTN","MAGDQR03",113,0) . S L=$TR(T,",") "RTN","MAGDQR03",114,0) . S E=$TR($E(L,1),"0123456789abcdef","QRSTUVWXYZABCDEF") "RTN","MAGDQR03",115,0) . S $E(L,1)=E S:L'?8UN L="" "RTN","MAGDQR03",116,0) . I L'="",$T(@L)'="" D Q "RTN","MAGDQR03",117,0) . . S L=L_"(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK)" "RTN","MAGDQR03",118,0) . . D @L S V(T)=$G(V(T)) "RTN","MAGDQR03",119,0) . . Q "RTN","MAGDQR03",120,0) . ; unsupported tag <> fatal error "RTN","MAGDQR03",121,0) . D ERR^MAGDQRUE("Cannot calculate value for tag: """_T_""".") S ERROR=1 "RTN","MAGDQR03",122,0) . Q "RTN","MAGDQR03",123,0) ; "RTN","MAGDQR03",124,0) I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE S FATAL=1 G RESULTX "RTN","MAGDQR03",125,0) ; "RTN","MAGDQR03",126,0) G RESULTX:'OK ; don't return result on key mismatch "RTN","MAGDQR03",127,0) ; "RTN","MAGDQR03",128,0) D G RESULTX:'OK ; There must be a valid Study Instance UID "RTN","MAGDQR03",129,0) . N T ; P162 - Removed the new of the local V array to prevent undefined error in MAGDQR13 "RTN","MAGDQR03",130,0) . S T="0020,000D" D Q020000D(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",131,0) . S OK=(V(T)'="") "RTN","MAGDQR03",132,0) . Q "RTN","MAGDQR03",133,0) ; "RTN","MAGDQR03",134,0) D SAVRSLT^MAGDQR13(RESULT,MAGDFN,MAGIEN,.V) "RTN","MAGDQR03",135,0) ; "RTN","MAGDQR03",136,0) RESULTX ; single exit point "RTN","MAGDQR03",137,0) Q "RTN","MAGDQR03",138,0) ; "RTN","MAGDQR03",139,0) COMPARE(TAG,ACTUAL) N LOC,TMP,WILD "RTN","MAGDQR03",140,0) Q:'$G(REQ(TAG)) 1 "RTN","MAGDQR03",141,0) S WILD=$G(REQ(TAG,1)) Q:WILD="" 0 "RTN","MAGDQR03",142,0) Q:$G(ACTUAL)="" 0 "RTN","MAGDQR03",143,0) S LOC(ACTUAL)="" "RTN","MAGDQR03",144,0) Q $$MATCHD(WILD,"LOC(LOOP)","TMP(LOOP)") "RTN","MAGDQR03",145,0) ; "RTN","MAGDQR03",146,0) MATCH1(X,Y) N I,M "RTN","MAGDQR03",147,0) F Q:X="" Q:Y="" D "RTN","MAGDQR03",148,0) . I $E(X,1)=$E(Y,1) S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q "RTN","MAGDQR03",149,0) . I $E(Y,1)="?" S X=$E(X,2,$L(X)),Y=$E(Y,2,$L(Y)) Q "RTN","MAGDQR03",150,0) . I $E(Y,1)="*" D Q:M "RTN","MAGDQR03",151,0) . . I Y="*" S (X,Y)="",M=1 Q "RTN","MAGDQR03",152,0) . . S Y=$E(Y,2,$L(Y)),M=0 "RTN","MAGDQR03",153,0) . . F I=1:1:$L(X) I $$MATCH1($E(X,I,$L(X)),Y) S M=1,X=$E(X,I,$L(X)) Q "RTN","MAGDQR03",154,0) . . Q "RTN","MAGDQR03",155,0) . S X="!",Y="" "RTN","MAGDQR03",156,0) . Q "RTN","MAGDQR03",157,0) S:$TR(Y,"*")="" Y="" Q:X'="" 0 Q:Y'="" 0 "RTN","MAGDQR03",158,0) Q 1 "RTN","MAGDQR03",159,0) ; "RTN","MAGDQR03",160,0) MATCHD(WILDCARD,STRUCTUR,FOUND) N C,LOOP,L1,L9,SEEK,X,Y "RTN","MAGDQR03",161,0) ; -- Scans a structure, "RTN","MAGDQR03",162,0) ; reports entries in @STRUCTUR that match WILDCARD; "RTN","MAGDQR03",163,0) ; the result is reported in local array @FOUND "RTN","MAGDQR03",164,0) S C=0 "RTN","MAGDQR03",165,0) S L1=$P($P(WILDCARD,"?",1),"*",1),L9=L1_"~" "RTN","MAGDQR03",166,0) I L1=WILDCARD D Q C "RTN","MAGDQR03",167,0) . S LOOP=L1 "RTN","MAGDQR03",168,0) . I $D(@STRUCTUR) S @FOUND="",C=C+1 Q "RTN","MAGDQR03",169,0) . Q "RTN","MAGDQR03",170,0) S LOOP=L1 F D S LOOP=$O(@STRUCTUR) Q:LOOP="" Q:LOOP]]L9 "RTN","MAGDQR03",171,0) . Q:LOOP="" Q:'$D(@STRUCTUR) "RTN","MAGDQR03",172,0) . Q:'$$MATCH1(LOOP,WILDCARD) "RTN","MAGDQR03",173,0) . S @FOUND="",C=C+1 "RTN","MAGDQR03",174,0) . Q "RTN","MAGDQR03",175,0) Q C "RTN","MAGDQR03",176,0) ; "RTN","MAGDQR03",177,0) Q0080018(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Image Instance UID "RTN","MAGDQR03",178,0) ; sensitive/employee? "RTN","MAGDQR03",179,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",180,0) . S V(T)="1.2.840.113754.2.1.3.1.1.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID")) "RTN","MAGDQR03",181,0) . Q "RTN","MAGDQR03",182,0) ; no "RTN","MAGDQR03",183,0) N SOPUID "RTN","MAGDQR03",184,0) S V(T)="" "RTN","MAGDQR03",185,0) D:MAGIEN'="" "RTN","MAGDQR03",186,0) . I (TYPE="R")!(TYPE="C") D Q "RTN","MAGDQR03",187,0) . . S V(T)=$P($G(^MAG(2005,MAGIEN,"PACS")),"^",1) "RTN","MAGDQR03",188,0) . . S SOPUID=$P($G(^MAG(2005,MAGIEN,"SOP")),"^",2) "RTN","MAGDQR03",189,0) . . S:SOPUID'="" V(T)=SOPUID "RTN","MAGDQR03",190,0) . . Q "RTN","MAGDQR03",191,0) . I TYPE="N" D Q "RTN","MAGDQR03",192,0) . . S V(T)=$P($G(^MAGV(2005.64,MAGIEN,0)),"^",1) "RTN","MAGDQR03",193,0) . . Q "RTN","MAGDQR03",194,0) . Q "RTN","MAGDQR03",195,0) Q "RTN","MAGDQR03",196,0) ; "RTN","MAGDQR03",197,0) Q0080020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Date "RTN","MAGDQR03",198,0) ; sensitive/employee? "RTN","MAGDQR03",199,0) N STUDYIX "RTN","MAGDQR03",200,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",201,0) . N I,REQDT S I=$O(REQ(T,"")) S:I REQDT=$TR($P($G(REQ(T,I)),"-",1),"*") "RTN","MAGDQR03",202,0) . S V(T)=$S($G(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000) "RTN","MAGDQR03",203,0) . Q "RTN","MAGDQR03",204,0) ; no "RTN","MAGDQR03",205,0) S V(T)="" "RTN","MAGDQR03",206,0) D:MAGIEN "RTN","MAGDQR03",207,0) . I (TYPE="R")!(TYPE="C") D Q "RTN","MAGDQR03",208,0) . . S V(T)=$P($G(^MAG(2005,MAGIEN,2)),"^",5) "RTN","MAGDQR03",209,0) . . Q "RTN","MAGDQR03",210,0) . I TYPE="N" D Q "RTN","MAGDQR03",211,0) . . S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX "RTN","MAGDQR03",212,0) . . S V(T)=$P($G(^MAGV(2005.62,STUDYIX,2)),"^",1) "RTN","MAGDQR03",213,0) . . Q "RTN","MAGDQR03",214,0) . Q "RTN","MAGDQR03",215,0) S:V(T) V(T)=V(T)\1+17000000 "RTN","MAGDQR03",216,0) Q "RTN","MAGDQR03",217,0) ; "RTN","MAGDQR03",218,0) Q0080030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study Time "RTN","MAGDQR03",219,0) ; sensitive/employee? "RTN","MAGDQR03",220,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",221,0) . N I,REQTM S I=$O(REQ(T,"")) S:I REQTM=$TR($P($G(REQ(T,I)),"-",1),"*") "RTN","MAGDQR03",222,0) . S V(T)=$S($G(REQTM)?6N:REQTM,1:$E($P($$NOW^XLFDT,".",2)_"000000",1,6)) "RTN","MAGDQR03",223,0) . Q "RTN","MAGDQR03",224,0) ; no "RTN","MAGDQR03",225,0) S V(T)="" "RTN","MAGDQR03",226,0) D:MAGIEN "RTN","MAGDQR03",227,0) . I (TYPE="R")!(TYPE="C") D Q "RTN","MAGDQR03",228,0) . . S V(T)=$P($G(^MAG(2005,MAGIEN,2)),"^",5) "RTN","MAGDQR03",229,0) . . Q "RTN","MAGDQR03",230,0) . I TYPE="N" D Q "RTN","MAGDQR03",231,0) . . S STUDYIX=$$STUDYIX^MAGUE004(MAGIEN) Q:'STUDYIX "RTN","MAGDQR03",232,0) . . S V(T)=$P($G(^MAGV(2005.62,STUDYIX,2)),"^",1) "RTN","MAGDQR03",233,0) . . Q "RTN","MAGDQR03",234,0) . Q "RTN","MAGDQR03",235,0) S:V(T) V(T)=$TR($J("."_$P(V(T),".",2)*1E6,6)," ",0) "RTN","MAGDQR03",236,0) Q "RTN","MAGDQR03",237,0) ; "RTN","MAGDQR03",238,0) Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Accession Number "RTN","MAGDQR03",239,0) D Q0080050^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",240,0) Q "RTN","MAGDQR03",241,0) ; "RTN","MAGDQR03",242,0) Q0100010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient's Name "RTN","MAGDQR03",243,0) ; No IA needed, PIMS 5.3 "RTN","MAGDQR03",244,0) S V(T)=$S('SENSEMP:$P($G(^DPT(MAGDFN,0)),"^",1),1:"IMAGPATIENT,SENSITIVE") "RTN","MAGDQR03",245,0) S V(T)=$$VA2DCM^MAGDQR01(V(T)) "RTN","MAGDQR03",246,0) Q "RTN","MAGDQR03",247,0) ; "RTN","MAGDQR03",248,0) Q0100020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Patient ID "RTN","MAGDQR03",249,0) N DFN,VA "RTN","MAGDQR03",250,0) S DFN=MAGDFN "RTN","MAGDQR03",251,0) D PID^VADPT6 ; ICR supported #10062 "RTN","MAGDQR03",252,0) S V(T)=$TR(VA("PID"),"-") "RTN","MAGDQR03",253,0) Q "RTN","MAGDQR03",254,0) ; "RTN","MAGDQR03",255,0) Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study ID "RTN","MAGDQR03",256,0) D Q0200010^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",257,0) Q "RTN","MAGDQR03",258,0) ; "RTN","MAGDQR03",259,0) Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID "RTN","MAGDQR03",260,0) D Q020000D^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow "RTN","MAGDQR03",261,0) Q "RTN","MAGDQR03",262,0) ; "RTN","MAGDQR03",263,0) Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID "RTN","MAGDQR03",264,0) Q ; not for study level query "RTN","MAGDQR03",265,0) D Q020000E^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow "RTN","MAGDQR03",266,0) Q "RTN","MAGDQR03",267,0) ; "RTN","MAGDQR03",268,0) Q0080052(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Query Level "RTN","MAGDQR03",269,0) N I "RTN","MAGDQR03",270,0) S I=$O(REQ(T,"")),V(T)="" "RTN","MAGDQR03",271,0) S:I'="" V(T)=$G(REQ(T,I)) "RTN","MAGDQR03",272,0) Q "RTN","MAGDQR03",273,0) ; "RTN","MAGDQR03",274,0) Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study "RTN","MAGDQR03",275,0) D Q0080061^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow "RTN","MAGDQR03",276,0) Q "RTN","MAGDQR03",277,0) ; "RTN","MAGDQR03",278,0) Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O SOP Classes in Study "RTN","MAGDQR03",279,0) D Q0080062^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",280,0) Q "RTN","MAGDQR03",281,0) ; "RTN","MAGDQR03",282,0) Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Referring Physician's Name "RTN","MAGDQR03",283,0) D Q0080090^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",284,0) Q "RTN","MAGDQR03",285,0) ; "RTN","MAGDQR03",286,0) Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Study Description "RTN","MAGDQR03",287,0) D Q0081030^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",288,0) Q "RTN","MAGDQR03",289,0) ; "RTN","MAGDQR03",290,0) Q0081032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Procedure Code Sequence "RTN","MAGDQR03",291,0) Q "RTN","MAGDQR03",292,0) ; "RTN","MAGDQR03",293,0) Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Value "RTN","MAGDQR03",294,0) D Q0080100^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",295,0) Q "RTN","MAGDQR03",296,0) ; "RTN","MAGDQR03",297,0) Q0080102(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Designator "RTN","MAGDQR03",298,0) S V("0008,1030",1,T)="C4" "RTN","MAGDQR03",299,0) Q "RTN","MAGDQR03",300,0) ; "RTN","MAGDQR03",301,0) Q0080103(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Coding Scheme Version "RTN","MAGDQR03",302,0) S V("0008,1030",1,T)=4 "RTN","MAGDQR03",303,0) Q "RTN","MAGDQR03",304,0) ; "RTN","MAGDQR03",305,0) Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Meaning "RTN","MAGDQR03",306,0) D Q0080104^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",307,0) Q "RTN","MAGDQR03",308,0) ; "RTN","MAGDQR03",309,0) Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Name of Physician(s) Reading Study "RTN","MAGDQR03",310,0) D Q0081060^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",311,0) Q "RTN","MAGDQR03",312,0) ; "RTN","MAGDQR03",313,0) Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Admitting Diagnosis Description "RTN","MAGDQR03",314,0) D Q0081080^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",315,0) Q "RTN","MAGDQR03",316,0) ; "RTN","MAGDQR03",317,0) Q0100021(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Issuer of Patient ID "RTN","MAGDQR03",318,0) S V(T)="USSSA" "RTN","MAGDQR03",319,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",320,0) Q "RTN","MAGDQR03",321,0) ; "RTN","MAGDQR03",322,0) Q0100030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Date "RTN","MAGDQR03",323,0) ; sensitive/employee? "RTN","MAGDQR03",324,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",325,0) . N I,REQDT S I=$O(REQ(T,"")) S:I REQDT=$TR($P($G(REQ(T,I)),"-",1),"*") "RTN","MAGDQR03",326,0) . S V(T)=$S($G(REQDT)?8N:REQDT,1:$$DT^XLFDT+17000000) "RTN","MAGDQR03",327,0) . Q "RTN","MAGDQR03",328,0) ; no "RTN","MAGDQR03",329,0) S V(T)=$P($G(^DPT(MAGDFN,0)),"^",3)\1+17000000 "RTN","MAGDQR03",330,0) I $E(V(T),5,6)="00" S V(T)="" ; invalid month for DICOM "RTN","MAGDQR03",331,0) I $E(V(T),7,8)="00" S V(T)="" ; invalid year for DICOM "RTN","MAGDQR03",332,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",333,0) Q "RTN","MAGDQR03",334,0) ; "RTN","MAGDQR03",335,0) Q0100032(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Birth Time "RTN","MAGDQR03",336,0) ; sensitive/employee? "RTN","MAGDQR03",337,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",338,0) . N I,REQTM S I=$O(REQ(T,"")) S:I REQTM=$TR($P($G(REQ(T,I)),"-",1),"*") "RTN","MAGDQR03",339,0) . S V(T)=$S($G(REQTM)?6N:REQTM,1:$E($P($$NOW^XLFDT,".",2)_"000000",1,6)) "RTN","MAGDQR03",340,0) . Q "RTN","MAGDQR03",341,0) ; no "RTN","MAGDQR03",342,0) S V(T)=$TR($J("."_$P($P($G(^DPT(MAGDFN,0)),"^",3),".",2)*1E6,6)," ",0) "RTN","MAGDQR03",343,0) S:V(T)="000000" V(T)="" ; no time on file "RTN","MAGDQR03",344,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",345,0) Q "RTN","MAGDQR03",346,0) ; "RTN","MAGDQR03",347,0) Q0100040(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Sex "RTN","MAGDQR03",348,0) ; sensitive/employee? "RTN","MAGDQR03",349,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",350,0) . N I S I=$O(REQ(T,"")) S V(T)=$S(I:$S($G(REQ(T,I))]"":REQ(T,I),1:"O"),1:"O") "RTN","MAGDQR03",351,0) . Q "RTN","MAGDQR03",352,0) ; no "RTN","MAGDQR03",353,0) S V(T)=$P($G(^DPT(MAGDFN,0)),"^",2) "RTN","MAGDQR03",354,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",355,0) Q "RTN","MAGDQR03",356,0) ; "RTN","MAGDQR03",357,0) Q0101000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient IDs "RTN","MAGDQR03",358,0) ; sensitive/employee? "RTN","MAGDQR03",359,0) I SENSEMP S V(T)="000001234" Q ; yes, scrub "RTN","MAGDQR03",360,0) ; no "RTN","MAGDQR03",361,0) N DFN,I,VA,VADPT "RTN","MAGDQR03",362,0) S DFN=MAGDFN D DEM^VADPT ; Supported IA (#10061) "RTN","MAGDQR03",363,0) S X=$P(^DPT(DFN,0),"^",9) S:X'="" DFN(X)="" "RTN","MAGDQR03",364,0) S:$G(VA("PID"))'="" DFN(VA("PID"))="" "RTN","MAGDQR03",365,0) S:$G(VA("BID"))'="" DFN(VA("BID"))="" "RTN","MAGDQR03",366,0) I $T(GETICN^MPIF001)'="" S X=$$GETICN^MPIF001(DFN) S:+X DFN(X)="" ; Supported IA (#2701) "RTN","MAGDQR03",367,0) S I=0,X="" F S X=$O(DFN(X)) Q:X="" S I=I+1,V(T,I)=X "RTN","MAGDQR03",368,0) ;;;S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",369,0) Q "RTN","MAGDQR03",370,0) ; "RTN","MAGDQR03",371,0) Q0101001(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Other Patient Names "RTN","MAGDQR03",372,0) ; sensitive/employee? "RTN","MAGDQR03",373,0) I SENSEMP S V(T)="IMAGPATIENT,SENSITIVE" Q ; yes, scrub "RTN","MAGDQR03",374,0) ; no "RTN","MAGDQR03",375,0) N D1,I "RTN","MAGDQR03",376,0) S (I,D1)=0 F S D1=$O(^DPT(MAGDFN,0.01,D1)) Q:'D1 D "RTN","MAGDQR03",377,0) . S X=$P($G(^DPT(MAGDFN,0.01,D1,0)),"^",1) "RTN","MAGDQR03",378,0) . S:X'="" I=I+1,V(T,I)=X "RTN","MAGDQR03",379,0) . Q "RTN","MAGDQR03",380,0) ;;;S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",381,0) Q "RTN","MAGDQR03",382,0) ; "RTN","MAGDQR03",383,0) Q0101010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Age "RTN","MAGDQR03",384,0) ; sensitive/employee? "RTN","MAGDQR03",385,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",386,0) . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"") "RTN","MAGDQR03",387,0) . Q "RTN","MAGDQR03",388,0) ; no "RTN","MAGDQR03",389,0) N DOB,FROM,YEARS "RTN","MAGDQR03",390,0) S DOB=$P($G(^DPT(MAGDFN,0)),"^",3) "RTN","MAGDQR03",391,0) S FROM=$P($G(^DPT(MAGDFN,.35)),"^",1) S:'FROM FROM=DT "RTN","MAGDQR03",392,0) S YEARS=$E(FROM,1,3)-$E(DOB,1,3) "RTN","MAGDQR03",393,0) S:$E(FROM,4,7)<$E(DOB,4,7) YEARS=YEARS-1 "RTN","MAGDQR03",394,0) S V(T)=($P($J(YEARS/1000,0,3),".",2))_"Y" "RTN","MAGDQR03",395,0) ;;;S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",396,0) Q "RTN","MAGDQR03",397,0) ; "RTN","MAGDQR03",398,0) Q0101020(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Size "RTN","MAGDQR03",399,0) ; sensitive/employee? "RTN","MAGDQR03",400,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",401,0) . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"") "RTN","MAGDQR03",402,0) . Q "RTN","MAGDQR03",403,0) ; no "RTN","MAGDQR03",404,0) S V(T)=$P($G(^DPT(MAGDFN,57)),"^",1) ; height in cm - field not populated "RTN","MAGDQR03",405,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",406,0) Q "RTN","MAGDQR03",407,0) ; "RTN","MAGDQR03",408,0) Q0101030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient's Weight "RTN","MAGDQR03",409,0) ; sensitive/employee? "RTN","MAGDQR03",410,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",411,0) . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"") "RTN","MAGDQR03",412,0) . Q "RTN","MAGDQR03",413,0) ; no "RTN","MAGDQR03",414,0) S V(T)=$P($G(^DPT(MAGDFN,57)),"^",2) ; weight in kg - field not populated "RTN","MAGDQR03",415,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",416,0) Q "RTN","MAGDQR03",417,0) ; "RTN","MAGDQR03",418,0) Q0102160(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Ethnic Group "RTN","MAGDQR03",419,0) ; sensitive/employee? "RTN","MAGDQR03",420,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",421,0) . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"") "RTN","MAGDQR03",422,0) . Q "RTN","MAGDQR03",423,0) ; no "RTN","MAGDQR03",424,0) S V(T)=$P($G(^DPT(MAGDFN,0)),"^",6) "RTN","MAGDQR03",425,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",426,0) Q "RTN","MAGDQR03",427,0) ; "RTN","MAGDQR03",428,0) Q0102180(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Occupation "RTN","MAGDQR03",429,0) ; sensitive/employee? "RTN","MAGDQR03",430,0) I SENSEMP D Q ; yes, scrub "RTN","MAGDQR03",431,0) . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"") "RTN","MAGDQR03",432,0) . Q "RTN","MAGDQR03",433,0) ; no "RTN","MAGDQR03",434,0) S V(T)=$P($G(^DPT(MAGDFN,0)),"^",7) "RTN","MAGDQR03",435,0) S:'$$COMPARE(T,V(T)) OK=0 "RTN","MAGDQR03",436,0) Q "RTN","MAGDQR03",437,0) ; "RTN","MAGDQR03",438,0) Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Additional Patient History "RTN","MAGDQR03",439,0) D Q01021B0^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",440,0) Q "RTN","MAGDQR03",441,0) ; "RTN","MAGDQR03",442,0) Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient Comments "RTN","MAGDQR03",443,0) D Q0104000^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",444,0) Q "RTN","MAGDQR03",445,0) ; "RTN","MAGDQR03",446,0) Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series "RTN","MAGDQR03",447,0) D Q0201206^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow "RTN","MAGDQR03",448,0) Q "RTN","MAGDQR03",449,0) ; "RTN","MAGDQR03",450,0) Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances "RTN","MAGDQR03",451,0) D Q0201208^MAGDQR09(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) ; overflow "RTN","MAGDQR03",452,0) Q "RTN","MAGDQR03",453,0) ; "RTN","MAGDQR03",454,0) U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Interpretation Author "RTN","MAGDQR03",455,0) D U008010C^MAGDQR06(TYPE,.REQ,.V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,.OK) "RTN","MAGDQR03",456,0) Q "RTN","MAGDQR72") 0^8^B8819008 "RTN","MAGDQR72",1,0) MAGDQR72 ;WOIFO/MLH,DAC - Imaging RPCs for Query/Retrieve - acc# scan for rad recs (old DB) ; 22 Dec 2015 3:07 PM "RTN","MAGDQR72",2,0) ;;3.0;IMAGING;**118,162**;Mar 19, 2002;Build 22;Dec 22, 2015 "RTN","MAGDQR72",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGDQR72",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR72",5,0) ;; | Property of the US Government. | "RTN","MAGDQR72",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGDQR72",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGDQR72",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGDQR72",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGDQR72",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGDQR72",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGDQR72",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGDQR72",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGDQR72",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGDQR72",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGDQR72",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGDQR72",17,0) ;; "RTN","MAGDQR72",18,0) Q "RTN","MAGDQR72",19,0) ; called by MAGDQR07 "RTN","MAGDQR72",20,0) ; "RTN","MAGDQR72",21,0) ACCRAD(REQ,T,P,ACC) ; scan old structure for Radiology Related Images (including site-specific accession numbers) "RTN","MAGDQR72",22,0) N TMPQ,I,V,MAGD0,MAGD1,MAGD2,RPTIX "RTN","MAGDQR72",23,0) S TMPQ=$NA(^TMP("MAG",$J,"QR")) K @TMPQ@(5) "RTN","MAGDQR72",24,0) S I=$$MATCHD^MAGDQR03(REQ(T,P),"^RADPT(""ADC"",LOOP)","@TMPQ@(5,LOOP)") "RTN","MAGDQR72",25,0) S I=$$MATCHD^MAGDQR03(REQ(T,P),"^RADPT(""ADC1"",LOOP)","@TMPQ@(5,LOOP)") "RTN","MAGDQR72",26,0) S V="" F S V=$O(@TMPQ@(5,V)) Q:V="" D "RTN","MAGDQR72",27,0) . S MAGD0="" F S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0="" D "RTN","MAGDQR72",28,0) . . S MAGD1="" F S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1="" D "RTN","MAGDQR72",29,0) . . . S MAGD2="" F S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2="" D "RTN","MAGDQR72",30,0) . . . . S RPTIX=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) Q:'RPTIX ; no report on file "RTN","MAGDQR72",31,0) . . . . Q:'$D(^RARPT(RPTIX,2005)) ; report doesn't have images in old structure "RTN","MAGDQR72",32,0) . . . . S @TMPQ@(6,"R^"_MAGD0_"^"_MAGD1_"^"_MAGD2)="",ACC=1 "RTN","MAGDQR72",33,0) . . . . Q "RTN","MAGDQR72",34,0) . . . Q "RTN","MAGDQR72",35,0) . . Q "RTN","MAGDQR72",36,0) . Q "RTN","MAGDQR72",37,0) ; P162 DAC - Match site specific accession numbers - ADC1 index "RTN","MAGDQR72",38,0) S V="" F S V=$O(@TMPQ@(5,V)) Q:V="" D "RTN","MAGDQR72",39,0) . S MAGD0="" F S MAGD0=$O(^RADPT("ADC1",V,MAGD0)) Q:MAGD0="" D "RTN","MAGDQR72",40,0) . . S MAGD1="" F S MAGD1=$O(^RADPT("ADC1",V,MAGD0,MAGD1)) Q:MAGD1="" D "RTN","MAGDQR72",41,0) . . . S MAGD2="" F S MAGD2=$O(^RADPT("ADC1",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2="" D "RTN","MAGDQR72",42,0) . . . . S RPTIX=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) Q:'RPTIX ; no report on file "RTN","MAGDQR72",43,0) . . . . Q:'$D(^RARPT(RPTIX,2005)) ; report doesn't have images in old structure "RTN","MAGDQR72",44,0) . . . . S @TMPQ@(6,"R^"_MAGD0_"^"_MAGD1_"^"_MAGD2)="",ACC=1 "RTN","MAGDQR72",45,0) . . . . Q "RTN","MAGDQR72",46,0) . . . Q "RTN","MAGDQR72",47,0) . . Q "RTN","MAGDQR72",48,0) . Q "RTN","MAGDQR72",49,0) Q "RTN","MAGDRPCA") 0^2^B80785193 "RTN","MAGDRPCA",1,0) MAGDRPCA ;WOIFO/PMK/MLS/SG/DAC/JSL - Imaging RPCs for Importer ; 26 Jan 2016 7:03 PM "RTN","MAGDRPCA",2,0) ;;3.0;IMAGING;**53,123,118,142,138,162**;Mar 19, 2002;Build 22 "RTN","MAGDRPCA",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGDRPCA",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGDRPCA",5,0) ;; | Property of the US Government. | "RTN","MAGDRPCA",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGDRPCA",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGDRPCA",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGDRPCA",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGDRPCA",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGDRPCA",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGDRPCA",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGDRPCA",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGDRPCA",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGDRPCA",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGDRPCA",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGDRPCA",17,0) ;; "RTN","MAGDRPCA",18,0) Q "RTN","MAGDRPCA",19,0) ; "RTN","MAGDRPCA",20,0) CHECKUID(OUT,UIDLIST,LEVEL) ; RPC = MAG DICOM IMPORTER CHECK UIDS "RTN","MAGDRPCA",21,0) N COUNT,DUPCOUNT,DUPUID,ERROR,I,MAG0,MAGIEN,OBJECT "RTN","MAGDRPCA",22,0) I '$D(UIDLIST) S OUT(1)="-1,A list of UIDs must be supplied." Q "RTN","MAGDRPCA",23,0) I '$D(LEVEL) S OUT(1)="-2,Study or SOP Instance level must be specified." Q "RTN","MAGDRPCA",24,0) I LEVEL'="STUDY",LEVEL'="SOP" D Q "RTN","MAGDRPCA",25,0) . S OUT(1)="-3,Level must be either ""STUDY"" or ""SOP -- """ "RTN","MAGDRPCA",26,0) . S OUT(1)=OUT(1)_"the value """_LEVEL_""" was specified." "RTN","MAGDRPCA",27,0) . Q "RTN","MAGDRPCA",28,0) S COUNT=$G(UIDLIST(1)),ERROR=0 "RTN","MAGDRPCA",29,0) I COUNT'>0 S OUT(1)="-4,Count of UIDs in list must be greater than zero." Q "RTN","MAGDRPCA",30,0) F I=2:1:COUNT+1 S UID=UIDLIST(I) D "RTN","MAGDRPCA",31,0) . S MAGIEN=$O(^MAG(2005,"P",UID,"")) "RTN","MAGDRPCA",32,0) . I MAGIEN D "RTN","MAGDRPCA",33,0) . . S MAG0=$G(^MAG(2005,MAGIEN,0)),OBJECT=$P(MAG0,"^",6),DFN=$P(MAG0,"^",7) "RTN","MAGDRPCA",34,0) . . I LEVEL="STUDY" D ; Study Instance UID "RTN","MAGDRPCA",35,0) . . . I OBJECT'=11 D Q "RTN","MAGDRPCA",36,0) . . . . S OUT(I)="-5,Study Instance UID not pointing to an XRAY Group -- " "RTN","MAGDRPCA",37,0) . . . . S OUT(I)=OUT(I)_"MAGIEN = "_MAGIEN,ERROR=ERROR+1 "RTN","MAGDRPCA",38,0) . . . . Q "RTN","MAGDRPCA",39,0) . . . S OUT(I)=$$LOOKUP1(MAGIEN)_"^"_$$DUPUID(LEVEL,UID) "RTN","MAGDRPCA",40,0) . . . Q "RTN","MAGDRPCA",41,0) . . E D ; SOP Instance UID "RTN","MAGDRPCA",42,0) . . . I OBJECT'=3,OBJECT'=100 D Q "RTN","MAGDRPCA",43,0) . . . . S OUT(I)="-6,SOP Instance UID not pointing to an XRAY or a DICOM object -- " "RTN","MAGDRPCA",44,0) . . . . S OUT(I)=OUT(I)_"MAGIEN = "_MAGIEN,ERROR=ERROR+1 "RTN","MAGDRPCA",45,0) . . . . Q "RTN","MAGDRPCA",46,0) . . . S OUT(I)=$$LOOKUP1(MAGIEN)_"^"_$$DUPUID(LEVEL,UID) "RTN","MAGDRPCA",47,0) . . . Q "RTN","MAGDRPCA",48,0) . . Q "RTN","MAGDRPCA",49,0) . E S OUT(I)="" "RTN","MAGDRPCA",50,0) . Q "RTN","MAGDRPCA",51,0) I ERROR>1 S OUT(1)="-100,There were "_ERROR_" database inconsistency errors detected. Look at returned data." "RTN","MAGDRPCA",52,0) E I ERROR=1 S OUT(1)="-100,A database inconsistency error was detected. Look at returned data." "RTN","MAGDRPCA",53,0) E S OUT(1)=COUNT "RTN","MAGDRPCA",54,0) Q "RTN","MAGDRPCA",55,0) ; "RTN","MAGDRPCA",56,0) DUPUID(LEVEL,UID) ; return a list of ^MAG(2005) entries with dup uids "RTN","MAGDRPCA",57,0) N COUNT,DFN,DUPUID,I,MAG0,MAG2,MAGIEN,PARENT,RETURN,XREF,XREFLIST "RTN","MAGDRPCA",58,0) S MAGIEN="" "RTN","MAGDRPCA",59,0) F S MAGIEN=$O(^MAG(2005,"P",UID,MAGIEN)) Q:MAGIEN="" D "RTN","MAGDRPCA",60,0) . S MAG0=$G(^MAG(2005,MAGIEN,0)),DFN=$P(MAG0,"^",7) "RTN","MAGDRPCA",61,0) . S MAG2=$G(^MAG(2005,MAGIEN,2)) "RTN","MAGDRPCA",62,0) . S PARENT="" F I=6,7,8,10 S PARENT=PARENT_"^"_$P(MAG2,"^",I) "RTN","MAGDRPCA",63,0) . S DUPUID(MAGIEN)=DFN_PARENT "RTN","MAGDRPCA",64,0) . S XREFLIST(DFN_PARENT,MAGIEN)="" "RTN","MAGDRPCA",65,0) . Q "RTN","MAGDRPCA",66,0) . ; remove duplicate Study UIDs for different groups for the same study "RTN","MAGDRPCA",67,0) I LEVEL="STUDY" D "RTN","MAGDRPCA",68,0) . S COUNT=0,XREF="" "RTN","MAGDRPCA",69,0) . F S XREF=$O(XREFLIST(XREF)) Q:XREF="" S COUNT=COUNT+1 "RTN","MAGDRPCA",70,0) . I COUNT=1 K DUPUID "RTN","MAGDRPCA",71,0) . Q "RTN","MAGDRPCA",72,0) S COUNT=0,(MAGIEN,RETURN)="" "RTN","MAGDRPCA",73,0) F S MAGIEN=$O(DUPUID(MAGIEN)) Q:MAGIEN="" D "RTN","MAGDRPCA",74,0) . S RETURN=RETURN_"^"_MAGIEN,COUNT=COUNT+1 "RTN","MAGDRPCA",75,0) . Q "RTN","MAGDRPCA",76,0) Q COUNT_RETURN "RTN","MAGDRPCA",77,0) ; "RTN","MAGDRPCA",78,0) LOOKUP(OUT,MAGIEN) ; RPC = MAG DICOM IMPORTER LOOKUP "RTN","MAGDRPCA",79,0) S OUT=$$LOOKUP1(MAGIEN) "RTN","MAGDRPCA",80,0) Q "RTN","MAGDRPCA",81,0) ; "RTN","MAGDRPCA",82,0) LOOKUP1(MAGIEN) ; patient and accession number lookup "RTN","MAGDRPCA",83,0) N DFN,I,MAG0,MAG2,NUMBER,OUT,TMP,VA,VADM,X "RTN","MAGDRPCA",84,0) S MAG0=$G(^MAG(2005,MAGIEN,0)),MAG2=$G(^(2)) "RTN","MAGDRPCA",85,0) S DFN=+$P(MAG0,"^",7) "RTN","MAGDRPCA",86,0) D ; Protect variables that are referenced by the DEM^VADPT "RTN","MAGDRPCA",87,0) . N A,I,J,K,K1,NC,NF,NQ,T,VAHOW,VAPTYP,VAROOT,X "RTN","MAGDRPCA",88,0) . D DEM^VADPT ; Supported IA (#10061) "RTN","MAGDRPCA",89,0) . Q "RTN","MAGDRPCA",90,0) S X="^"_DFN ; piece 1 is for an error message "RTN","MAGDRPCA",91,0) S X=X_"^"_VADM(1) ; patient name "RTN","MAGDRPCA",92,0) S X=X_"^"_VA("PID") ; patient id "RTN","MAGDRPCA",93,0) S TMP=$S(VADM(3)>0:17000000+VADM(3),1:"-1,Invalid date of birth") "RTN","MAGDRPCA",94,0) S X=X_"^"_TMP ; Patient DOB "RTN","MAGDRPCA",95,0) S X=X_"^"_$P(VADM(5),"^",1) ; patient sex "RTN","MAGDRPCA",96,0) ; $$GETICN^MPIF001 can return error code and message separated "RTN","MAGDRPCA",97,0) ; by "^". If this happens, the "^" is replaced by comma. "RTN","MAGDRPCA",98,0) S TMP=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI") ; Supported IA (#2701) "RTN","MAGDRPCA",99,0) S X=X_"^"_$TR(TMP,"^",",") ; ICN "RTN","MAGDRPCA",100,0) I $P(MAG2,"^",6)=2006.5839 D ; temporary consult association "RTN","MAGDRPCA",101,0) . N ACNUMB,GMRCIEN,MODIFIER,PROCNAME,STUDYDAT "RTN","MAGDRPCA",102,0) . S GMRCIEN=$P(MAG2,"^",7),ACNUMB=$$GMRCACN^MAGDFCNV(GMRCIEN) "RTN","MAGDRPCA",103,0) . S TMP=$$GET1^DIQ(123,GMRCIEN,.01,"I")\1 "RTN","MAGDRPCA",104,0) . S STUDYDAT=$S(TMP>0:17000000+TMP,1:"-1,Invalid study date") "RTN","MAGDRPCA",105,0) . S PROCNAME=$$GET1^DIQ(123,GMRCIEN,1) ; TO SERVICE "RTN","MAGDRPCA",106,0) . S MODIFIER=$$GET1^DIQ(123,GMRCIEN,4) ; PROCEDURE "RTN","MAGDRPCA",107,0) . S X=X_"^"_ACNUMB_"^"_STUDYDAT_"^"_PROCNAME_"^"_MODIFIER "RTN","MAGDRPCA",108,0) . Q "RTN","MAGDRPCA",109,0) E D ; regular association "RTN","MAGDRPCA",110,0) . S NUMBER="`"_MAGIEN D IENLOOK^MAGDRPC9 ; lookup accession number "RTN","MAGDRPCA",111,0) . I OUT(1)<0 S X=OUT(1)_" detected in IENLOOK^MAGDRPC9" "RTN","MAGDRPCA",112,0) . E S X=X_"^"_$P(OUT(2),"^",4,7) ; accession number, study date, procedure "RTN","MAGDRPCA",113,0) . Q "RTN","MAGDRPCA",114,0) Q X "RTN","MAGDRPCA",115,0) ; "RTN","MAGDRPCA",116,0) ; "RTN","MAGDRPCA",117,0) ; "RTN","MAGDRPCA",118,0) GETDFN(OUT,ICN) ; RPC = MAG DICOM GET DFN "RTN","MAGDRPCA",119,0) S OUT=$S($T(GETDFN^MPIF001)'="":$$GETDFN^MPIF001(ICN),1:"-1^NO MPI") ; Supported IA (#2701) "RTN","MAGDRPCA",120,0) Q "RTN","MAGDRPCA",121,0) ; "RTN","MAGDRPCA",122,0) ; "RTN","MAGDRPCA",123,0) ; "RTN","MAGDRPCA",124,0) ACNUMB(OUT,ACNUMB) ; RPC = MAG DICOM GET RAD INFO BY ACN "RTN","MAGDRPCA",125,0) N RADFN,RADTI,LIST,STATUS "RTN","MAGDRPCA",126,0) S STATUS=$$ACCFIND^RAAPI(ACNUMB,.LIST) ; Private IA (#5020) "RTN","MAGDRPCA",127,0) I STATUS<0 S OUT=STATUS Q "RTN","MAGDRPCA",128,0) S OUT=STATUS_"^"_LIST(1) "RTN","MAGDRPCA",129,0) ; add the imaging location as 5th piece of the results "RTN","MAGDRPCA",130,0) S RADFN=$P(LIST(1),"^",1),RADTI=$P(LIST(1),"^",2) "RTN","MAGDRPCA",131,0) S OUT=OUT_"^"_$$GET1^DIQ(79.1,$P(^RADPT(RADFN,"DT",RADTI,0),"^",4),.01) "RTN","MAGDRPCA",132,0) Q "RTN","MAGDRPCA",133,0) ; "RTN","MAGDRPCA",134,0) ; "RTN","MAGDRPCA",135,0) ; "RTN","MAGDRPCA",136,0) DELETE(OUT,IMAGEUID,MACHID,FILEPATH) ; RPC = MAG DICOM IMPORTER DELETE "RTN","MAGDRPCA",137,0) S OUT=$$DELETE^MAGDIR8R(IMAGEUID,MACHID,FILEPATH) "RTN","MAGDRPCA",138,0) Q "RTN","MAGDRPCA",139,0) ; "RTN","MAGDRPCA",140,0) ;***** RETURNS THE LIST OF RADIOLOGY PROCEDURES "RTN","MAGDRPCA",141,0) ; RPC: MAG DICOM RADIOLOGY PROCEDURES "RTN","MAGDRPCA",142,0) ; "RTN","MAGDRPCA",143,0) ; .ARRAY Reference to a local variable where results "RTN","MAGDRPCA",144,0) ; are returned to. "RTN","MAGDRPCA",145,0) ; "RTN","MAGDRPCA",146,0) ; DIV IEN of a record in the INSTITUTION file (#4) "RTN","MAGDRPCA",147,0) ; "RTN","MAGDRPCA",148,0) PROC(ARRAY,DIV,FILTER) ; "RTN","MAGDRPCA",149,0) N IMAGTYPE ; IEN of the imaging type (file #79.2) "RTN","MAGDRPCA",150,0) N INACTDAT ; Inactivation date of the procedure "RTN","MAGDRPCA",151,0) N OMLDAT ; Outside imaging location data (file #2006.5759) "RTN","MAGDRPCA",152,0) N OMLIEN ; IEN in OUTSIDE IMAGING LOCATION file (#2006.5759) "RTN","MAGDRPCA",153,0) N RADPROC ; Radiology procedure data (file #71) "RTN","MAGDRPCA",154,0) N TODAY ; today's date in Fileman format "RTN","MAGDRPCA",155,0) N PROCTYPE ; Type of procedure "RTN","MAGDRPCA",156,0) N DIVSN ; Division Station Number "RTN","MAGDRPCA",157,0) ; "RTN","MAGDRPCA",158,0) N BUF,ERROR,IEN,Z "RTN","MAGDRPCA",159,0) K ARRAY "RTN","MAGDRPCA",160,0) ; "RTN","MAGDRPCA",161,0) ;--- Validate parameters "RTN","MAGDRPCA",162,0) S DIV=$G(DIV) "RTN","MAGDRPCA",163,0) I ($$STA^XUAF4(DIV)="")!(DIV'=+DIV) D Q:$D(ARRAY) ; P142 DAC - Accept IEN or STATION NUMBER "RTN","MAGDRPCA",164,0) . S DIVSN=$$IEN^XUAF4(DIV) ; Check STATION NUMBER "RTN","MAGDRPCA",165,0) . I DIVSN="" S ARRAY(1)="-2,Institution "_DIV_" does not exist." Q "RTN","MAGDRPCA",166,0) . S DIV=DIVSN "RTN","MAGDRPCA",167,0) . Q "RTN","MAGDRPCA",168,0) S ERROR=$$DISPLAY^MAGDAIRG(0) "RTN","MAGDRPCA",169,0) I ERROR=-1 D Q "RTN","MAGDRPCA",170,0) . S ARRAY(1)="-3,""No Credit"" entries must be added to the IMAGING LOCATIONS file (#79.1)" "RTN","MAGDRPCA",171,0) . S ARRAY(2)="" "RTN","MAGDRPCA",172,0) . S ARRAY(3)="Use the IMPORTER MENU option CHECK OUTSIDE IMAGING LOCATION FILE" "RTN","MAGDRPCA",173,0) . S ARRAY(4)="on the VistA system to correct the problem." "RTN","MAGDRPCA",174,0) . Q "RTN","MAGDRPCA",175,0) I ERROR=-2 D Q "RTN","MAGDRPCA",176,0) . S ARRAY(1)="-4,Entries must be added to the OUTSIDE IMAGING LOCATIONS file (#2006.5759)" "RTN","MAGDRPCA",177,0) . S ARRAY(2)="" "RTN","MAGDRPCA",178,0) . S ARRAY(3)="Use the IMPORTER MENU option BUILD OUTSIDE IMAGING LOCATION FILE" "RTN","MAGDRPCA",179,0) . S ARRAY(4)="on the VistA system to correct the problem." "RTN","MAGDRPCA",180,0) . Q "RTN","MAGDRPCA",181,0) I ERROR'=0 D Q "RTN","MAGDRPCA",182,0) . S ARRAY(1)="-5,Unexpected error #"_ERROR_" returned by $$DISPLAY^MAGDAIRG(0)" "RTN","MAGDRPCA",183,0) . Q "RTN","MAGDRPCA",184,0) ; "RTN","MAGDRPCA",185,0) S (ARRAY(1),IEN)=0,TODAY=$$DT^XLFDT() "RTN","MAGDRPCA",186,0) F S IEN=$O(^RAMIS(71,IEN)) Q:'IEN D ; Private IA (#1174) "RTN","MAGDRPCA",187,0) . S RADPROC=^RAMIS(71,IEN,0),IMAGTYPE=+$P(RADPROC,U,12) "RTN","MAGDRPCA",188,0) . ;--- Get outside imaging location associated "RTN","MAGDRPCA",189,0) . ;--- with the imaging type of the procedure "RTN","MAGDRPCA",190,0) . S OMLIEN=$O(^MAGD(2006.5759,"D",DIV,IMAGTYPE,"")) Q:'OMLIEN "RTN","MAGDRPCA",191,0) . S OMLDAT=$G(^MAGD(2006.5759,OMLIEN,0)) "RTN","MAGDRPCA",192,0) . Q:$P(OMLDAT,U,4)'=DIV ; Has to be in the same Division "RTN","MAGDRPCA",193,0) . ;--- Prepare the procedure descriptor "RTN","MAGDRPCA",194,0) . S BUF=$P(RADPROC,U)_U_IEN ; Procedure Name and IEN "RTN","MAGDRPCA",195,0) . S PROCTYPE=$P(RADPROC,U,6) ; Type of Procedure "RTN","MAGDRPCA",196,0) . I $G(FILTER)=1,(PROCTYPE="B")!(PROCTYPE="P") Q "RTN","MAGDRPCA",197,0) . S $P(BUF,U,3)=PROCTYPE ; Type of Procedure "RTN","MAGDRPCA",198,0) . S $P(BUF,U,4)=$P(RADPROC,U,9) ; CPT Code (file #81) "RTN","MAGDRPCA",199,0) . S $P(BUF,U,5)=IMAGTYPE ; Type of Imaging (file #79.2) "RTN","MAGDRPCA",200,0) . S INACTDAT=$P($G(^RAMIS(71,IEN,"I")),U) "RTN","MAGDRPCA",201,0) . I INACTDAT,INACTDAT0 D "RTN","MAGVAG03",257,0) . S IENS=I_"," "RTN","MAGVAG03",258,0) . K OUT,ERR "RTN","MAGVAG03",259,0) . D GETS^DIQ(FILE,IENS,FIELDS,"I","OUT","ERR") "RTN","MAGVAG03",260,0) . I $D(ERR("DIERR")) D Q "RTN","MAGVAG03",261,0) . . D MSG^DIALOG("A",.MAGRESA,245,5,"ERR") "RTN","MAGVAG03",262,0) . . S MAGRY(0)=$$FAILED^MAGVAF02()_RESDEL_"Error getting values: "_MAGRESA(1) Q ; Error getting the values "RTN","MAGVAG03",263,0) . . Q "RTN","MAGVAG03",264,0) . S INSTIEN=OUT(FILE,IENS,.01,"I") "RTN","MAGVAG03",265,0) . S X=$$NS^XUAF4(INSTIEN) ; IA # 2171 Institution Name and Station Number "RTN","MAGVAG03",266,0) . S CNT=CNT+1 "RTN","MAGVAG03",267,0) . S MAGRY(CNT)=I_RESDEL_INSTIEN_RESDEL_$P(X,U,2)_RESDEL_$P(X,U,1) "RTN","MAGVAG03",268,0) . S MAGRY(CNT)=MAGRY(CNT)_RESDEL_OUT(FILE,IENS,50,"I")_RESDEL_OUT(FILE,IENS,51,"I") "RTN","MAGVAG03",269,0) . Q "RTN","MAGVAG03",270,0) ; "RTN","MAGVAG03",271,0) S X="IEN^Site IEN^Site Number^Site Name^Net UserName^Net Password" "RTN","MAGVAG03",272,0) F I=1:1:$L(X,"^") S $P(MAGRY(1),RESDEL,I)=$P(X,"^",I) "RTN","MAGVAG03",273,0) S MAGRY(0)=$$OK^MAGVAF02()_RESDEL_RESDEL_(CNT-1) "RTN","MAGVAG03",274,0) Q "RTN","MAGVCWIA") 0^4^B117974804 "RTN","MAGVCWIA",1,0) MAGVCWIA ;WOIFO/MAT,DAC - DICOM Storage Commit RPCs ; 20 Nov 2015 8:58 PM "RTN","MAGVCWIA",2,0) ;;3.0;IMAGING;**138,162**;Mar 19, 2002;Build 22;Nov 20, 2015 "RTN","MAGVCWIA",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGVCWIA",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGVCWIA",5,0) ;; | Property of the US Government. | "RTN","MAGVCWIA",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGVCWIA",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGVCWIA",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGVCWIA",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGVCWIA",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGVCWIA",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGVCWIA",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGVCWIA",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGVCWIA",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGVCWIA",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGVCWIA",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGVCWIA",17,0) ;; "RTN","MAGVCWIA",18,0) Q "RTN","MAGVCWIA",19,0) ;##### Create Storage Commit Work Item w/ optional pre-store processing. "RTN","MAGVCWIA",20,0) ; RPC: MAGVC WI SUBMIT NEW "RTN","MAGVCWIA",21,0) ; "RTN","MAGVCWIA",22,0) ; Calls: CRTITEM^MAGVIM01 [RPC: MAGV SUBMIT WORK ITEM] "RTN","MAGVCWIA",23,0) ; "RTN","MAGVCWIA",24,0) ; Input "RTN","MAGVCWIA",25,0) ; ===== "RTN","MAGVCWIA",26,0) ; "RTN","MAGVCWIA",27,0) ; RETURN Array for output "RTN","MAGVCWIA",28,0) ; MSGTAGS Array of Tag`Value pairs: "RTN","MAGVCWIA",29,0) ; "RTN","MAGVCWIA",30,0) ; Item##### tag values are "~"-delimited artifact UIDs. "RTN","MAGVCWIA",31,0) ; "RTN","MAGVCWIA",32,0) ; STAT Boolean: 1=Process when submitted; 0=not (default) "RTN","MAGVCWIA",33,0) ; "RTN","MAGVCWIA",34,0) ; Output "RTN","MAGVCWIA",35,0) ; ====== "RTN","MAGVCWIA",36,0) ; "RTN","MAGVCWIA",37,0) ; Error ..... <0`errmsg "RTN","MAGVCWIA",38,0) ; Success ... 0`## lines returned "RTN","MAGVCWIA",39,0) ; (1..n) echo MSGTAGS input (w/ "~"-3,4 piece status flags). "RTN","MAGVCWIA",40,0) ; "RTN","MAGVCWIA",41,0) ACTCRE8(RETURN,MSGTAGS,STAT) ; "RTN","MAGVCWIA",42,0) ; "RTN","MAGVCWIA",43,0) ;--- Quit on invalid KERNEL service account user identifier. "RTN","MAGVCWIA",44,0) I ($G(DUZ)="")!($G(DUZ(2))="") D Q "RTN","MAGVCWIA",45,0) . S RETURN(0)="-1`Invalid user service account." "RTN","MAGVCWIA",46,0) . Q "RTN","MAGVCWIA",47,0) ; "RTN","MAGVCWIA",48,0) ; "RTN","MAGVCWIA",49,0) I $G(STAT)="" S STAT=0 "RTN","MAGVCWIA",50,0) ;--- Default status subject to change if Item UIDs not unique. "RTN","MAGVCWIA",51,0) N STATUS S STATUS="RECEIVED" "RTN","MAGVCWIA",52,0) ;--- Note DICOM UID format etc. is pre-validated by Java side. "RTN","MAGVCWIA",53,0) N CTITEMS,CTWINS,ITEMCT,MAGERR S (CTITEMS,CTWINS,ITEMCT,MAGERR)=0 "RTN","MAGVCWIA",54,0) ; "RTN","MAGVCWIA",55,0) ;--- Initialize tag(name)=variable array. "RTN","MAGVCWIA",56,0) N TAGS K TAGS "RTN","MAGVCWIA",57,0) N APPNAME S APPNAME="",TAGS("ApplicationName")="APPNAME" "RTN","MAGVCWIA",58,0) N HOSTNAME S HOSTNAME="",TAGS("HostName")="HOSTNAME" "RTN","MAGVCWIA",59,0) N ITEMCT S ITEMCT="",TAGS("ItemCount")="ITEMCT" "RTN","MAGVCWIA",60,0) N RESPDTTM S RESPDTTM="",TAGS("ResponseDateTime")="RESPDTTM" "RTN","MAGVCWIA",61,0) N RETRY2GO S RETRY2GO="",TAGS("RetriesLeft")="RETRY2GO" "RTN","MAGVCWIA",62,0) N TRANSXID S TRANSXID="",TAGS("TransactionID")="TRANSXID" "RTN","MAGVCWIA",63,0) ; "RTN","MAGVCWIA",64,0) N UIDZ K UIDZ "RTN","MAGVCWIA",65,0) N TXTAG S TXTAG=0 "RTN","MAGVCWIA",66,0) ;--- Parse MSGTAGS array for item meta-info. "RTN","MAGVCWIA",67,0) D "RTN","MAGVCWIA",68,0) . N TAGCT S TAGCT=0 "RTN","MAGVCWIA",69,0) . F S TAGCT=$O(MSGTAGS(TAGCT)) Q:TAGCT="" D "RTN","MAGVCWIA",70,0) . . ; "RTN","MAGVCWIA",71,0) . . ;--- Recover tag-embedded data. "RTN","MAGVCWIA",72,0) . . N VAR S VAR=0 "RTN","MAGVCWIA",73,0) . . S TAG=$P(MSGTAGS(TAGCT),"`") "RTN","MAGVCWIA",74,0) . . S:$D(TAGS(TAG)) VAR=TAGS(TAG),@VAR=$P(MSGTAGS(TAGCT),"`",2) "RTN","MAGVCWIA",75,0) . . S:(TAG="TransactionID") TXTAG=TAGCT "RTN","MAGVCWIA",76,0) . . ;--- Process "Item#####" tags. "RTN","MAGVCWIA",77,0) . . D:TAG?1"Item"5N "RTN","MAGVCWIA",78,0) . . . ; "RTN","MAGVCWIA",79,0) . . . ;--- Array Item#####s to verify Instance UIDs are unique. "RTN","MAGVCWIA",80,0) . . . ;--- ANY duplication FAILS the SC Request at the Work Item level. "RTN","MAGVCWIA",81,0) . . . N YNTWIN "RTN","MAGVCWIA",82,0) . . . S YNTWIN=$$ACTCRE8A(.MSGTAGS,TAGCT,STAT) S:YNTWIN CTWINS=CTWINS+1 "RTN","MAGVCWIA",83,0) . . . S CTITEMS=CTITEMS+1 "RTN","MAGVCWIA",84,0) . . . ;--- Rename tag so MAGVIM01 files values as WP field lines. "RTN","MAGVCWIA",85,0) . . . S $P(MSGTAGS(TAGCT),"`")="MSG"_TAG "RTN","MAGVCWIA",86,0) . . . Q "RTN","MAGVCWIA",87,0) . . Q "RTN","MAGVCWIA",88,0) . ;--- Quit (-2) if TransactionID already on file. "RTN","MAGVCWIA",89,0) . I ''$D(^MAGV(2006.941,"SCTX",TRANSXID)) D Q "RTN","MAGVCWIA",90,0) . . S MAGERR=-2_"`"_"TransactionID already in use." "RTN","MAGVCWIA",91,0) . . Q "RTN","MAGVCWIA",92,0) . ;--- Quit (-4) if ItemCT '= Count of Item#####s "RTN","MAGVCWIA",93,0) . I ITEMCT'=CTITEMS D Q "RTN","MAGVCWIA",94,0) . . S MAGERR=-4_"`"_"ItemCount ("_ITEMCT_") <> ("_CTITEMS_") Items Submitted." "RTN","MAGVCWIA",95,0) . . Q "RTN","MAGVCWIA",96,0) . Q "RTN","MAGVCWIA",97,0) ; "RTN","MAGVCWIA",98,0) I +MAGERR<0 S RETURN(0)=MAGERR Q "RTN","MAGVCWIA",99,0) ; "RTN","MAGVCWIA",100,0) ;--- Set WI STATUS to FAILED if any UID is duplicated. "RTN","MAGVCWIA",101,0) S:+CTWINS STATUS="FAILURE" "RTN","MAGVCWIA",102,0) ; "RTN","MAGVCWIA",103,0) ;--- Delete the TransactionID tag and re-subscript remaining array elements. "RTN","MAGVCWIA",104,0) D:TXTAG "RTN","MAGVCWIA",105,0) . K MSGTAGS(TXTAG) "RTN","MAGVCWIA",106,0) . F S TXTAG=$O(MSGTAGS(TXTAG)) Q:TXTAG="" D "RTN","MAGVCWIA",107,0) . . S MSGTAGS(TXTAG-1)=MSGTAGS(TXTAG) K MSGTAGS(TXTAG) "RTN","MAGVCWIA",108,0) . . Q "RTN","MAGVCWIA",109,0) . Q "RTN","MAGVCWIA",110,0) ;--- If STAT was invoked and WI did not fail due to item duplication, "RTN","MAGVCWIA",111,0) ; set WI STATUS (=FAILURE on first "U" encountered). "RTN","MAGVCWIA",112,0) D:(STAT&(STATUS'="FAILURE")) "RTN","MAGVCWIA",113,0) . ;--- Set aggregate STATUS. "RTN","MAGVCWIA",114,0) . N FAILURE,TAG S (FAILURE,TAG)=0 "RTN","MAGVCWIA",115,0) . F S TAG=$O(MSGTAGS(TAG)) Q:TAG="" Q:FAILURE D "RTN","MAGVCWIA",116,0) . . ; "RTN","MAGVCWIA",117,0) . . S:($P(MSGTAGS(TAG),"~",3)="U") FAILURE=1 "RTN","MAGVCWIA",118,0) . . Q "RTN","MAGVCWIA",119,0) . ; "RTN","MAGVCWIA",120,0) . S STATUS=$S(FAILURE:"FAILURE",1:"SUCCESS") "RTN","MAGVCWIA",121,0) . Q "RTN","MAGVCWIA",122,0) ;--- Initialize variables for call to CRTITEM^MAGVIM01. "RTN","MAGVCWIA",123,0) N CRTUSR,PLACEID S CRTUSR=DUZ,PLACEID=DUZ(2) ;--- Service Account User. "RTN","MAGVCWIA",124,0) N CRTAPP,SUBTYPE,TYPE S (CRTAPP,SUBTYPE,TYPE)="StorageCommit" "RTN","MAGVCWIA",125,0) N PRIORITY S PRIORITY="0" "RTN","MAGVCWIA",126,0) ;--- Post entry to the MAG WORK ITEM & MAG WORK ITEM HISTORY files. "RTN","MAGVCWIA",127,0) D CRTITEM^MAGVIM01(.OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP) "RTN","MAGVCWIA",128,0) ; "RTN","MAGVCWIA",129,0) ;--- Quit on error from the create call. "RTN","MAGVCWIA",130,0) I +OUT<0 S RETURN(0)=OUT Q "RTN","MAGVCWIA",131,0) N WIIEN S WIIEN=$P(OUT,"`",2) "RTN","MAGVCWIA",132,0) K OUT "RTN","MAGVCWIA",133,0) ; "RTN","MAGVCWIA",134,0) ;--- Store the TransactionId "RTN","MAGVCWIA",135,0) N FDA S FDA(2006.941,WIIEN_",",16)=TRANSXID "RTN","MAGVCWIA",136,0) D FILE^DIE("","FDA") "RTN","MAGVCWIA",137,0) ; "RTN","MAGVCWIA",138,0) ;--- Return the work item. Note this call makes assumptions about STATUS which "RTN","MAGVCWIA",139,0) ; may changed when on-demand processing is invoked. "RTN","MAGVCWIA",140,0) D ACTGET(.RETURN,WIIEN) "RTN","MAGVCWIA",141,0) Q "RTN","MAGVCWIA",142,0) ;+++++ Internal Entry Point: Array item Instance UIDs & detect duplicates. "RTN","MAGVCWIA",143,0) ACTCRE8A(MSGTAGS,TAGCT,STAT) ; "RTN","MAGVCWIA",144,0) ; "RTN","MAGVCWIA",145,0) N YNTWIN S YNTWIN=0 "RTN","MAGVCWIA",146,0) N UIDI S UIDI=$P(MSGTAGS(TAGCT),"~",2) "RTN","MAGVCWIA",147,0) ;--- Set new array entry ... "RTN","MAGVCWIA",148,0) I '$D(UIDZ(UIDI)) D "RTN","MAGVCWIA",149,0) . S UIDZ(UIDI)="" "RTN","MAGVCWIA",150,0) . Q "RTN","MAGVCWIA",151,0) ;--- ... or mark as duplicate (do not mark older twin per CPT). "RTN","MAGVCWIA",152,0) E D "RTN","MAGVCWIA",153,0) . S YNTWIN=1,$P(MSGTAGS(TAGCT),"~",3,4)="U~D" "RTN","MAGVCWIA",154,0) . Q "RTN","MAGVCWIA",155,0) ;--- Do not process a known duplicated UID. "RTN","MAGVCWIA",156,0) Q:YNTWIN YNTWIN "RTN","MAGVCWIA",157,0) ;--- Conditional branch to on-demand processing. "RTN","MAGVCWIA",158,0) D:STAT "RTN","MAGVCWIA",159,0) . ;--- Query < MAG*3.0*34 structure. "RTN","MAGVCWIA",160,0) . N STATITEM S STATITEM=$$QRYLEGAC^MAGVCQRY(UIDI) "RTN","MAGVCWIA",161,0) . ;--- Query >= MAG*3.0*34 structure. "RTN","MAGVCWIA",162,0) . I 'STATITEM S STATITEM=$$QRYCURNT^MAGVCQRY(UIDI) "RTN","MAGVCWIA",163,0) . S $P(MSGTAGS(TAGCT),"~",3,4)=$S(STATITEM:"C~",1:"U~U") "RTN","MAGVCWIA",164,0) . Q "RTN","MAGVCWIA",165,0) Q YNTWIN "RTN","MAGVCWIA",166,0) ; "RTN","MAGVCWIA",167,0) ;##### Delete Storage Commit Work Item "RTN","MAGVCWIA",168,0) ; RPC: MAGVC WI DELETE "RTN","MAGVCWIA",169,0) ; "RTN","MAGVCWIA",170,0) ; Inputs "RTN","MAGVCWIA",171,0) ; ====== "RTN","MAGVCWIA",172,0) ; "RTN","MAGVCWIA",173,0) ; RETURN Target array for output "RTN","MAGVCWIA",174,0) ; WIIEN IEN of the MAG WORK ITEM (#2006.941) entry to delete. "RTN","MAGVCWIA",175,0) ; "RTN","MAGVCWIA",176,0) ACTDEL(RETURN,WIIEN) ; "RTN","MAGVCWIA",177,0) ; "RTN","MAGVCWIA",178,0) I '$D(^MAGV(2006.941,WIIEN)) S RETURN=-1_"`"_"Work item "_WIIEN_" not found." Q "RTN","MAGVCWIA",179,0) ; "RTN","MAGVCWIA",180,0) ; RPC: MAGV DELETE WORK ITEM "RTN","MAGVCWIA",181,0) D DELWITEM^MAGVIM01(.RETURN,WIIEN) "RTN","MAGVCWIA",182,0) Q "RTN","MAGVCWIA",183,0) ;##### Get Storage Commit Work Item(s) "RTN","MAGVCWIA",184,0) ; RPC: MAGVC WI GET "RTN","MAGVCWIA",185,0) ; "RTN","MAGVCWIA",186,0) ; Calls: GETITEM^MAGVIM01 [RPC: MAGV GET WORK ITEM] "RTN","MAGVCWIA",187,0) ; "RTN","MAGVCWIA",188,0) ; Inputs "RTN","MAGVCWIA",189,0) ; ====== "RTN","MAGVCWIA",190,0) ; "RTN","MAGVCWIA",191,0) ; RETURN Target array for output "RTN","MAGVCWIA",192,0) ; WIIEN IEN of the MAG WORK ITEM (#2006.941) entry to return. "RTN","MAGVCWIA",193,0) ; STAT Boolean: 1=Process; 0=not (default) "RTN","MAGVCWIA",194,0) ; "RTN","MAGVCWIA",195,0) ; Output "RTN","MAGVCWIA",196,0) ; ====== "RTN","MAGVCWIA",197,0) ; "RTN","MAGVCWIA",198,0) ; Error ..... <0`errmsg "RTN","MAGVCWIA",199,0) ; Success ... 0`## lines returned "RTN","MAGVCWIA",200,0) ; (1..n) lines of tag`value data w/ "~"-3,4 piece status flags. "RTN","MAGVCWIA",201,0) ; "RTN","MAGVCWIA",202,0) ACTGET(RETURN,WIIEN,STAT) ; "RTN","MAGVCWIA",203,0) ; "RTN","MAGVCWIA",204,0) ;--- Quit on invalid KERNEL service account user identifier. "RTN","MAGVCWIA",205,0) I $G(DUZ)="" S RETURN(0)="-1`Invalid user service account." Q "RTN","MAGVCWIA",206,0) ; "RTN","MAGVCWIA",207,0) S:$G(STAT)="" STAT=0 "RTN","MAGVCWIA",208,0) N CALLSTAT S CALLSTAT=0 "RTN","MAGVCWIA",209,0) ;--- Process first if STAT. "RTN","MAGVCWIA",210,0) N WISTAT ; P162 DAC - No need to look up failed statuses and prevent statuses to be reset to "FAILURE" "RTN","MAGVCWIA",211,0) S WISTAT=$$GET1^DIQ(2006.941,WIIEN,3) ; P162 DAC "RTN","MAGVCWIA",212,0) I (WISTAT="SENDING RESPONSE FAILED")!(WISTAT="FAILURE") S STAT=0 ; P162 DAC "RTN","MAGVCWIA",213,0) I STAT=1 N ERROR S CALLSTAT=$$MAIN^MAGVCQRY(.ERROR,WIIEN) "RTN","MAGVCWIA",214,0) I +CALLSTAT<0 S RETURN(0)=CALLSTAT Q "RTN","MAGVCWIA",215,0) ; "RTN","MAGVCWIA",216,0) ;--- Set EXPSTAT as f(STAT). "RTN","MAGVCWIA",217,0) N EXPSTAT S EXPSTAT=$$GET1^DIQ(2006.941,WIIEN,3) "RTN","MAGVCWIA",218,0) N NEWSTAT S NEWSTAT=EXPSTAT "RTN","MAGVCWIA",219,0) N UPDAPP S UPDAPP="StorageCommit" "RTN","MAGVCWIA",220,0) N UPDUSR S UPDUSR=DUZ "RTN","MAGVCWIA",221,0) ; "RTN","MAGVCWIA",222,0) ; RPC: MAGV GET WORK ITEM "RTN","MAGVCWIA",223,0) ; Find work item with matching ID and return tags - Get and transition "RTN","MAGVCWIA",224,0) ; "RTN","MAGVCWIA",225,0) K OUT "RTN","MAGVCWIA",226,0) D GETITEM^MAGVIM01(.OUT,WIIEN,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP) "RTN","MAGVCWIA",227,0) ; "RTN","MAGVCWIA",228,0) ;--- Output error from the GETITEM call. "RTN","MAGVCWIA",229,0) I +OUT(0)<0 M RETURN=OUT Q "RTN","MAGVCWIA",230,0) ; "RTN","MAGVCWIA",231,0) K OUTB "RTN","MAGVCWIA",232,0) ;--- Arrange meta-tag output. "RTN","MAGVCWIA",233,0) N ND S ND="" "RTN","MAGVCWIA",234,0) F S ND=$O(OUT(ND)) Q:ND="" D "RTN","MAGVCWIA",235,0) . ; "RTN","MAGVCWIA",236,0) . Q:OUT(ND)'["Tag" "RTN","MAGVCWIA",237,0) . S OUTB($P($P(OUT(ND),"`",2),"|"))=$P(OUT(ND),"|",2) "RTN","MAGVCWIA",238,0) . Q "RTN","MAGVCWIA",239,0) K OUT "RTN","MAGVCWIA",240,0) S OUT(1)="ApplicationName"_"`"_OUTB("ApplicationName") "RTN","MAGVCWIA",241,0) S OUT(2)="TransactionID"_"`"_$$GET1^DIQ(2006.941,WIIEN,16) "RTN","MAGVCWIA",242,0) S OUT(3)="HostName"_"`"_OUTB("HostName") "RTN","MAGVCWIA",243,0) S OUT(4)="ResponseDateTime"_"`"_OUTB("ResponseDateTime") "RTN","MAGVCWIA",244,0) S OUT(5)="RetriesLeft"_"`"_OUTB("RetriesLeft") "RTN","MAGVCWIA",245,0) S OUT(6)="scWIstatus"_"`"_$$GET1^DIQ(2006.941,WIIEN,3) "RTN","MAGVCWIA",246,0) S OUT(7)="ItemCount"_"`"_OUTB("ItemCount") "RTN","MAGVCWIA",247,0) ; "RTN","MAGVCWIA",248,0) ;--- Rebuild Item##### tags from WP field data. "RTN","MAGVCWIA",249,0) N LN S LN=7 "RTN","MAGVCWIA",250,0) N LNWP S LNWP=0 "RTN","MAGVCWIA",251,0) F S LNWP=$O(^MAGV(2006.941,WIIEN,2,LNWP)) Q:LNWP="" D "RTN","MAGVCWIA",252,0) . S LN=LN+1 "RTN","MAGVCWIA",253,0) . S OUT(LN)="Item"_$E((100000+LNWP),2,6)_"`"_$G(^MAGV(2006.941,WIIEN,2,LNWP,0)) "RTN","MAGVCWIA",254,0) . Q "RTN","MAGVCWIA",255,0) M RETURN=OUT "RTN","MAGVCWIA",256,0) S RETURN(0)=0_"`"_WIIEN "RTN","MAGVCWIA",257,0) Q "RTN","MAGVCWIA",258,0) ;##### List Storage Commit Work Item(s) "RTN","MAGVCWIA",259,0) ; RPC: MAGVC WI LIST "RTN","MAGVCWIA",260,0) ; "RTN","MAGVCWIA",261,0) ; Input "RTN","MAGVCWIA",262,0) ; ===== "RTN","MAGVCWIA",263,0) ; RETURN target output array "RTN","MAGVCWIA",264,0) ; [HOSTNAME] value of input tag "HostName" on which to filter. "RTN","MAGVCWIA",265,0) ; (if omitted, returns all HostNames) "RTN","MAGVCWIA",266,0) ; "RTN","MAGVCWIA",267,0) ; [WILIMIT] maxium number of work items to return in one RPC call "RTN","MAGVCWIA",268,0) ; [LASTIEN] the last work item IEN returned in the previous RPC call "RTN","MAGVCWIA",269,0) ; "RTN","MAGVCWIA",270,0) ; Output "RTN","MAGVCWIA",271,0) ; ====== "RTN","MAGVCWIA",272,0) ; Error: (0) <0`errmsg "RTN","MAGVCWIA",273,0) ; Success: (0) 0`n lines returned "RTN","MAGVCWIA",274,0) ; (1..n) |-1 IEN of WorkItem "RTN","MAGVCWIA",275,0) ; -2 Status "RTN","MAGVCWIA",276,0) ; -3 ResponseDateTime (in "millis"econds) "RTN","MAGVCWIA",277,0) ; -4 Retries Left "RTN","MAGVCWIA",278,0) ; -5 HostName "RTN","MAGVCWIA",279,0) ; "RTN","MAGVCWIA",280,0) ACTLIST(RETURN,HOSTNAME,WILIMIT,LASTIEN) ; P162 DAC - Modified to support additional parameters and return smaller lists "RTN","MAGVCWIA",281,0) ; "RTN","MAGVCWIA",282,0) S HOSTNAME=$G(HOSTNAME),WILIMIT=$G(WILIMIT),LASTIEN=$G(LASTIEN) "RTN","MAGVCWIA",283,0) ; "RTN","MAGVCWIA",284,0) ;--- Get IEN of "StorageCommit" entry in WORKLIST file (#2006.9412). "RTN","MAGVCWIA",285,0) N SCIEN S SCIEN=$$FIND1^DIC(2006.9412,,,"StorageCommit") "RTN","MAGVCWIA",286,0) ; "RTN","MAGVCWIA",287,0) ;--- Traverse IEN's "T" cross-reference for member Work Items. "RTN","MAGVCWIA",288,0) N OUT K OUT "RTN","MAGVCWIA",289,0) N FILE S FILE=2006.941 "RTN","MAGVCWIA",290,0) N WIIEN S WIIEN="" "RTN","MAGVCWIA",291,0) N COUNTER S COUNTER=0 "RTN","MAGVCWIA",292,0) I LASTIEN'="" S WIIEN=LASTIEN "RTN","MAGVCWIA",293,0) F S WIIEN=$O(^MAGV(FILE,"T",SCIEN,WIIEN)) Q:WIIEN="" Q:COUNTER=WILIMIT D ; P162 DAC - Added work Item Limit check "RTN","MAGVCWIA",294,0) . ; "RTN","MAGVCWIA",295,0) . N WISTATUS S WISTATUS=$$GET1^DIQ(FILE,WIIEN,3) "RTN","MAGVCWIA",296,0) . ;--- Recover tag-embedded data. "RTN","MAGVCWIA",297,0) . N HOST S HOST="" "RTN","MAGVCWIA",298,0) . N RESPDTTM,RETRY2GO S (RESPDTTM,RETRY2GO)="" "RTN","MAGVCWIA",299,0) . N TGIEN S TGIEN=0 "RTN","MAGVCWIA",300,0) . F S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN="" D "RTN","MAGVCWIA",301,0) . . ; "RTN","MAGVCWIA",302,0) . . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U) "RTN","MAGVCWIA",303,0) . . N VAL S VAL=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2) "RTN","MAGVCWIA",304,0) . . S:TAG="ResponseDateTime" RESPDTTM=VAL "RTN","MAGVCWIA",305,0) . . S:TAG="RetriesLeft" RETRY2GO=VAL "RTN","MAGVCWIA",306,0) . . S:TAG="HostName" HOST=VAL "RTN","MAGVCWIA",307,0) . . Q "RTN","MAGVCWIA",308,0) . Q:(RESPDTTM="") "RTN","MAGVCWIA",309,0) . ; "RTN","MAGVCWIA",310,0) . ;--- Optional filter by HOSTNAME. "RTN","MAGVCWIA",311,0) . I HOSTNAME="" D "RTN","MAGVCWIA",312,0) . . S OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST "RTN","MAGVCWIA",313,0) . . S COUNTER=COUNTER+1 ; P162 DAC - Increment record returned counter "RTN","MAGVCWIA",314,0) . . Q "RTN","MAGVCWIA",315,0) . E D "RTN","MAGVCWIA",316,0) . . S:HOSTNAME=HOST OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST "RTN","MAGVCWIA",317,0) . . S COUNTER=COUNTER+1 ; P162 DAC - Increment record returned counter "RTN","MAGVCWIA",318,0) . . Q "RTN","MAGVCWIA",319,0) . Q "RTN","MAGVCWIA",320,0) ;--- Re-index array & return. "RTN","MAGVCWIA",321,0) N CT,NOD S (CT,NOD)=0 "RTN","MAGVCWIA",322,0) F S NOD=$O(OUT(NOD)) Q:NOD="" S CT=CT+1,RETURN(CT)=OUT(NOD) "RTN","MAGVCWIA",323,0) S RETURN(0)=0_"`"_CT ; P162 DAC - Return record count "RTN","MAGVCWIA",324,0) Q "RTN","MAGVCWIA",325,0) ;##### Update Storage Commit Work Item Status "RTN","MAGVCWIA",326,0) ; RPC: MAGVC WI UPDATE STATUS "RTN","MAGVCWIA",327,0) ; "RTN","MAGVCWIA",328,0) ACTUPD8(RETURN,WIIEN,NEWSTAT) ; "RTN","MAGVCWIA",329,0) ; "RTN","MAGVCWIA",330,0) ;--- Get Current Status "RTN","MAGVCWIA",331,0) N NOWSTAT S NOWSTAT=$$GET1^DIQ(2006.941,WIIEN,3) "RTN","MAGVCWIA",332,0) ; "RTN","MAGVCWIA",333,0) ;--- Quit (-2) if status is IN PROGRESS. "RTN","MAGVCWIA",334,0) I NOWSTAT="IN PROGRESS" D Q "RTN","MAGVCWIA",335,0) . S RETURN(0)=-2_"`"_"WI is "_NOWSTAT_"." "RTN","MAGVCWIA",336,0) ; "RTN","MAGVCWIA",337,0) ;--- Handle subsequent "SENDING RESPONSE FAILED" set requests. "RTN","MAGVCWIA",338,0) I (NEWSTAT="SENDING RESPONSE FAILED")&(NOWSTAT=NEWSTAT) D Q "RTN","MAGVCWIA",339,0) . ; "RTN","MAGVCWIA",340,0) . ;--- Decrement RetriesLeft tag. "RTN","MAGVCWIA",341,0) . D ZUPD8FLG(.OUT,.WIIEN,"RetriesLeft") "RTN","MAGVCWIA",342,0) . I +OUT<0 S RETURN(0)=OUT Q "RTN","MAGVCWIA",343,0) . N RETRY2GO S RETRY2GO=$P(OUT,"`",2) "RTN","MAGVCWIA",344,0) . ; "RTN","MAGVCWIA",345,0) . ;--- Return. "RTN","MAGVCWIA",346,0) . D ACTGET(.RETURN,.WIIEN) "RTN","MAGVCWIA",347,0) . S RETURN(0)=0_"`"_WIIEN_"`"_"Decremented RetriesLeft to "_RETRY2GO_"." "RTN","MAGVCWIA",348,0) . Q "RTN","MAGVCWIA",349,0) ;--- Otherwise quit (-4) if status is already at the requested status. "RTN","MAGVCWIA",350,0) I NOWSTAT=NEWSTAT D Q "RTN","MAGVCWIA",351,0) . S RETURN(0)=-4_"`"_"WI Status is already "_NEWSTAT_"." "RTN","MAGVCWIA",352,0) . Q "RTN","MAGVCWIA",353,0) ;--- Update the item's STATUS. "RTN","MAGVCWIA",354,0) N FDA S FDA(2006.941,WIIEN_",",3)=NEWSTAT "RTN","MAGVCWIA",355,0) N MAGERR "RTN","MAGVCWIA",356,0) D FILE^DIE("E","FDA","MAGERR") "RTN","MAGVCWIA",357,0) ;--- Quit on trapped UPDATER Error "RTN","MAGVCWIA",358,0) I $D(MAGERR) D Q "RTN","MAGVCWIA",359,0) . S RETURN(0)=-6_"`"_MAGERR("DIERR",1,"TEXT",1) "RTN","MAGVCWIA",360,0) . Q "RTN","MAGVCWIA",361,0) ;--- Return. "RTN","MAGVCWIA",362,0) D ACTGET(.RETURN,.WIIEN) "RTN","MAGVCWIA",363,0) S RETURN(0)=0_"`"_WIIEN_"`"_"Updated to "_NEWSTAT_"." "RTN","MAGVCWIA",364,0) Q "RTN","MAGVCWIA",365,0) ;--- Decrement RetriesLeft Tag if >1 "Sending Response Failed" set attempt. "RTN","MAGVCWIA",366,0) ; "RTN","MAGVCWIA",367,0) ZUPD8FLG(OUT,WIIEN,TAGIN) ; "RTN","MAGVCWIA",368,0) ; "RTN","MAGVCWIA",369,0) K OUT S OUT="0`" "RTN","MAGVCWIA",370,0) ; "RTN","MAGVCWIA",371,0) ;--- Recover tag-embedded data. "RTN","MAGVCWIA",372,0) N FILE S FILE=2006.941 "RTN","MAGVCWIA",373,0) N TGIEN S TGIEN=0 "RTN","MAGVCWIA",374,0) F S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN="" D "RTN","MAGVCWIA",375,0) . ; "RTN","MAGVCWIA",376,0) . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U) "RTN","MAGVCWIA",377,0) . D:(TAG=TAGIN) "RTN","MAGVCWIA",378,0) . . N RETRIES,RETRY2GO S (RETRIES,RETRY2GO)="" "RTN","MAGVCWIA",379,0) . . S RETRIES=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2) "RTN","MAGVCWIA",380,0) . . S RETRY2GO=RETRIES-1 "RTN","MAGVCWIA",381,0) . . I RETRY2GO<0 S OUT=-1_"`RetriesLeft is already "_0_"." Q "RTN","MAGVCWIA",382,0) . . S $P(^MAGV(FILE,WIIEN,4,TGIEN,0),U,2)=RETRY2GO "RTN","MAGVCWIA",383,0) . . S $P(OUT,"`",2)=RETRY2GO "RTN","MAGVCWIA",384,0) . . Q "RTN","MAGVCWIA",385,0) . Q "RTN","MAGVCWIA",386,0) Q "RTN","MAGVCWIA",387,0) ; "RTN","MAGVCWIA",388,0) ; MAGVCWIA "RTN","MAGVGUID") 0^5^B34583705 "RTN","MAGVGUID",1,0) MAGVGUID ;WOIFO/RRB,DAC - Duplicate DICOM Study, Series, & SOP Instance UID Checks ; 23 Nov 2015 3:17 PM "RTN","MAGVGUID",2,0) ;;3.0;IMAGING;**118,138,162**;Mar 19, 2002;Build 22;Nov 23, 2015 "RTN","MAGVGUID",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGVGUID",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGVGUID",5,0) ;; | Property of the US Government. | "RTN","MAGVGUID",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGVGUID",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGVGUID",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGVGUID",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGVGUID",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGVGUID",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGVGUID",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGVGUID",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGVGUID",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGVGUID",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGVGUID",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGVGUID",17,0) ;; "RTN","MAGVGUID",18,0) Q "RTN","MAGVGUID",19,0) ; "RTN","MAGVGUID",20,0) ; check for duplicate SOP Instance UID "RTN","MAGVGUID",21,0) SOP(DFN,ACNUMB,STUDYUID,SERIESUID,SOPUID) ; "RTN","MAGVGUID",22,0) N MAGIEN ;--- ien of 2005 DICOM object "RTN","MAGVGUID",23,0) N DUPSOP ;--- -1 = Error, 1 = Duplicate UID, 2 = RESEND "RTN","MAGVGUID",24,0) ; "RTN","MAGVGUID",25,0) ; is there a DICOM object on file with this SOP Instance UID? "RTN","MAGVGUID",26,0) I '$O(^MAG(2005,"P",SOPUID,0)) Q 0 ; nope "RTN","MAGVGUID",27,0) ; "RTN","MAGVGUID",28,0) ; is the same DICOM object already on file? "RTN","MAGVGUID",29,0) ; there might be multiples and we have to check each one "RTN","MAGVGUID",30,0) S MAGIEN=0,DUPSOP=0 "RTN","MAGVGUID",31,0) F S MAGIEN=$O(^MAG(2005,"P",SOPUID,MAGIEN)) Q:MAGIEN="" D Q:DUPSOP "RTN","MAGVGUID",32,0) . S DUPSOP=$$SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID) "RTN","MAGVGUID",33,0) . Q "RTN","MAGVGUID",34,0) S DUPSOP=$S(DUPSOP=0:2,1:DUPSOP) "RTN","MAGVGUID",35,0) Q DUPSOP "RTN","MAGVGUID",36,0) ; "RTN","MAGVGUID",37,0) SAMEIMG(MAGIEN,DFN,STUDYUID,SERIESUID) ; check DFN and study & series UIDs "RTN","MAGVGUID",38,0) N MAG0 ;----- 0-node of file 2005 "RTN","MAGVGUID",39,0) N MAGDFN ;--- DFN of designated image "RTN","MAGVGUID",40,0) N MAGGROUP ;- pointer to the image group "RTN","MAGVGUID",41,0) N MAGPTR,MAGACN "RTN","MAGVGUID",42,0) N OLDSTUDY,OLDSERIES ; UIDs of the original series or study "RTN","MAGVGUID",43,0) ; check for defined arguments "RTN","MAGVGUID",44,0) Q:$G(MAGIEN)="" -1 "RTN","MAGVGUID",45,0) Q:$G(DFN)="" -1 "RTN","MAGVGUID",46,0) Q:$G(STUDYUID)="" -1 "RTN","MAGVGUID",47,0) Q:$G(SERIESUID)="" -1 "RTN","MAGVGUID",48,0) S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0="" -1 ; no 0-node "RTN","MAGVGUID",49,0) S MAGDFN=$P(MAG0,"^",7) Q:DFN'=MAGDFN 1 ; different patient "RTN","MAGVGUID",50,0) S MAGGROUP=$P(MAG0,"^",10) "RTN","MAGVGUID",51,0) ; P162 DAC - Accession Number Check producing duplicates instread of resends "RTN","MAGVGUID",52,0) S OLDSTUDY=$S(MAGGROUP:$P($G(^MAG(2005,MAGGROUP,"PACS")),"^",1),1:"") "RTN","MAGVGUID",53,0) I $L(OLDSTUDY),OLDSTUDY'=STUDYUID Q 1 ; different study instance UIDs "RTN","MAGVGUID",54,0) S OLDSERIES=$G(^MAG(2005,MAGIEN,"SERIESUID")) "RTN","MAGVGUID",55,0) I $L(OLDSERIES),OLDSERIES'=SERIESUID Q 1 ; different series instance UIDs "RTN","MAGVGUID",56,0) Q 0 "RTN","MAGVGUID",57,0) ; "RTN","MAGVGUID",58,0) ; check for duplicate Series Instance UID "RTN","MAGVGUID",59,0) SERIES(DFN,ACNUMB,STUDYUID,SERIESUID) ; "RTN","MAGVGUID",60,0) N MAG0 ;----- 0-node of file 2005 "RTN","MAGVGUID",61,0) N MAGACN ;--- accession number of 2005 DICOM object "RTN","MAGVGUID",62,0) N MAGIEN ;--- ien of 2005 DICOM object "RTN","MAGVGUID",63,0) N MAGIENG ;-- ien of 2005 DICOM object in group file (2005.04) "RTN","MAGVGUID",64,0) N MAGDFN ;--- DFN of designated image "RTN","MAGVGUID",65,0) N MAGGROUP ;- pointer to the image group "RTN","MAGVGUID",66,0) N MAGSTUID ;- study instance uid of 2005 DICOM object "RTN","MAGVGUID",67,0) N DUPSERIES "RTN","MAGVGUID",68,0) N I,X "RTN","MAGVGUID",69,0) ; "RTN","MAGVGUID",70,0) ; is there a DICOM object on file with this Series Instance UID? "RTN","MAGVGUID",71,0) I '$O(^MAG(2005,"SERIESUID",SERIESUID,0)) Q 0 ; nope "RTN","MAGVGUID",72,0) ; "RTN","MAGVGUID",73,0) K ^TMP("MAG",$J,"SERIES UID") "RTN","MAGVGUID",74,0) ; "RTN","MAGVGUID",75,0) ; First pass - get the list of DICOM objects for this series "RTN","MAGVGUID",76,0) ; "RTN","MAGVGUID",77,0) S MAGIEN=0 "RTN","MAGVGUID",78,0) F S MAGIEN=$O(^MAG(2005,"SERIESUID",SERIESUID,MAGIEN)) Q:MAGIEN="" D "RTN","MAGVGUID",79,0) . S ^TMP("MAG",$J,"SERIES UID",MAGIEN)="" "RTN","MAGVGUID",80,0) . Q "RTN","MAGVGUID",81,0) ; "RTN","MAGVGUID",82,0) ; Second pass - for each DICOM object on file, do the following steps "RTN","MAGVGUID",83,0) ; 1) look up the group and get DFN, ACNUMB, Study Instance UID "RTN","MAGVGUID",84,0) ; 2) record this information for the first DICOM object in each group "RTN","MAGVGUID",85,0) ; 3) skip other DICOM objects in same group - redundant information "RTN","MAGVGUID",86,0) ; "RTN","MAGVGUID",87,0) S MAGIEN=0 "RTN","MAGVGUID",88,0) F S MAGIEN=$O(^TMP("MAG",$J,"SERIES UID",MAGIEN)) Q:'MAGIEN S X=^(MAGIEN) D "RTN","MAGVGUID",89,0) . Q:X?1"SKIP".E ; skip DICOM objects in groups that were already processed "RTN","MAGVGUID",90,0) . S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0="" "RTN","MAGVGUID",91,0) . S MAGDFN=$P(MAG0,"^",7),MAGGROUP=$P(MAG0,"^",10) "RTN","MAGVGUID",92,0) . S MAGSTUID=$P($G(^MAG(2005,MAGGROUP,"PACS")),"^",1) "RTN","MAGVGUID",93,0) . S MAGACN=$$GETACN(MAGIEN) "RTN","MAGVGUID",94,0) . S X=MAGDFN_"^"_MAGACN_"^"_MAGSTUID "RTN","MAGVGUID",95,0) . S ^TMP("MAG",$J,"SERIES UID",MAGIEN)=X "RTN","MAGVGUID",96,0) . ; go through the object group file (2005.04) and remove redundancies "RTN","MAGVGUID",97,0) . S I=0 F S I=$O(^MAG(2005,MAGGROUP,1,I)) Q:'I S X=^(I,0) D "RTN","MAGVGUID",98,0) . . S MAGIENG=$P(X,"^",1) Q:MAGIENG=MAGIEN ; keep first object "RTN","MAGVGUID",99,0) . . I $D(^TMP("MAG",$J,"SERIES UID",MAGIENG)) S ^(MAGIENG)="SKIP-"_MAGIEN "RTN","MAGVGUID",100,0) . . Q "RTN","MAGVGUID",101,0) . Q "RTN","MAGVGUID",102,0) ; "RTN","MAGVGUID",103,0) ; Third pass - check remaining entries in ^TMP for duplicates "RTN","MAGVGUID",104,0) ; "RTN","MAGVGUID",105,0) S MAGIEN="",DUPSERIES=0 "RTN","MAGVGUID",106,0) F S MAGIEN=$O(^TMP("MAG",$J,"SERIES UID",MAGIEN)) Q:MAGIEN="" D Q:DUPSERIES "RTN","MAGVGUID",107,0) . S X=^TMP("MAG",$J,"SERIES UID",MAGIEN) "RTN","MAGVGUID",108,0) . Q:X["SKIP" "RTN","MAGVGUID",109,0) . S MAGDFN=$P(X,"^",1),MAGACN=$P(X,"^",2),MAGSTUID=$P(X,"^",3) "RTN","MAGVGUID",110,0) . S DUPSERIES=1 "RTN","MAGVGUID",111,0) . I DFN=MAGDFN,ACNUMB=MAGACN,STUDYUID=MAGSTUID S DUPSERIES=0 "RTN","MAGVGUID",112,0) . Q "RTN","MAGVGUID",113,0) ; "RTN","MAGVGUID",114,0) Q DUPSERIES "RTN","MAGVGUID",115,0) ; "RTN","MAGVGUID",116,0) ; check for duplicate Study Instance UID "RTN","MAGVGUID",117,0) STUDY(DFN,ACNUMB,STUDYUID) ; "RTN","MAGVGUID",118,0) N HIT ;------ switch "RTN","MAGVGUID",119,0) N MAGIEN ;--- ien of 2005 DICOM object "RTN","MAGVGUID",120,0) ; "RTN","MAGVGUID",121,0) ; is there a DICOM object on file with this Study Instance UID? "RTN","MAGVGUID",122,0) I '$O(^MAG(2005,"P",STUDYUID,0)) Q 0 ; nope "RTN","MAGVGUID",123,0) ; "RTN","MAGVGUID",124,0) ; is the same DICOM object already on file? "RTN","MAGVGUID",125,0) ; there might be multiples and we have to check each one "RTN","MAGVGUID",126,0) S (HIT,MAGIEN)=0 "RTN","MAGVGUID",127,0) F S MAGIEN=$O(^MAG(2005,"P",STUDYUID,MAGIEN)) Q:MAGIEN="" D Q:HIT "RTN","MAGVGUID",128,0) . S HIT=$$SAMESTDY(MAGIEN,DFN,ACNUMB) "RTN","MAGVGUID",129,0) . Q "RTN","MAGVGUID",130,0) ; "RTN","MAGVGUID",131,0) Q HIT "RTN","MAGVGUID",132,0) ; "RTN","MAGVGUID",133,0) SAMESTDY(MAGIEN,DFN,ACNUMB) ; "RTN","MAGVGUID",134,0) N MAG0 ; 0-node and 2-node of file 2005 "RTN","MAGVGUID",135,0) N MAGDFN ; DFN of designated image "RTN","MAGVGUID",136,0) S MAG0=$G(^MAG(2005,MAGIEN,0)) Q:MAG0="" -1 ; no 0-node "RTN","MAGVGUID",137,0) S MAGDFN=$P(MAG0,"^",7) Q:DFN'=MAGDFN 1 ; different patient "RTN","MAGVGUID",138,0) I ACNUMB'=$$GETACN(MAGIEN) Q 1 ; different accession "RTN","MAGVGUID",139,0) Q 0 "RTN","MAGVGUID",140,0) ; "RTN","MAGVGUID",141,0) GETACN(MAGIEN) ; return the accession number of a study "RTN","MAGVGUID",142,0) N ACNUMBVAH ; VA HIS accession number "RTN","MAGVGUID",143,0) N DATETIME ; Accession DateTime "RTN","MAGVGUID",144,0) N MAG2 ; 2-node of file 2005 "RTN","MAGVGUID",145,0) N RARPT0 ; 0-node of ^RARPT "RTN","MAGVGUID",146,0) N RADPT0 ; 0-node of ^RADPT "RTN","MAGVGUID",147,0) N REVDT ; "RTN","MAGVGUID",148,0) N ROOT,POINTER ; parent data file root and pointer "RTN","MAGVGUID",149,0) S MAG2=$G(^MAG(2005,MAGIEN,2)) Q:MAG2="" "" ; no 2-node "RTN","MAGVGUID",150,0) S ROOT=$P(MAG2,"^",6),POINTER=$P(MAG2,"^",7) "RTN","MAGVGUID",151,0) I ROOT=74 D "RTN","MAGVGUID",152,0) . S RARPT0=$G(^RARPT(POINTER,0)),DATETIME=$P(RARPT0,"^",3) "RTN","MAGVGUID",153,0) . S REVDT=9999999.9999-DATETIME "RTN","MAGVGUID",154,0) . S RADPT0=$G(^RADPT(DFN,"DT",REVDT,"P",1,0)) "RTN","MAGVGUID",155,0) . S ACNUMBVAH=$P(RADPT0,"^",31) "RTN","MAGVGUID",156,0) . I ACNUMBVAH="" S ACNUMBVAH=$P(RARPT0,"^",1) "RTN","MAGVGUID",157,0) . Q "RTN","MAGVGUID",158,0) E I ROOT=8925 S ACNUMBVAH=$$GMRCACN^MAGDFCNV(+$$GET1^DIQ(8925,POINTER,1405,"I")) "RTN","MAGVGUID",159,0) E I ROOT=2006.5839 S ACNUMBVAH=$$GMRCACN^MAGDFCNV(POINTER) "RTN","MAGVGUID",160,0) E S ACNUMBVAH="" "RTN","MAGVGUID",161,0) Q ACNUMBVAH "RTN","MAGVGUID",162,0) ; "RTN","MAGVRS61") 0^6^B95250185 "RTN","MAGVRS61",1,0) MAGVRS61 ;WOIFO/DAC - RPC calls for DICOM file processing ; 20 Nov 2015 11:20 AM "RTN","MAGVRS61",2,0) ;;3.0;IMAGING;**118,162**;Mar 19, 2002;Build 22;Nov 20, 2015 "RTN","MAGVRS61",3,0) ;; Per VHA Directive 2004-038, this routine should not be modified. "RTN","MAGVRS61",4,0) ;; +---------------------------------------------------------------+ "RTN","MAGVRS61",5,0) ;; | Property of the US Government. | "RTN","MAGVRS61",6,0) ;; | No permission to copy or redistribute this software is given. | "RTN","MAGVRS61",7,0) ;; | Use of unreleased versions of this software requires the user | "RTN","MAGVRS61",8,0) ;; | to execute a written test agreement with the VistA Imaging | "RTN","MAGVRS61",9,0) ;; | Development Office of the Department of Veterans Affairs, | "RTN","MAGVRS61",10,0) ;; | telephone (301) 734-0100. | "RTN","MAGVRS61",11,0) ;; | The Food and Drug Administration classifies this software as | "RTN","MAGVRS61",12,0) ;; | a medical device. As such, it may not be changed in any way. | "RTN","MAGVRS61",13,0) ;; | Modifications to this software may result in an adulterated | "RTN","MAGVRS61",14,0) ;; | medical device under 21CFR820, the use of which is considered | "RTN","MAGVRS61",15,0) ;; | to be a violation of US Federal Statutes. | "RTN","MAGVRS61",16,0) ;; +---------------------------------------------------------------+ "RTN","MAGVRS61",17,0) ;; "RTN","MAGVRS61",18,0) Q "RTN","MAGVRS61",19,0) DUPUID(OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID) ; Check for duplicate UIDs in the new structure "RTN","MAGVRS61",20,0) ; OUT - Duplicate message output "RTN","MAGVRS61",21,0) ; ACCESSION - Accession # ; DFN - Patient DFN "RTN","MAGVRS61",22,0) ; TYPE - Type of UID check - "STUDY", "SERIES", or "SOP" "RTN","MAGVRS61",23,0) ; UID - Unique Identifier "RTN","MAGVRS61",24,0) ; if accession number does not match then it's a duplicate UID "RTN","MAGVRS61",25,0) ; OUT: "RTN","MAGVRS61",26,0) ; "RTN","MAGVRS61",27,0) ; -1 - Exception with error message "RTN","MAGVRS61",28,0) ; "RTN","MAGVRS61",29,0) ; 0 - Not a duplicate UID - Non duplicates are either have no entries in the 2005.6x files "RTN","MAGVRS61",30,0) ; or they match on UID, DFN, Accession, and parent UIDs "RTN","MAGVRS61",31,0) ; 1 - Duplicate UID - Duplicates have an entry in a 2005.6x file, but does not match "RTN","MAGVRS61",32,0) ; on UID, DFN, Accession, and/or parent UID "RTN","MAGVRS61",33,0) ; 2 - Record exist - A record exists with a matching DFN, Accession, Study UID, Series UID, "RTN","MAGVRS61",34,0) ; and SOP UID already "RTN","MAGVRS61",35,0) N SOPOUT,SOPLINK "RTN","MAGVRS61",36,0) I TYPE'="STUDY",TYPE'="SERIES",TYPE'="SOP" S OUT="-1~TYPE is not Study, Series, or SOP" Q "RTN","MAGVRS61",37,0) S OUT=0 "RTN","MAGVRS61",38,0) ; If the UID and the accession are already being used and the UID is not linked to the "RTN","MAGVRS61",39,0) ; procedure REF with the same accession then the UID is a duplicate "RTN","MAGVRS61",40,0) I TYPE="STUDY",$D(^MAGV(2005.62,"B",UID)) D "RTN","MAGVRS61",41,0) . I $$LINKED(ACCESSION,DFN,UID,"STUDY") Q "RTN","MAGVRS61",42,0) . S OUT=1 "RTN","MAGVRS61",43,0) . Q "RTN","MAGVRS61",44,0) I TYPE="SERIES",$D(^MAGV(2005.63,"B",UID)) D "RTN","MAGVRS61",45,0) . I $$LINKED(ACCESSION,DFN,UID,"SERIES",STUDUID) Q "RTN","MAGVRS61",46,0) . S OUT=1 "RTN","MAGVRS61",47,0) . Q "RTN","MAGVRS61",48,0) I TYPE="SOP",$D(^MAGV(2005.64,"B",UID)) D "RTN","MAGVRS61",49,0) . S SOPLINK=$$LINKED(ACCESSION,DFN,UID,"SOP",STUDUID,SERUID) "RTN","MAGVRS61",50,0) . I SOPLINK=2 S OUT=0 Q "RTN","MAGVRS61",51,0) . I SOPLINK="NOT AOF" S OUT=0 Q ; P162 DAC - Check AOF before checking if duplicate "RTN","MAGVRS61",52,0) . I SOPLINK=1 S OUT=2 Q "RTN","MAGVRS61",53,0) . S OUT=1 "RTN","MAGVRS61",54,0) . Q "RTN","MAGVRS61",55,0) Q OUT "RTN","MAGVRS61",56,0) DUPSTUD(DFN,ACCESSION,UID) ; Check for duplicate Study UID "RTN","MAGVRS61",57,0) S TYPE="STUDY" "RTN","MAGVRS61",58,0) I $G(ACCESSION)="" Q "-1~No accession number provided" "RTN","MAGVRS61",59,0) I $G(DFN)="" Q "-1~No patient DFN provided" "RTN","MAGVRS61",60,0) D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID) "RTN","MAGVRS61",61,0) Q OUT "RTN","MAGVRS61",62,0) DUPSER(DFN,ACCESSION,STUDUID,UID) ; Check for duplicate Series UID "RTN","MAGVRS61",63,0) S TYPE="SERIES" "RTN","MAGVRS61",64,0) I $G(ACCESSION)="" Q "-1~No accession number provided" "RTN","MAGVRS61",65,0) I $G(DFN)="" Q "-1~No patient DFN provided" "RTN","MAGVRS61",66,0) D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID) "RTN","MAGVRS61",67,0) Q OUT "RTN","MAGVRS61",68,0) DUPSOP(DFN,ACCESSION,STUDUID,SERUID,UID) ; Check for duplicate SOP UID "RTN","MAGVRS61",69,0) S TYPE="SOP" "RTN","MAGVRS61",70,0) I $G(ACCESSION)="" Q "-1~No accession number provided" "RTN","MAGVRS61",71,0) I $G(DFN)="" Q "-1~No patient DFN provided" "RTN","MAGVRS61",72,0) D DUPUID(.OUT,ACCESSION,DFN,TYPE,UID,STUDUID,SERUID) "RTN","MAGVRS61",73,0) Q OUT "RTN","MAGVRS61",74,0) LINKED(ACCESSION,DFN,UID,UIDTYPE,STUDUIDA,SERUIDA) ; Check if duplicate UID is linked to the same procedure, patient, and parent Study, Series, SOP IENS "RTN","MAGVRS61",75,0) N LINK,IEN,PROCIEN,STUDYIEN,SERIESIEN,SOPIEN,PROCCASE,PRIEN,PRDFN,STATUS,STUDUIDB,SOPUIDB,PATPROC,SERUIDB,AOF "RTN","MAGVRS61",76,0) S LINK=0 "RTN","MAGVRS61",77,0) I UIDTYPE="STUDY" D "RTN","MAGVRS61",78,0) . ; Check if the Study IEN is linked to the procedure IEN with the Accession # "RTN","MAGVRS61",79,0) . S STUDYIEN="" "RTN","MAGVRS61",80,0) . F S STUDYIEN=$O(^MAGV(2005.62,"B",UID,STUDYIEN)) Q:STUDYIEN="" D Q:STATUS="A" "RTN","MAGVRS61",81,0) . . S STATUS=$P($G(^MAGV(2005.62,STUDYIEN,5)),U,2) "RTN","MAGVRS61",82,0) . . Q:STATUS="I" "RTN","MAGVRS61",83,0) . . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6)) "RTN","MAGVRS61",84,0) . . S PROCIEN=$P(PATPROC,U,1) "RTN","MAGVRS61",85,0) . . S PRIEN=$P(PATPROC,U,3) "RTN","MAGVRS61",86,0) . . Q "RTN","MAGVRS61",87,0) . Q "RTN","MAGVRS61",88,0) I UIDTYPE="SERIES" D "RTN","MAGVRS61",89,0) . ; Check if the Series IEN is linked to the procedure IEN with the Accession # "RTN","MAGVRS61",90,0) . S SERIESIEN="" "RTN","MAGVRS61",91,0) . F S SERIESIEN=$O(^MAGV(2005.63,"B",UID,SERIESIEN)) Q:SERIESIEN="" D Q:STATUS="A" "RTN","MAGVRS61",92,0) . . S STATUS=$G(^MAGV(2005.63,SERIESIEN,9)) "RTN","MAGVRS61",93,0) . . Q:STATUS="I" "RTN","MAGVRS61",94,0) . . S STUDYIEN=$P($G(^MAGV(2005.63,SERIESIEN,6)),U,1) "RTN","MAGVRS61",95,0) . . S STUDUIDB=$P($G(^MAGV(2005.62,STUDYIEN,0)),U,1) "RTN","MAGVRS61",96,0) . . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6)) "RTN","MAGVRS61",97,0) . . S PROCIEN=$P(PATPROC,U,1) "RTN","MAGVRS61",98,0) . . S PRIEN=$P(PATPROC,U,3) "RTN","MAGVRS61",99,0) . . Q "RTN","MAGVRS61",100,0) . Q "RTN","MAGVRS61",101,0) I UIDTYPE="SOP" D "RTN","MAGVRS61",102,0) . ; Check if the SOP IEN is linked to the procedure IEN with the Accession # "RTN","MAGVRS61",103,0) . S SOPIEN="" "RTN","MAGVRS61",104,0) . F S SOPIEN=$O(^MAGV(2005.64,"B",UID,SOPIEN)) Q:SOPIEN="" D Q:STATUS="A" "RTN","MAGVRS61",105,0) . . S STATUS=$G(^MAGV(2005.64,SOPIEN,11)) "RTN","MAGVRS61",106,0) . . Q:STATUS="I" "RTN","MAGVRS61",107,0) . . S AOF=$P($G(^MAGV(2005.64,SOPIEN,6)),U,2) "RTN","MAGVRS61",108,0) . . S SERIESIEN=$P($G(^MAGV(2005.64,SOPIEN,6)),U,1) "RTN","MAGVRS61",109,0) . . S SERUIDB=$P($G(^MAGV(2005.63,SERIESIEN,0)),U,1) "RTN","MAGVRS61",110,0) . . S STUDYIEN=$P($G(^MAGV(2005.63,SERIESIEN,6)),U,1) "RTN","MAGVRS61",111,0) . . S STUDUIDB=$P($G(^MAGV(2005.62,STUDYIEN,0)),U,1) "RTN","MAGVRS61",112,0) . . S PATPROC=$G(^MAGV(2005.62,STUDYIEN,6)) "RTN","MAGVRS61",113,0) . . S PROCIEN=$P(PATPROC,U,1) "RTN","MAGVRS61",114,0) . . S PRIEN=$P(PATPROC,U,3) "RTN","MAGVRS61",115,0) . . Q "RTN","MAGVRS61",116,0) . Q "RTN","MAGVRS61",117,0) I $G(PROCIEN)="" Q LINK ; Not linked to a procedure ref "RTN","MAGVRS61",118,0) I $G(PRIEN)="" Q LINK ; Not linked to a procedure ref "RTN","MAGVRS61",119,0) S PROCCASE=$P(^MAGV(2005.61,PROCIEN,0),U,1) "RTN","MAGVRS61",120,0) S PRDFN=$P($G(^MAGV(2005.6,PRIEN,0)),U,1) "RTN","MAGVRS61",121,0) I PRDFN=DFN,ACCESSION=PROCCASE S LINK=1 "RTN","MAGVRS61",122,0) I TYPE="SERIES",LINK,STUDUIDA'=STUDUIDB S LINK=0 "RTN","MAGVRS61",123,0) I TYPE="SOP",LINK,((STUDUIDA'=STUDUIDB)!(SERUIDA'=SERUIDB)) S LINK=0 "RTN","MAGVRS61",124,0) I LINK=1,TYPE="SOP",AOF'=1 S LINK="NOT AOF" Q LINK "RTN","MAGVRS61",125,0) I $G(STATUS)="I" Q 2 ; P162 DAC - Check Status after AOF check. No accessible record found. "RTN","MAGVRS61",126,0) Q LINK "RTN","MAGVRS61",127,0) LOGDUP(ORIGUID,NEWUID,ACCESSION,DFN,TYPE,STUDYUID,SERUID) ; Log duplicate UIDs "RTN","MAGVRS61",128,0) N FDA,FILE,ONEWUID,SOCTYPE "RTN","MAGVRS61",129,0) S ONEWUID=NEWUID ; Store original generated NEWUID with postfix "RTN","MAGVRS61",130,0) I TYPE="SERIES",STUDYUID="" S NEWUID="-1~No Study UID provided" Q "RTN","MAGVRS61",131,0) I TYPE="SOP",STUDYUID="" S NEWUID="-1~No Study UID provided" Q "RTN","MAGVRS61",132,0) I TYPE="SOP",SERUID="" S NEWUID="-1~No Series UID provided" Q "RTN","MAGVRS61",133,0) L +^MAGV(2005.66,"C",ONEWUID):1E9 ; Lock generated UID "RTN","MAGVRS61",134,0) I TYPE="STUDY" S SOCTYPE=1 "RTN","MAGVRS61",135,0) I TYPE="SERIES" S SOCTYPE=2 "RTN","MAGVRS61",136,0) I TYPE="SOP" S SOCTYPE=3 "RTN","MAGVRS61",137,0) S FILE=2005.66 "RTN","MAGVRS61",138,0) D LOGLOOK(.NEWUID) "RTN","MAGVRS61",139,0) S FDA(FILE,"+1,",.01)=ORIGUID "RTN","MAGVRS61",140,0) S FDA(FILE,"+1,",2)=NEWUID "RTN","MAGVRS61",141,0) S FDA(FILE,"+1,",3)=ACCESSION "RTN","MAGVRS61",142,0) S FDA(FILE,"+1,",4)=DFN "RTN","MAGVRS61",143,0) S FDA(FILE,"+1,",5)=SOCTYPE "RTN","MAGVRS61",144,0) I $G(STUDYUID)'="" S FDA(FILE,"+1,",6)=STUDYUID "RTN","MAGVRS61",145,0) I $G(SERUID)'="" S FDA(FILE,"+1,",7)=SERUID "RTN","MAGVRS61",146,0) D UPDATE^DIE("","FDA") "RTN","MAGVRS61",147,0) L -^MAGV(2005.66,"C",ONEWUID) ; Unlock original generated UID "RTN","MAGVRS61",148,0) I NEWUID'=ONEWUID L -^MAGV(2005.66,"C",NEWUID) ; Unlock new generated UID with postfix "RTN","MAGVRS61",149,0) K FDA "RTN","MAGVRS61",150,0) Q "RTN","MAGVRS61",151,0) LOGLOOK(NEWUID) ; Look for UID in duplicate log and generate a new UID if there is a duplicate "RTN","MAGVRS61",152,0) N POSTFIX "RTN","MAGVRS61",153,0) I '$$UIDCHECK(NEWUID) F POSTFIX=1:1 Q:$$UIDCHECK(NEWUID_"."_POSTFIX) "RTN","MAGVRS61",154,0) I $G(POSTFIX)'="" D "RTN","MAGVRS61",155,0) . S NEWUID=NEWUID_"."_POSTFIX "RTN","MAGVRS61",156,0) . L +^MAGV(2005.66,"C",NEWUID):1E9 "RTN","MAGVRS61",157,0) . Q "RTN","MAGVRS61",158,0) Q "RTN","MAGVRS61",159,0) UIDCHECK(POSTUID) ; Check if newly generated UID exists in UID database indexes "RTN","MAGVRS61",160,0) ; If UID is found return 0, if UID is not found return 1 "RTN","MAGVRS61",161,0) N UNIQUE "RTN","MAGVRS61",162,0) S UNIQUE=1 "RTN","MAGVRS61",163,0) D ; Check file indexes for UID "RTN","MAGVRS61",164,0) . ; Check for duplicate in new UID log "RTN","MAGVRS61",165,0) . I $D(^MAGV(2005.66,"C",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",166,0) . ; Check for duplicate Study and SOP in 2005 "RTN","MAGVRS61",167,0) . I $D(^MAG(2005,"P",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",168,0) . ; Check for duplicate Series in 2005 "RTN","MAGVRS61",169,0) . I $D(^MAG(2005,"SERIESUID",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",170,0) . ; Check for duplicate Study in 2005.62 "RTN","MAGVRS61",171,0) . I $D(^MAGV(2005.62,"B",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",172,0) . ; Check for duplicate Series in 2005.63 "RTN","MAGVRS61",173,0) . I $D(^MAGV(2005.63,"B",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",174,0) . ; Check for duplicate SOP in 2005.64 "RTN","MAGVRS61",175,0) . I $D(^MAGV(2005.64,"B",POSTUID)) S UNIQUE=0 Q "RTN","MAGVRS61",176,0) . Q "RTN","MAGVRS61",177,0) Q UNIQUE "RTN","MAGVRS61",178,0) UIDLOOK(UID,DFN,ACC,TYPE,STUDYUID,SERUID) ; Look to see if Original UID exists and if entry matches DFN and ACC provided. If so, return New UID. Otherwise, 0. "RTN","MAGVRS61",179,0) N OUT,IEN,ENTRY,ENTRY2,STYPE "RTN","MAGVRS61",180,0) S OUT=0 "RTN","MAGVRS61",181,0) I (UID="")!($G(DFN)="")!($G(ACC)="")!($G(TYPE)="") Q OUT "RTN","MAGVRS61",182,0) I '$D(^MAGV(2005.66,"B",UID)) Q OUT "RTN","MAGVRS61",183,0) I TYPE="SERIES",$G(STUDYUID)="" Q OUT "RTN","MAGVRS61",184,0) I TYPE="SOP",($G(SERUID)="")!($G(STUDYUID)="") Q OUT "RTN","MAGVRS61",185,0) I TYPE="SERIES" I '$D(^MAGV(2005.66,"D",UID,$G(STUDYUID))) Q OUT "RTN","MAGVRS61",186,0) I TYPE="SOP" I '$D(^MAGV(2005.66,"E",UID,$G(SERUID))) Q OUT "RTN","MAGVRS61",187,0) S IEN="" "RTN","MAGVRS61",188,0) F S IEN=$O(^MAGV(2005.66,"B",UID,IEN)) Q:(IEN="")!(OUT'=0) D "RTN","MAGVRS61",189,0) . S ENTRY=$G(^MAGV(2005.66,IEN,0)) "RTN","MAGVRS61",190,0) . S ENTRY2=$G(^MAGV(2005.66,IEN,1)) "RTN","MAGVRS61",191,0) . S STYPE=$P($$GET1^DIQ(2005.66,IEN,5)," ",1) "RTN","MAGVRS61",192,0) . I DFN=$P(ENTRY,U,4),ACC=$P(ENTRY,U,3),TYPE=STYPE D "RTN","MAGVRS61",193,0) . . I TYPE="STUDY",$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q "RTN","MAGVRS61",194,0) . . I TYPE="SERIES",$G(STUDYUID)=$P(ENTRY2,U,1),$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q "RTN","MAGVRS61",195,0) . . I TYPE="SOP",$G(STUDYUID)=$P(ENTRY2,U,1),$G(SERUID)=$P(ENTRY2,U,2),$G(UID)=$P(ENTRY,U,1) S OUT=$P(ENTRY,U,2) Q "RTN","MAGVRS61",196,0) Q OUT "RTN","MAGVRS61",197,0) DELLOG(OUT,IEN,FILE) ; Remove inactivated entries from the duplicate log "RTN","MAGVRS61",198,0) N DUPIEN,PIEN,ACC,DFN,SOPUID,SERUID,STUDUID,TYPE,ERR,UID,PATIEN,SSEP,PROCIEN,PATID,DUPDATA1,DUPDATA2 "RTN","MAGVRS61",199,0) N DUPACC,DUPPATID,DSERUID,IENS,FDA,DSTDUID,STUDDATA,DELETE "RTN","MAGVRS61",200,0) ; "RTN","MAGVRS61",201,0) S OUT="0" "RTN","MAGVRS61",202,0) S SSEP=$$STATSEP^MAGVRS41 "RTN","MAGVRS61",203,0) I (FILE'=2005.64)&(FILE'=2005.63)&(FILE'=2005.62) S OUT="-1"_SSEP_"Invalid file number" Q "RTN","MAGVRS61",204,0) I IEN="" S OUT="-7"_SSEP_"No IEN provided" Q "RTN","MAGVRS61",205,0) I FILE=2005.64 D "RTN","MAGVRS61",206,0) . S (SOPUID,UID)=$P($G(^MAGV(2005.64,IEN,0)),U,1) "RTN","MAGVRS61",207,0) . S IEN=$P($G(^MAGV(2005.64,IEN,6)),U,1) "RTN","MAGVRS61",208,0) . Q "RTN","MAGVRS61",209,0) I IEN="" S OUT="-8"_SSEP_"No Parent Record" Q "RTN","MAGVRS61",210,0) I FILE>=2005.63 D "RTN","MAGVRS61",211,0) . I FILE=2005.64 S SERUID=$P($G(^MAGV(2005.63,IEN,0)),U,2) "RTN","MAGVRS61",212,0) . I FILE=2005.63 S SERUID=$P($G(^MAGV(2005.63,IEN,0)),U,1) "RTN","MAGVRS61",213,0) . I '$D(UID) S UID=SERUID "RTN","MAGVRS61",214,0) . S IEN=$P($G(^MAGV(2005.63,IEN,6)),U,1) "RTN","MAGVRS61",215,0) . Q "RTN","MAGVRS61",216,0) I IEN="" S OUT="-8"_SSEP_"No Parent Record" Q "RTN","MAGVRS61",217,0) I FILE>=2005.62 D "RTN","MAGVRS61",218,0) . I FILE=2005.62 S STUDUID=$P($G(^MAGV(2005.62,IEN,0)),U,1) "RTN","MAGVRS61",219,0) . I FILE'=2005.62 S STUDUID=$P($G(^MAGV(2005.62,IEN,0)),U,2) "RTN","MAGVRS61",220,0) . I '$D(UID) S UID=STUDUID "RTN","MAGVRS61",221,0) . S STUDDATA=$G(^MAGV(2005.62,IEN,6)) "RTN","MAGVRS61",222,0) . S PATIEN=$P(STUDDATA,U,3) "RTN","MAGVRS61",223,0) . S PROCIEN=$P(STUDDATA,U,1) "RTN","MAGVRS61",224,0) . I (PROCIEN="")!(PATIEN="") Q "RTN","MAGVRS61",225,0) . S ACC=$P($G(^MAGV(2005.61,PROCIEN,0)),U,1) "RTN","MAGVRS61",226,0) . S PATID=$P($G(^MAGV(2005.6,PATIEN,0)),U,1) "RTN","MAGVRS61",227,0) . Q "RTN","MAGVRS61",228,0) I PATIEN="" S OUT="-9"_SSEP_"No Patient Record" Q "RTN","MAGVRS61",229,0) I PROCIEN="" S OUT="-10"_SSEP_"No Procedure Record" Q "RTN","MAGVRS61",230,0) S DUPIEN="" "RTN","MAGVRS61",231,0) F DUPIEN=$O(^MAGV(2005.66,"C",UID,DUPIEN)) Q:DUPIEN="" D "RTN","MAGVRS61",232,0) . S DUPDATA1=$G(^MAGV(2005.66,DUPIEN,0)) "RTN","MAGVRS61",233,0) . S DUPDATA2=$G(^MAGV(2005.66,DUPIEN,1)) "RTN","MAGVRS61",234,0) . S DUPACC=$P(DUPDATA1,U,3),DUPPATID=$P(DUPDATA1,U,4) "RTN","MAGVRS61",235,0) . S DSTDUID=$P(DUPDATA2,U,1),DSERUID=$P(DUPDATA2,U,2) "RTN","MAGVRS61",236,0) . S DELETE=0 "RTN","MAGVRS61",237,0) . I FILE=2005.64,ACC=DUPACC,PATID=DUPPATID,((STUDUID=DSTDUID)!('DSTDUID)),(($G(SERUID)=DSERUID)!('DSERUID)) S DELETE=1 ; SOP Check "RTN","MAGVRS61",238,0) . I FILE=2005.63,ACC=DUPACC,PATID=DUPPATID,((STUDUID=DSTDUID)!('DSTDUID)) S DELETE=1 ; Series Check "RTN","MAGVRS61",239,0) . I FILE=2005.62,ACC=DUPACC,PATID=DUPPATID S DELETE=1 ; Study Check "RTN","MAGVRS61",240,0) . I DELETE D "RTN","MAGVRS61",241,0) . . ; Delete matching duplicate entries "RTN","MAGVRS61",242,0) . . S IENS=DUPIEN_"," "RTN","MAGVRS61",243,0) . . S FDA(2005.66,IENS,.01)="@" "RTN","MAGVRS61",244,0) . . D FILE^DIE("","FDA","ERR") "RTN","MAGVRS61",245,0) . . S OUT="0" "RTN","MAGVRS61",246,0) . . I $D(ERR("DIERR")) S OUT="-11"_SSEP_$G(ERR("DIERR",1,"TEXT",1)) "RTN","MAGVRS61",247,0) . . Q "RTN","MAGVRS61",248,0) . Q "RTN","MAGVRS61",249,0) Q "RTN","MAGVRS61",250,0) ; "VER") 8.0^22.0 "^DD",2006.931,2006.931,0) FIELD^^.01^1 "^DD",2006.931,2006.931,0,"DDA") N "^DD",2006.931,2006.931,0,"DT") 3110131 "^DD",2006.931,2006.931,0,"IX","B",2006.931,.01) "^DD",2006.931,2006.931,0,"NM","IMAGING EVENT AUDITABLE ACTION") "^DD",2006.931,2006.931,0,"PT",2006.93,1) "^DD",2006.931,2006.931,0,"VRPK") MAG "^DD",2006.931,2006.931,.01,0) NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",2006.931,2006.931,.01,1,0) ^.1 "^DD",2006.931,2006.931,.01,1,1,0) 2006.931^B "^DD",2006.931,2006.931,.01,1,1,1) S ^MAGV(2006.931,"B",$E(X,1,30),DA)="" "^DD",2006.931,2006.931,.01,1,1,2) K ^MAGV(2006.931,"B",$E(X,1,30),DA) "^DD",2006.931,2006.931,.01,3) Answer must be 3-30 characters in length. "^DD",2006.931,2006.931,.01,21,0) ^^1^1^3110131^ "^DD",2006.931,2006.931,.01,21,1,0) This is the name of an action to be audited. "^DD",2006.931,2006.931,.01,"DT") 3110131 "^DIC",2006.931,2006.931,0) IMAGING EVENT AUDITABLE ACTION^2006.931 "^DIC",2006.931,2006.931,0,"GL") ^MAGV(2006.931, "^DIC",2006.931,2006.931,"%",0) ^1.005^^0 "^DIC",2006.931,2006.931,"%D",0) ^^18^18^3110216^ "^DIC",2006.931,2006.931,"%D",1,0) +---------------------------------------------------------------+ "^DIC",2006.931,2006.931,"%D",2,0) | | "^DIC",2006.931,2006.931,"%D",3,0) | Property of the US Government. | "^DIC",2006.931,2006.931,"%D",4,0) | No permission to copy or redistribute this software is given. | "^DIC",2006.931,2006.931,"%D",5,0) | Use of unreleased versions of this software requires the user | "^DIC",2006.931,2006.931,"%D",6,0) | to execute a written test agreement with the VistA Imaging | "^DIC",2006.931,2006.931,"%D",7,0) | Development Office of the Department of Veterans Affairs, | "^DIC",2006.931,2006.931,"%D",8,0) | telephone (301) 734-0100. | "^DIC",2006.931,2006.931,"%D",9,0) | | "^DIC",2006.931,2006.931,"%D",10,0) | The Food and Drug Administration classifies this software as | "^DIC",2006.931,2006.931,"%D",11,0) | a medical device. As such, it may not be changed in any way. | "^DIC",2006.931,2006.931,"%D",12,0) | Modifications to this software may result in an adulterated | "^DIC",2006.931,2006.931,"%D",13,0) | medical device under 21CFR820, the use of which is considered | "^DIC",2006.931,2006.931,"%D",14,0) | to be a violation of US Federal Statutes. | "^DIC",2006.931,2006.931,"%D",15,0) | | "^DIC",2006.931,2006.931,"%D",16,0) +---------------------------------------------------------------+ "^DIC",2006.931,2006.931,"%D",17,0) "^DIC",2006.931,2006.931,"%D",18,0) This file contains VistA Imaging auditable events. "^DIC",2006.931,"B","IMAGING EVENT AUDITABLE ACTION",2006.931) **END** **END**