MAGVIM09 ;WOIFO/DAC,MAT,JSJ,RRM,BT,JSL - Utilities for RPC calls for DICOM file processing ; Oct 04, 2022@19:19:13
;;3.0;IMAGING;**118,138,332,345,357**;Mar 19, 2002;Build 29
;; Per VA Directive 6402, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
; +++++ Get a record from a WORK ITEM file (#2006.941) by IEN
;
; Input parameters
; ================
; ID = IEN in the file
; STARTCNT = starting line in OUT array
;
; Return Values
; =============
; OUT(STARTCNT)="WorkItemHeader"_delimited "`" fields values
; OUT(STARTCNT+1..n)=Message
; OUT(n+1..m)=Tags`TagName`TagValue
;
GETWI(OUT,ID,STOPTAG,SRV) ; Return Work Item record in OUT array
; OUT - array that holds the result
; ID - IEN of the Work Item
; STOPTAG - The last tag of a record to be returned (optional)
N FILE,IENS,MAGOUT,ERR,FLD,CNT,TAGS,I,AFLD,DATA
N SSEP,OSEP,STOP,TAGNAME,TAGVALUE
S SSEP=$$STATSEP^MAGVIM01,OSEP=$$OUTSEP^MAGVIM01
S FILE=2006.941
S IENS=ID_","
D GETS^DIQ(FILE,ID_",","*","IE","MAGOUT","ERR")
I $D(ERR) S OUT="-1"_SSEP_$G(ERR("DIERR",1,"TEXT",1)) Q
; Type of the return field values - internal, external, date
S AFLD(.01)="D" ; CREATED DATE/TIME
S AFLD(1)="E" ; TYPE
S AFLD(2)="E" ; SUBTYPE
S AFLD(3)="E" ; STATUS
S AFLD(4)="I" ; LOCATION
S AFLD(5)="E" ; PRIORITY
S AFLD(8)="IE" ; CREATING USER
S AFLD(9)="D" ; LAST UPDATED DATE/TIME
S AFLD(10)="IE" ; LAST UPDATING USER
S AFLD(14)="E" ; CREATING APPLICATION
S AFLD(15)="E" ; LAST UPDATING APPLICATION
S AFLD(16)="E" ; SC TRANSACTION ID
;
;Convert Institution IEN to Station Number
I $G(MAGOUT(FILE,IENS,4,"I")) D
. S MAGOUT(FILE,IENS,4,"I")=$$STA^XUAF4(MAGOUT(FILE,IENS,4,"I")) ;IA #2171 Get station number for an IEN
. Q
;
S CNT=OUT(0)+1
S FLD=0
S OUT(CNT)="WorkItemHeader"_SSEP_ID
F S FLD=$O(MAGOUT(FILE,IENS,FLD)) Q:FLD="" D
. Q:FLD=13 ; Word-processing field
. I AFLD(FLD)["D" S OUT(CNT)=OUT(CNT)_OSEP_$$FMTE^XLFDT(MAGOUT(FILE,IENS,FLD,"I"),5) ; Date fields
. I AFLD(FLD)["I" S OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"I")
. I AFLD(FLD)["E" S OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"E")
. Q
; Get Message
S I=0 F S I=$O(MAGOUT(FILE,IENS,13,I)) Q:I'>0 D
. S CNT=CNT+1,OUT(CNT)="Message"_SSEP_MAGOUT(FILE,IENS,13,I)
. Q
; Get Tags
S TAGS=2006.94111,I="",STOP=0
I $G(SRV)'="" S CNT=CNT+1,OUT(CNT)="Tag"_SSEP_"Service"_OSEP_SRV
S I=0
F S I=$O(^MAGV(2006.941,ID,4,I)) Q:I="" D Q:STOP=1
. S DATA=$G(^MAGV(2006.941,ID,4,I,0))
. S TAGNAME=$P(DATA,U,1),TAGVALUE=$P(DATA,U,2)
. S CNT=CNT+1,OUT(CNT)="Tag"_SSEP_TAGNAME_OSEP_TAGVALUE
. I $G(STOPTAG)'="",STOPTAG=TAGNAME S STOP=1
S OUT(0)=CNT
Q
;
;P332 IMSTATUS moved from MAGVIM01 because routine size was exceeded
; RPC: MAGV IMPORT STATUS from MAGVIM01
IMSTATUS(OUT,UIDS) ; Get import status
N SSEP,STUDYLIST,SOPLIST,STUDYOUT,SOPOUT,I,CNT,STUDYUID,SERUID,SOPUID,ISEP,SOPIEN,SERIEN,STUDIEN,FOUNDUID
N ONFILESOP
S SSEP=$$OUTSEP^MAGVIM01,ISEP=$$INPUTSEP^MAGVIM01,I=0,CNT=0 ;P332 add routine to calls
I '$D(UIDS) S OUT(1)=-6_SSEP_"No UIDs provided" Q
F S I=$O(UIDS(I)) Q:I="" D
. S CNT=I,FOUNDUID="",ONFILESOP=0
. S STUDYUID=$P(UIDS(I),ISEP,1),SERUID=$P(UIDS(I),ISEP,2),SOPUID=$P(UIDS(I),ISEP,3)
. I $G(STUDYUID)="" S OUT(I+1)=-1_SSEP_"No study UID provided" Q
. I $G(SERUID)="" S OUT(I+1)=-2_SSEP_"No series UID provided" Q
. I $G(SOPUID)="" S OUT(I+1)=-3_SSEP_"No SOP UID provided" Q
. S OUT(I+1)=-1_SSEP_UIDS(I)_SSEP_"not on file"
. S STUDYLIST(1)=1,STUDYLIST(2)=STUDYUID
. S SOPLIST(1)=1,SOPLIST(2)=SOPUID
. ; Check ^MAG(2005) for import study status
. D CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
. I STUDYOUT(2)'="",(+STUDYOUT(2))'<0 D
. . D CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
. . I SOPOUT(2)'="",(+SOPOUT(2))'<0 D S CNT=I
. . . S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. . . S ONFILESOP=1
. . . Q
. . Q
. I $G(STUDYOUT(2))="",$G(ONFILESOP)<1 D SOPCHECK(.UIDS,I) Q:$G(ONFILESOP)
. S SOPOUT=""
. ; Check SOP original and UID
. I ('$D(^MAGV(2005.64,"B",SOPUID)))&('$D(^MAGV(2005.66,"B",SOPUID))) D SOPCHECK(.UIDS,I) Q
. S SOPIEN=$O(^MAGV(2005.64,"B",SOPUID,""),-1)
. ;if null try dup(replaced) UID
. I SOPIEN="" S SOPIEN=$$DUPUID(.UIDS,I,SOPUID,3) ;P332 Check for replacement
. Q:SOPIEN=""
. I $G(^MAGV(2005.64,SOPIEN,11))'="A" Q
. ; Check Series original and UID
. I ('$D(^MAGV(2005.63,"B",SERUID)))&('$D(^MAGV(2005.66,"B",SERUID))) D Q:$G(FOUNDUID)=""
. . I $G(SOPIEN)'="" S FOUNDUID=$$RECHKFLE(.UIDS,I,SOPUID,2)
. S SERIEN=$O(^MAGV(2005.63,"B",$S($G(FOUNDUID)'="":FOUNDUID,1:SERUID),""),-1)
. ;if null try dup(replaced) UID
. I SERIEN="" S SERIEN=$$DUPUID(.UIDS,I,SERUID,2) ;P332 Check for replacement
. Q:SERIEN=""
. I $G(^MAGV(2005.63,SERIEN,9))'="A" Q
. ; Check Study original and UID
. I ('$D(^MAGV(2005.62,"B",STUDYUID)))&('$D(^MAGV(2005.66,"B",STUDYUID))) D Q:$G(FOUNDUID)=""
. . I $G(SERIEN)'="" S FOUNDUID=$$RECHKFLE(.UIDS,I,SERUID,1)
. S STUDIEN=$O(^MAGV(2005.62,"B",$S($G(FOUNDUID)'="":FOUNDUID,1:STUDYUID),""),-1)
. ;if null try dup(replaced) UID
. I STUDIEN="" S STUDIEN=$$DUPUID(.UIDS,I,STUDYUID,1) ;P332 Check for replacement
. Q:STUDIEN=""
. I $P($G(^MAGV(2005.62,STUDIEN,5)),U,2)'="A" Q
. S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. I SOPIEN'="" S ONFILESOP=1
. Q
;
S OUT(1)=0_SSEP_CNT
Q
;
SOPCHECK(UIDS,I) ;
N MAG2005IEN,MAGPARENTIEN
S SOPUID=$P(UIDS(I),ISEP,3)
I $D(^MAG(2005,"P",SOPUID)) D
. D CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
. I SOPOUT(2)'="",(+SOPOUT(2))'<0 D
. . D CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
. . I SOPOUT(2)'="",(+SOPOUT(2))'<0 S OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
. . S ONFILESOP=1
Q
;
RECHKFLE(UIDS,I,UID,TYPE) ;
N FILE,NEWUID
I TYPE=1 S FILE=2005.63
I TYPE=2 S FILE=2005.64
I $D(^MAGV(FILE,"B",UID)) D
. S IEN=$O(^MAGV(FILE,"B",UID,""))
. S IEN=$P(^MAGV(FILE,IEN,6),"^")
. I TYPE=1 D
. . S NEWUID=$P($G(^MAGV(2005.62,IEN,0)),"^")
. . ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
. I TYPE=2 D
. . S NEWUID=$P($G(^MAGV(2005.63,IEN,0)),"^")
. . ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
Q $G(NEWUID) ;SF prevent UNDEF errors
;
;Set replaced UID in UIDS array if found in 2005.66 duplicate file
DUPUID(UIDS,I,UID,TYPE) ;P332 added sub
; UIDS - Array of UIDs
; I - Current array element of UIDS being processed
; UID - Original UID of TYPE being checked for duplicate
; TYPE - UID type - 1-STUDY, 2-SERIES, 3-SOP
I UID=""!(TYPE="") Q ""
NEW IEN,FILE,REC0,RPLFND,RPLIEN
S FILE=$P("2005.62,2005.63,2005.64",",",TYPE)
S (IEN,RPLIEN,RPLFND)=""
;loop dup index from latest and quit if a match is found
F S RPLIEN=$O(^MAGV(2005.66,"B",UID,RPLIEN),-1) Q:(RPLIEN="")!RPLFND D
. S REC0=$G(^MAGV(2005.66,RPLIEN,0))
. I TYPE'=$P(REC0,U,5) Q ;UID type mismatch
. I UID'=$P(REC0,U) Q ;UID doesn't match orig in dup record
. ;verify dup UID is in file index and UID matches original UID in FILE
. S IEN=$O(^MAGV(FILE,"B",$P(REC0,U,2),""),-1) ;get IEN from file with replaced UID
. I IEN="" Q ;replaced UID not in FILE index
. I UID'=$P($G(^MAGV(FILE,IEN,0)),"^",2) Q ;original UID does not match
. S $P(UIDS(I),ISEP,TYPE)=$P(REC0,U,2) ;set replacement UID
. S RPLFND=1 ;quit loop
Q IEN ;return FILE IEN for replaced UID (or null if not found)
;
; RPC: MAGV FIND WORK ITEM (Calling from FIND^MAGVIM01)
FIND(OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,STOPTAG,MAXROWS,TAGS,LASTIEN,ORDER,DTFROM,DTTO) ; Find records with given attributes - return ID
;PLACEID is FILE #4's STATION NUMBER
N IEN,IEN2,J,TAGMATCH,SSEP,ISEP,TAG,WICOUNT,FLD
N VALUE,FLDS,AFLD,NOMATCH,IENS,MAGOUT,LOCIEN,SRV
N TAGITM,PATNAME,GLB,FLTITM,RET
S SSEP=$$STATSEP^MAGVIM01,ISEP=$$INPUTSEP^MAGVIM01
S:'$G(DTFROM) DTFROM=0
S:'$G(DTTO) DTTO=9999999
;
I $G(MAXROWS)'="",'(MAXROWS?1N.N) S OUT=-2_SSEP_"Invalid MAXROWS parameter provided" Q
;
I $G(PLACEID)'="" D Q:$G(OUT)<0
. S LOCIEN=$$IEN^XUAF4(PLACEID) ;IA #2171 Get Institution IEN for a station number
. I LOCIEN="" S OUT=-2_SSEP_"Invalid PLACEID parameter provided"
. Q
;
S OUT(0)=0
; AFLD(FLD,"IE") = compare the external or internal value of the field
S FLDS=""
I $G(TYPE)'="" S FLDS=FLDS_"1;",AFLD(1)=TYPE,AFLD(1,"IE")="E"
I $G(SUBTYPE)'="" S FLDS=FLDS_"2;",AFLD(2)=SUBTYPE,AFLD(2,"IE")="E"
I $G(STATUS)'="" S FLDS=FLDS_"3;",AFLD(3)=STATUS,AFLD(3,"IE")="E"
I $G(LOCIEN)'="" S FLDS=FLDS_"4;",AFLD(4)=LOCIEN,AFLD(4,"IE")="I"
I $G(PRIORITY)'="" S FLDS=FLDS_"5;",AFLD(5)=PRIORITY,AFLD(5,"IE")="E"
;
K FLTITM S RET=$$GFLTITM^MAGVIM01(.FLTITM,.TAGS) ;filter Source, Service, Modality, and Procedure
I RET S GLB="FLTITM"
I 'RET S GLB="^MAGV(2006.941)"
;
K ERR
S:'$G(ORDER) ORDER=1
I '$G(LASTIEN) D
. I ORDER=1 S LASTIEN=0
. I ORDER=-1 S LASTIEN=9999999
S IEN=LASTIEN,WICOUNT=1
;
F S IEN=$O(@GLB@(IEN),ORDER) Q:(+IEN=0)!$D(ERR)!(($G(MAXROWS)'="")&(WICOUNT>$G(MAXROWS))) D
. Q:'$$DTINRNG^MAGVIM01(IEN,DTFROM,DTTO)
. S IENS=IEN_"," K ERR,MAGOUT
. D GETS^DIQ(2006.941,IENS,FLDS,"IE","MAGOUT","ERR")
. I $D(ERR) K OUT S OUT(0)=-1_SSEP_$G(ERR("DIERR",1,"TEXT",1)) Q ; Set Error and quit
. S FLD="",NOMATCH=0
. F S FLD=$O(AFLD(FLD)) Q:FLD=""!NOMATCH D
. . S:AFLD(FLD)'=MAGOUT("2006.941",IENS,FLD,AFLD(FLD,"IE")) NOMATCH=1
. . Q
. Q:NOMATCH ; get next one if no match
. ; Tag matching
. S SRV=$$SRV^MAGVIM01(IEN),J=0,TAGMATCH=1
. F S J=$O(TAGS(J)) Q:(J="")!'TAGMATCH D
. . S TAG=$P(TAGS(J),ISEP,1),VALUE=$P(TAGS(J),ISEP,2)
. . I TAG="Procedure",VALUE="[No Procedure]",'$D(^MAGV(2006.941,"H",TAG,IEN)) Q
. . I TAG="Modality",VALUE="[No Modality]",'$D(^MAGV(2006.941,"H",TAG,IEN)) Q
. . I TAG="Service",VALUE'="" D Q
. . . I VALUE="[No Service]",SRV="" Q
. . . I SRV'=VALUE S TAGMATCH=0
. . I TAG="PatientName",VALUE'="",'$D(^MAGV(2006.941,"H",TAG,IEN)) S TAGMATCH=0 Q
. . I TAG="PatientName",VALUE'="",$D(^MAGV(2006.941,"H",TAG,IEN)) D Q
. . . S TAGITM=$O(^MAGV(2006.941,"H",TAG,IEN,"")) I TAGITM="" S TAGMATCH=0 Q
. . . S PATNAME=$P($G(^MAGV(2006.941,IEN,4,TAGITM,0)),U,2) I PATNAME="" S TAGMATCH=0 Q
. . . I '$F($$UPCASE(PATNAME),$$UPCASE(VALUE)) S TAGMATCH=0 Q
. . I VALUE'="",$L(VALUE)<31,'$D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) S TAGMATCH=0 Q
. . I VALUE'="",$L(VALUE)<31,$D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) Q
. . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
. . I $P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)'=VALUE S TAGMATCH=0
. . Q
. I 'TAGMATCH Q
. ; Add work item header to output array
. D GETWI^MAGVIM09(.OUT,IEN,"",SRV) ; Get Work Item Record
. I +OUT(0)<0 S ERR="" ; Check for error and set ERR to quit from the loop
. S WICOUNT=WICOUNT+1
. S LASTIEN=IEN
. Q
;Save the last IEN processed, used to retrieve more rows
I IEN,'$D(ERR) S OUT(0)=OUT(0)_SSEP_LASTIEN
Q
;
UPDWI(ID,FDA,MSGUPD) ; Update work item
; Return 0|Error`Message error
;
; ID - IEN of Work Item
; FDA - VA FileMan FDA array
; MSGUPD - Message array
N ERR,SSEP
S SSEP=$$STATSEP^MAGVIM01
;
D VALIDATE^MAGVIM06(.FDA,.ERR)
I $D(ERR("DIERR",1,"TEXT",1)) Q -4_SSEP_$G(ERR("DIERR",1,"TEXT",1))
;
K ERR
D FILE^DIE("E","FDA","ERR")
I $D(ERR("DIERR",1,"TEXT",1)) Q -3_SSEP_$G(ERR("DIERR",1,"TEXT",1))
;
; Update Message field
K ERR
I $D(MSGUPD) D WP^DIE(2006.941,ID_",",13,"K","MSGUPD","ERR")
I $D(ERR("DIERR",1,"TEXT",1)) Q -5_SSEP_$G(ERR("DIERR",1,"TEXT",1))
;
Q 0_SSEP_"Work item "_ID_" updated"
;
UPCASE(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM09 12640 printed Dec 13, 2024@02:09:56 Page 2
MAGVIM09 ;WOIFO/DAC,MAT,JSJ,RRM,BT,JSL - Utilities for RPC calls for DICOM file processing ; Oct 04, 2022@19:19:13
+1 ;;3.0;IMAGING;**118,138,332,345,357**;Mar 19, 2002;Build 29
+2 ;; Per VA Directive 6402, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+19 ; +++++ Get a record from a WORK ITEM file (#2006.941) by IEN
+20 ;
+21 ; Input parameters
+22 ; ================
+23 ; ID = IEN in the file
+24 ; STARTCNT = starting line in OUT array
+25 ;
+26 ; Return Values
+27 ; =============
+28 ; OUT(STARTCNT)="WorkItemHeader"_delimited "`" fields values
+29 ; OUT(STARTCNT+1..n)=Message
+30 ; OUT(n+1..m)=Tags`TagName`TagValue
+31 ;
GETWI(OUT,ID,STOPTAG,SRV) ; Return Work Item record in OUT array
+1 ; OUT - array that holds the result
+2 ; ID - IEN of the Work Item
+3 ; STOPTAG - The last tag of a record to be returned (optional)
+4 NEW FILE,IENS,MAGOUT,ERR,FLD,CNT,TAGS,I,AFLD,DATA
+5 NEW SSEP,OSEP,STOP,TAGNAME,TAGVALUE
+6 SET SSEP=$$STATSEP^MAGVIM01
SET OSEP=$$OUTSEP^MAGVIM01
+7 SET FILE=2006.941
+8 SET IENS=ID_","
+9 DO GETS^DIQ(FILE,ID_",","*","IE","MAGOUT","ERR")
+10 IF $DATA(ERR)
SET OUT="-1"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
QUIT
+11 ; Type of the return field values - internal, external, date
+12 ; CREATED DATE/TIME
SET AFLD(.01)="D"
+13 ; TYPE
SET AFLD(1)="E"
+14 ; SUBTYPE
SET AFLD(2)="E"
+15 ; STATUS
SET AFLD(3)="E"
+16 ; LOCATION
SET AFLD(4)="I"
+17 ; PRIORITY
SET AFLD(5)="E"
+18 ; CREATING USER
SET AFLD(8)="IE"
+19 ; LAST UPDATED DATE/TIME
SET AFLD(9)="D"
+20 ; LAST UPDATING USER
SET AFLD(10)="IE"
+21 ; CREATING APPLICATION
SET AFLD(14)="E"
+22 ; LAST UPDATING APPLICATION
SET AFLD(15)="E"
+23 ; SC TRANSACTION ID
SET AFLD(16)="E"
+24 ;
+25 ;Convert Institution IEN to Station Number
+26 IF $GET(MAGOUT(FILE,IENS,4,"I"))
Begin DoDot:1
+27 ;IA #2171 Get station number for an IEN
SET MAGOUT(FILE,IENS,4,"I")=$$STA^XUAF4(MAGOUT(FILE,IENS,4,"I"))
+28 QUIT
End DoDot:1
+29 ;
+30 SET CNT=OUT(0)+1
+31 SET FLD=0
+32 SET OUT(CNT)="WorkItemHeader"_SSEP_ID
+33 FOR
SET FLD=$ORDER(MAGOUT(FILE,IENS,FLD))
if FLD=""
QUIT
Begin DoDot:1
+34 ; Word-processing field
if FLD=13
QUIT
+35 ; Date fields
IF AFLD(FLD)["D"
SET OUT(CNT)=OUT(CNT)_OSEP_$$FMTE^XLFDT(MAGOUT(FILE,IENS,FLD,"I"),5)
+36 IF AFLD(FLD)["I"
SET OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"I")
+37 IF AFLD(FLD)["E"
SET OUT(CNT)=OUT(CNT)_OSEP_MAGOUT(FILE,IENS,FLD,"E")
+38 QUIT
End DoDot:1
+39 ; Get Message
+40 SET I=0
FOR
SET I=$ORDER(MAGOUT(FILE,IENS,13,I))
if I'>0
QUIT
Begin DoDot:1
+41 SET CNT=CNT+1
SET OUT(CNT)="Message"_SSEP_MAGOUT(FILE,IENS,13,I)
+42 QUIT
End DoDot:1
+43 ; Get Tags
+44 SET TAGS=2006.94111
SET I=""
SET STOP=0
+45 IF $GET(SRV)'=""
SET CNT=CNT+1
SET OUT(CNT)="Tag"_SSEP_"Service"_OSEP_SRV
+46 SET I=0
+47 FOR
SET I=$ORDER(^MAGV(2006.941,ID,4,I))
if I=""
QUIT
Begin DoDot:1
+48 SET DATA=$GET(^MAGV(2006.941,ID,4,I,0))
+49 SET TAGNAME=$PIECE(DATA,U,1)
SET TAGVALUE=$PIECE(DATA,U,2)
+50 SET CNT=CNT+1
SET OUT(CNT)="Tag"_SSEP_TAGNAME_OSEP_TAGVALUE
+51 IF $GET(STOPTAG)'=""
IF STOPTAG=TAGNAME
SET STOP=1
End DoDot:1
if STOP=1
QUIT
+52 SET OUT(0)=CNT
+53 QUIT
+54 ;
+55 ;P332 IMSTATUS moved from MAGVIM01 because routine size was exceeded
+56 ; RPC: MAGV IMPORT STATUS from MAGVIM01
IMSTATUS(OUT,UIDS) ; Get import status
+1 NEW SSEP,STUDYLIST,SOPLIST,STUDYOUT,SOPOUT,I,CNT,STUDYUID,SERUID,SOPUID,ISEP,SOPIEN,SERIEN,STUDIEN,FOUNDUID
+2 NEW ONFILESOP
+3 ;P332 add routine to calls
SET SSEP=$$OUTSEP^MAGVIM01
SET ISEP=$$INPUTSEP^MAGVIM01
SET I=0
SET CNT=0
+4 IF '$DATA(UIDS)
SET OUT(1)=-6_SSEP_"No UIDs provided"
QUIT
+5 FOR
SET I=$ORDER(UIDS(I))
if I=""
QUIT
Begin DoDot:1
+6 SET CNT=I
SET FOUNDUID=""
SET ONFILESOP=0
+7 SET STUDYUID=$PIECE(UIDS(I),ISEP,1)
SET SERUID=$PIECE(UIDS(I),ISEP,2)
SET SOPUID=$PIECE(UIDS(I),ISEP,3)
+8 IF $GET(STUDYUID)=""
SET OUT(I+1)=-1_SSEP_"No study UID provided"
QUIT
+9 IF $GET(SERUID)=""
SET OUT(I+1)=-2_SSEP_"No series UID provided"
QUIT
+10 IF $GET(SOPUID)=""
SET OUT(I+1)=-3_SSEP_"No SOP UID provided"
QUIT
+11 SET OUT(I+1)=-1_SSEP_UIDS(I)_SSEP_"not on file"
+12 SET STUDYLIST(1)=1
SET STUDYLIST(2)=STUDYUID
+13 SET SOPLIST(1)=1
SET SOPLIST(2)=SOPUID
+14 ; Check ^MAG(2005) for import study status
+15 DO CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
+16 IF STUDYOUT(2)'=""
IF (+STUDYOUT(2))'<0
Begin DoDot:2
+17 DO CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
+18 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
Begin DoDot:3
+19 SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+20 SET ONFILESOP=1
+21 QUIT
End DoDot:3
SET CNT=I
+22 QUIT
End DoDot:2
+23 IF $GET(STUDYOUT(2))=""
IF $GET(ONFILESOP)<1
DO SOPCHECK(.UIDS,I)
if $GET(ONFILESOP)
QUIT
+24 SET SOPOUT=""
+25 ; Check SOP original and UID
+26 IF ('$DATA(^MAGV(2005.64,"B",SOPUID)))&('$DATA(^MAGV(2005.66,"B",SOPUID)))
DO SOPCHECK(.UIDS,I)
QUIT
+27 SET SOPIEN=$ORDER(^MAGV(2005.64,"B",SOPUID,""),-1)
+28 ;if null try dup(replaced) UID
+29 ;P332 Check for replacement
IF SOPIEN=""
SET SOPIEN=$$DUPUID(.UIDS,I,SOPUID,3)
+30 if SOPIEN=""
QUIT
+31 IF $GET(^MAGV(2005.64,SOPIEN,11))'="A"
QUIT
+32 ; Check Series original and UID
+33 IF ('$DATA(^MAGV(2005.63,"B",SERUID)))&('$DATA(^MAGV(2005.66,"B",SERUID)))
Begin DoDot:2
+34 IF $GET(SOPIEN)'=""
SET FOUNDUID=$$RECHKFLE(.UIDS,I,SOPUID,2)
End DoDot:2
if $GET(FOUNDUID)=""
QUIT
+35 SET SERIEN=$ORDER(^MAGV(2005.63,"B",$SELECT($GET(FOUNDUID)'="":FOUNDUID,1:SERUID),""),-1)
+36 ;if null try dup(replaced) UID
+37 ;P332 Check for replacement
IF SERIEN=""
SET SERIEN=$$DUPUID(.UIDS,I,SERUID,2)
+38 if SERIEN=""
QUIT
+39 IF $GET(^MAGV(2005.63,SERIEN,9))'="A"
QUIT
+40 ; Check Study original and UID
+41 IF ('$DATA(^MAGV(2005.62,"B",STUDYUID)))&('$DATA(^MAGV(2005.66,"B",STUDYUID)))
Begin DoDot:2
+42 IF $GET(SERIEN)'=""
SET FOUNDUID=$$RECHKFLE(.UIDS,I,SERUID,1)
End DoDot:2
if $GET(FOUNDUID)=""
QUIT
+43 SET STUDIEN=$ORDER(^MAGV(2005.62,"B",$SELECT($GET(FOUNDUID)'="":FOUNDUID,1:STUDYUID),""),-1)
+44 ;if null try dup(replaced) UID
+45 ;P332 Check for replacement
IF STUDIEN=""
SET STUDIEN=$$DUPUID(.UIDS,I,STUDYUID,1)
+46 if STUDIEN=""
QUIT
+47 IF $PIECE($GET(^MAGV(2005.62,STUDIEN,5)),U,2)'="A"
QUIT
+48 SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+49 IF SOPIEN'=""
SET ONFILESOP=1
+50 QUIT
End DoDot:1
+51 ;
+52 SET OUT(1)=0_SSEP_CNT
+53 QUIT
+54 ;
SOPCHECK(UIDS,I) ;
+1 NEW MAG2005IEN,MAGPARENTIEN
+2 SET SOPUID=$PIECE(UIDS(I),ISEP,3)
+3 IF $DATA(^MAG(2005,"P",SOPUID))
Begin DoDot:1
+4 DO CHECKUID^MAGDRPCA(.SOPOUT,.SOPLIST,"SOP")
+5 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
Begin DoDot:2
+6 DO CHECKUID^MAGDRPCA(.STUDYOUT,.STUDYLIST,"STUDY")
+7 IF SOPOUT(2)'=""
IF (+SOPOUT(2))'<0
SET OUT(I+1)="0"_SSEP_UIDS(I)_SSEP_"on file"
+8 SET ONFILESOP=1
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
RECHKFLE(UIDS,I,UID,TYPE) ;
+1 NEW FILE,NEWUID
+2 IF TYPE=1
SET FILE=2005.63
+3 IF TYPE=2
SET FILE=2005.64
+4 IF $DATA(^MAGV(FILE,"B",UID))
Begin DoDot:1
+5 SET IEN=$ORDER(^MAGV(FILE,"B",UID,""))
+6 SET IEN=$PIECE(^MAGV(FILE,IEN,6),"^")
+7 IF TYPE=1
Begin DoDot:2
+8 SET NEWUID=$PIECE($GET(^MAGV(2005.62,IEN,0)),"^")
+9 ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
End DoDot:2
+10 IF TYPE=2
Begin DoDot:2
+11 SET NEWUID=$PIECE($GET(^MAGV(2005.63,IEN,0)),"^")
+12 ;S $P(UIDS(I),ISEP,TYPE)=NEWUID
End DoDot:2
End DoDot:1
+13 ;SF prevent UNDEF errors
QUIT $GET(NEWUID)
+14 ;
+15 ;Set replaced UID in UIDS array if found in 2005.66 duplicate file
DUPUID(UIDS,I,UID,TYPE) ;P332 added sub
+1 ; UIDS - Array of UIDs
+2 ; I - Current array element of UIDS being processed
+3 ; UID - Original UID of TYPE being checked for duplicate
+4 ; TYPE - UID type - 1-STUDY, 2-SERIES, 3-SOP
+5 IF UID=""!(TYPE="")
QUIT ""
+6 NEW IEN,FILE,REC0,RPLFND,RPLIEN
+7 SET FILE=$PIECE("2005.62,2005.63,2005.64",",",TYPE)
+8 SET (IEN,RPLIEN,RPLFND)=""
+9 ;loop dup index from latest and quit if a match is found
+10 FOR
SET RPLIEN=$ORDER(^MAGV(2005.66,"B",UID,RPLIEN),-1)
if (RPLIEN="")!RPLFND
QUIT
Begin DoDot:1
+11 SET REC0=$GET(^MAGV(2005.66,RPLIEN,0))
+12 ;UID type mismatch
IF TYPE'=$PIECE(REC0,U,5)
QUIT
+13 ;UID doesn't match orig in dup record
IF UID'=$PIECE(REC0,U)
QUIT
+14 ;verify dup UID is in file index and UID matches original UID in FILE
+15 ;get IEN from file with replaced UID
SET IEN=$ORDER(^MAGV(FILE,"B",$PIECE(REC0,U,2),""),-1)
+16 ;replaced UID not in FILE index
IF IEN=""
QUIT
+17 ;original UID does not match
IF UID'=$PIECE($GET(^MAGV(FILE,IEN,0)),"^",2)
QUIT
+18 ;set replacement UID
SET $PIECE(UIDS(I),ISEP,TYPE)=$PIECE(REC0,U,2)
+19 ;quit loop
SET RPLFND=1
End DoDot:1
+20 ;return FILE IEN for replaced UID (or null if not found)
QUIT IEN
+21 ;
+22 ; RPC: MAGV FIND WORK ITEM (Calling from FIND^MAGVIM01)
FIND(OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,STOPTAG,MAXROWS,TAGS,LASTIEN,ORDER,DTFROM,DTTO) ; Find records with given attributes - return ID
+1 ;PLACEID is FILE #4's STATION NUMBER
+2 NEW IEN,IEN2,J,TAGMATCH,SSEP,ISEP,TAG,WICOUNT,FLD
+3 NEW VALUE,FLDS,AFLD,NOMATCH,IENS,MAGOUT,LOCIEN,SRV
+4 NEW TAGITM,PATNAME,GLB,FLTITM,RET
+5 SET SSEP=$$STATSEP^MAGVIM01
SET ISEP=$$INPUTSEP^MAGVIM01
+6 if '$GET(DTFROM)
SET DTFROM=0
+7 if '$GET(DTTO)
SET DTTO=9999999
+8 ;
+9 IF $GET(MAXROWS)'=""
IF '(MAXROWS?1N.N)
SET OUT=-2_SSEP_"Invalid MAXROWS parameter provided"
QUIT
+10 ;
+11 IF $GET(PLACEID)'=""
Begin DoDot:1
+12 ;IA #2171 Get Institution IEN for a station number
SET LOCIEN=$$IEN^XUAF4(PLACEID)
+13 IF LOCIEN=""
SET OUT=-2_SSEP_"Invalid PLACEID parameter provided"
+14 QUIT
End DoDot:1
if $GET(OUT)<0
QUIT
+15 ;
+16 SET OUT(0)=0
+17 ; AFLD(FLD,"IE") = compare the external or internal value of the field
+18 SET FLDS=""
+19 IF $GET(TYPE)'=""
SET FLDS=FLDS_"1;"
SET AFLD(1)=TYPE
SET AFLD(1,"IE")="E"
+20 IF $GET(SUBTYPE)'=""
SET FLDS=FLDS_"2;"
SET AFLD(2)=SUBTYPE
SET AFLD(2,"IE")="E"
+21 IF $GET(STATUS)'=""
SET FLDS=FLDS_"3;"
SET AFLD(3)=STATUS
SET AFLD(3,"IE")="E"
+22 IF $GET(LOCIEN)'=""
SET FLDS=FLDS_"4;"
SET AFLD(4)=LOCIEN
SET AFLD(4,"IE")="I"
+23 IF $GET(PRIORITY)'=""
SET FLDS=FLDS_"5;"
SET AFLD(5)=PRIORITY
SET AFLD(5,"IE")="E"
+24 ;
+25 ;filter Source, Service, Modality, and Procedure
KILL FLTITM
SET RET=$$GFLTITM^MAGVIM01(.FLTITM,.TAGS)
+26 IF RET
SET GLB="FLTITM"
+27 IF 'RET
SET GLB="^MAGV(2006.941)"
+28 ;
+29 KILL ERR
+30 if '$GET(ORDER)
SET ORDER=1
+31 IF '$GET(LASTIEN)
Begin DoDot:1
+32 IF ORDER=1
SET LASTIEN=0
+33 IF ORDER=-1
SET LASTIEN=9999999
End DoDot:1
+34 SET IEN=LASTIEN
SET WICOUNT=1
+35 ;
+36 FOR
SET IEN=$ORDER(@GLB@(IEN),ORDER)
if (+IEN=0)!$DATA(ERR)!(($GET(MAXROWS)'="")&(WICOUNT>$GET(MAXROWS)))
QUIT
Begin DoDot:1
+37 if '$$DTINRNG^MAGVIM01(IEN,DTFROM,DTTO)
QUIT
+38 SET IENS=IEN_","
KILL ERR,MAGOUT
+39 DO GETS^DIQ(2006.941,IENS,FLDS,"IE","MAGOUT","ERR")
+40 ; Set Error and quit
IF $DATA(ERR)
KILL OUT
SET OUT(0)=-1_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
QUIT
+41 SET FLD=""
SET NOMATCH=0
+42 FOR
SET FLD=$ORDER(AFLD(FLD))
if FLD=""!NOMATCH
QUIT
Begin DoDot:2
+43 if AFLD(FLD)'=MAGOUT("2006.941",IENS,FLD,AFLD(FLD,"IE"))
SET NOMATCH=1
+44 QUIT
End DoDot:2
+45 ; get next one if no match
if NOMATCH
QUIT
+46 ; Tag matching
+47 SET SRV=$$SRV^MAGVIM01(IEN)
SET J=0
SET TAGMATCH=1
+48 FOR
SET J=$ORDER(TAGS(J))
if (J="")!'TAGMATCH
QUIT
Begin DoDot:2
+49 SET TAG=$PIECE(TAGS(J),ISEP,1)
SET VALUE=$PIECE(TAGS(J),ISEP,2)
+50 IF TAG="Procedure"
IF VALUE="[No Procedure]"
IF '$DATA(^MAGV(2006.941,"H",TAG,IEN))
QUIT
+51 IF TAG="Modality"
IF VALUE="[No Modality]"
IF '$DATA(^MAGV(2006.941,"H",TAG,IEN))
QUIT
+52 IF TAG="Service"
IF VALUE'=""
Begin DoDot:3
+53 IF VALUE="[No Service]"
IF SRV=""
QUIT
+54 IF SRV'=VALUE
SET TAGMATCH=0
End DoDot:3
QUIT
+55 IF TAG="PatientName"
IF VALUE'=""
IF '$DATA(^MAGV(2006.941,"H",TAG,IEN))
SET TAGMATCH=0
QUIT
+56 IF TAG="PatientName"
IF VALUE'=""
IF $DATA(^MAGV(2006.941,"H",TAG,IEN))
Begin DoDot:3
+57 SET TAGITM=$ORDER(^MAGV(2006.941,"H",TAG,IEN,""))
IF TAGITM=""
SET TAGMATCH=0
QUIT
+58 SET PATNAME=$PIECE($GET(^MAGV(2006.941,IEN,4,TAGITM,0)),U,2)
IF PATNAME=""
SET TAGMATCH=0
QUIT
+59 IF '$FIND($$UPCASE(PATNAME),$$UPCASE(VALUE))
SET TAGMATCH=0
QUIT
End DoDot:3
QUIT
+60 IF VALUE'=""
IF $LENGTH(VALUE)<31
IF '$DATA(^MAGV(2006.941,"HH",TAG,VALUE,IEN))
SET TAGMATCH=0
QUIT
+61 IF VALUE'=""
IF $LENGTH(VALUE)<31
IF $DATA(^MAGV(2006.941,"HH",TAG,VALUE,IEN))
QUIT
+62 SET IEN2=$ORDER(^MAGV(2006.941,"H",TAG,IEN,""))
+63 IF $PIECE($GET(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)'=VALUE
SET TAGMATCH=0
+64 QUIT
End DoDot:2
+65 IF 'TAGMATCH
QUIT
+66 ; Add work item header to output array
+67 ; Get Work Item Record
DO GETWI^MAGVIM09(.OUT,IEN,"",SRV)
+68 ; Check for error and set ERR to quit from the loop
IF +OUT(0)<0
SET ERR=""
+69 SET WICOUNT=WICOUNT+1
+70 SET LASTIEN=IEN
+71 QUIT
End DoDot:1
+72 ;Save the last IEN processed, used to retrieve more rows
+73 IF IEN
IF '$DATA(ERR)
SET OUT(0)=OUT(0)_SSEP_LASTIEN
+74 QUIT
+75 ;
UPDWI(ID,FDA,MSGUPD) ; Update work item
+1 ; Return 0|Error`Message error
+2 ;
+3 ; ID - IEN of Work Item
+4 ; FDA - VA FileMan FDA array
+5 ; MSGUPD - Message array
+6 NEW ERR,SSEP
+7 SET SSEP=$$STATSEP^MAGVIM01
+8 ;
+9 DO VALIDATE^MAGVIM06(.FDA,.ERR)
+10 IF $DATA(ERR("DIERR",1,"TEXT",1))
QUIT -4_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+11 ;
+12 KILL ERR
+13 DO FILE^DIE("E","FDA","ERR")
+14 IF $DATA(ERR("DIERR",1,"TEXT",1))
QUIT -3_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+15 ;
+16 ; Update Message field
+17 KILL ERR
+18 IF $DATA(MSGUPD)
DO WP^DIE(2006.941,ID_",",13,"K","MSGUPD","ERR")
+19 IF $DATA(ERR("DIERR",1,"TEXT",1))
QUIT -5_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+20 ;
+21 QUIT 0_SSEP_"Work item "_ID_" updated"
+22 ;
UPCASE(X) ;
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
