MAGVIM01 ;WOIFO/DAC/NST/JSJ/BT - Utilities for RPC calls for DICOM file processing ; Nov 05, 2020@07:26:32
;;3.0;IMAGING;**118,138,221,250,283,332,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
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
Q "|"
STATSEP() ; Status and result separator ie. -3``No record IEN
Q "`"
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
Q "`"
; RPC: MAGV GET WORKLISTS
GETLIST(OUT) ; Returns all worklist names and statuses
N IEN,OSEP,SSEP,FILE,WORKLIST,I
S IEN=0,I=0,OSEP=$$OUTSEP,SSEP=$$STATSEP,FILE=2006.9412
F S IEN=$O(^MAGV(FILE,IEN)) Q:+IEN=0 D
. S I=I+1,WORKLIST=$G(^MAGV(FILE,IEN,0))
. S OUT(I+1)=$P(WORKLIST,U,1)_OSEP_$P(WORKLIST,U,2)
I I>0 S OUT(1)=0_SSEP_I
Q
; RPC: MAGV CREATE WORK ITEM
CRTITEM(OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,MSGTAGS,CRTUSR,CRTAPP,UPDSRV) ; Creates an entry in the work item file and the work history file
N FDA,FDA2,ERR,ERR2,SMIEN,ISEP,SSEP,MSG,APPIEN,LOCIEN,I,CRTDAT,SRV,MDL,PROC,SRC,TAGN,TAGV,TAGIDX
S SSEP=$$STATSEP,ISEP=$$INPUTSEP
S CRTDAT=$$NOW^XLFDT ; CREATED DATE/TIME
S UPDSRV=$G(UPDSRV,0) ;Set Service based on modality and procedure
K OUT
I $G(TYPE)="" S OUT=-6_SSEP_"No work item TYPE provided" Q
I $G(SUBTYPE)="" S OUT=-7_SSEP_"No work item SUBTYPE provided" Q
I $G(STATUS)="" S OUT=-8_SSEP_"No work item STATUS provided" Q
I $G(PLACEID)="" S OUT=-9_SSEP_"No work item LOCATION provided" Q
I $G(PRIORITY)="" S OUT=-10_SSEP_"No work item PRIORITY provided" Q
I ($G(CRTUSR)="")&($G(CRTAPP)="") S OUT=-11_SSEP_"No work item USER/APPLICATION provided" Q
; P250 DAC - Removed P142 LOCATION screen
; P283 DAC - This function will now only accepts Station Numbers as inputs. Will convert to Institution IEN before filing.
S LOCIEN=$$IEN^XUAF4(PLACEID) ; If it wasn't a LOCATION IEN, it should be a STATION NUMBER
I '$G(LOCIEN) S OUT=-11_SSEP_"Invalid LOCATION provided" Q ; If it was a LOCATION IEN or a STATION NUMBER
S FDA(2006.941,"+1,",.01)=CRTDAT
S FDA(2006.941,"+1,",1)=TYPE
S FDA(2006.941,"+1,",2)=SUBTYPE
S FDA(2006.941,"+1,",3)=STATUS
S FDA(2006.941,"+1,",5)=PRIORITY
S FDA(2006.941,"+1,",9)=CRTDAT
S:$G(CRTUSR)'="" (FDA(2006.941,"+1,",8),FDA(2006.941,"+1,",10))="`"_CRTUSR ; user DUZ is passed
I $G(CRTAPP)'="" D
. S APPIEN=$$GETIEN^MAGVAF05(2006.9193,CRTAPP,1) ; Get application IEN
. S (FDA(2006.941,"+1,",14),FDA(2006.941,"+1,",15))=CRTAPP
. Q
; Add message text and tag names and values
F I=1:1 Q:'$D(MSGTAGS(I)) D
. S TAGN=$P(MSGTAGS(I),ISEP,1)
. S TAGV=$P(MSGTAGS(I),ISEP,2)
. S TAGIDX=I+1
. I $E(TAGN,1,3)="MSG" S MSG(TAGIDX)=TAGV Q
. S FDA(2006.94111,"+"_TAGIDX_",+1,",.01)=TAGN ; TAG NAME
. S FDA(2006.94111,"+"_TAGIDX_",+1,",1)=TAGV ; TAG VALUE
. I UPDSRV,TAGN="Modality" S MDL=TAGV Q
. I UPDSRV,TAGN="Procedure" S PROC=TAGV Q
. I UPDSRV,TAGN="Source" S SRC=TAGV Q
. Q
; Update Service based on Modality and Procedure
S ERR=""
I UPDSRV,$G(MDL)'="" D
. S SRV=$$GETSRV^MAGVIM12(MDL,$G(PROC))
. I $P(SRV,U,1)="-1" S ERR=SRV Q
. Q
I ERR'="" S OUT="-1"_SSEP_$P(ERR,U,2) Q
K ERR
D VALIDATE^MAGVIM06(.FDA,.ERR)
; Quit on validation error
I $D(ERR) S OUT="-4"_SSEP_$G(ERR) Q
; Set Work Item
K ERR
L +^MAGV(2006.941,0):5 I $T D
. D UPDATE^DIE("E","FDA","SMIEN","ERR")
. S FDA2(2006.941,SMIEN(1)_",",4)=LOCIEN
. D FILE^DIE("I","FDA2","ERR2") ; P250 DAC - Update LOCATION separately with the internal value
. I '$D(ERR) S ERR=$G(ERR2) ; P250 DAC - If there was no error on the first UPDATE set the ERR to the 2nd update
. D
. . I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-1"_SSEP_$G(ERR("DIERR",1,"TEXT",1)) Q
. . ; File message as word processing field
. . K ERR
. . I $D(MSG) D Q:$D(ERR) ; Quit if error during saving
. . . D WP^DIE(2006.941,SMIEN(1)_",",13,"K","MSG","ERR")
. . . I $D(ERR) S OUT="-3"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
. . . Q
. . ; Return ID of new entry
. . S OUT=0_SSEP_SMIEN(1)
. . Q
. L -^MAGV(2006.941,0)
E D
. S OUT=-5_SSEP_"Unable to lock MAG WORK ITEM file."
. Q
Q
;
; RPC: MAGV UPDATE WORK ITEM
UPDITEM(OUT,ID,EXPSTAT,NEWSTAT,MESSAGE,UPDUSR,UPDAPP) ; Update work item status and create an entry in the work history file
N FDA,SSEP,ISEP,MSGUPD,APPIEN
S SSEP=$$STATSEP,ISEP=$$INPUTSEP
I '$D(^MAGV(2006.941,ID)) S OUT="-6"_SSEP_"Work item "_ID_" not found" Q
I $G(EXPSTAT)="" S OUT=-7_SSEP_"No work item expected status provided" Q
I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT=-8_SSEP_"No updated by user/application provided" Q
L +^MAGV(2006.941,ID):1999999
S RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
I EXPSTAT'=RSTAT S OUT=-9_SSEP_"Work item "_ID_" has a status of "_RSTAT_", not the expected status of "_EXPSTAT L -^MAGV(2006.941,ID) Q
I NEWSTAT'="" S FDA(2006.941,ID_",",3)=NEWSTAT
;
F I=1:1 Q:'$D(MESSAGE(I)) D
. I $E($P(MESSAGE(I),ISEP,1),1,3)="MSG" S MSGUPD(I+1)=$P(MESSAGE(I),ISEP,2)
. Q
;
S FDA(2006.941,ID_",",9)=$$NOW^XLFDT ; LAST UPDATED DATE/TIME
S:$G(UPDUSR)'="" FDA(2006.941,ID_",",10)="`"_UPDUSR ; LAST UPDATING USER - User DUZ
I $G(UPDAPP)'="" D
. S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1) ; Get application IEN or create a new one
. S FDA(2006.941,ID_",",15)=UPDAPP ; LAST UPDATING APP
. Q
;
S OUT=$$UPDWI^MAGVIM09(ID,.FDA,.MSGUPD) ; Update Work Item ID with FDA data, MSGUPD message
L -^MAGV(2006.941,ID)
Q
;
; RPC: MAGV FIND WORK ITEM
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
D FIND^MAGVIM09(.OUT,.TYPE,.SUBTYPE,.STATUS,.PLACEID,.PRIORITY,.STOPTAG,.MAXROWS,.TAGS,.LASTIEN,.ORDER,.DTFROM,.DTTO) ;P357 routine size exceeded - Moved to MAGVIM09
Q
;
DTINRNG(IEN,DTFROM,DTTO) ;
N DAT S DAT=+$P($P($G(^MAGV(2006.941,IEN,0)),U),".")
Q (DAT'<DTFROM)&(DAT'>DTTO)
;
GFLTITM(FLTITM,TAGS) ;This to improve loading performance
N TAGITM,TAG,TAGVAL,VALUE,IEN,IEN2,FILTER,FLTITM2,NOFILTER,DAT
;
K FILTER
S TAGITM=0
F S TAGITM=$O(TAGS(TAGITM)) Q:TAGITM="" D
. S TAG=$P(TAGS(TAGITM),ISEP,1),VALUE=$P(TAGS(TAGITM),ISEP,2)
. I TAG'="Procedure"&(TAG'="Modality")&(TAG'="Source")&(TAG'="Service")&(TAG'="PatientName") Q
. I TAG'="",VALUE'="",VALUE'="[No Procedure]",VALUE'="[No Modality]",VALUE'="[No Service]" S FILTER(TAG)=VALUE
;
Q:'$D(FILTER) 0 ;no filter on service, source, procedure, modality
;
K FLTITM,FLTITM2
S TAG="Procedure"
S VALUE=$G(FILTER(TAG))
I VALUE'="",VALUE'="[No Procedure]",$L(VALUE)<31 M FLTITM=^MAGV(2006.941,"HH",TAG,VALUE) Q:'$D(FLTITM) 1 ;can't find such procedure
I VALUE'="",VALUE'="[No Procedure]",$L(VALUE)>30 D Q:'$D(FLTITM) 1 ;can't find such procedure
. S IEN=0
. F S IEN=$O(^MAGV(2006.941,"H",TAG,IEN)) Q:'IEN D
. . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
. . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
. . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . I TAGVAL=VALUE S FLTITM(IEN)="" ;,FLTITM2(DAT,IEN)=""
;
K FLTITM3,FLTITM4
S TAG="Modality",VALUE=$G(FILTER(TAG))
I VALUE'="",VALUE'="[No Modality]" D Q:'$D(FLTITM) 1 ;can't find such modality
. S NOFILTER='$D(FLTITM)
. I NOFILTER M FLTITM=^MAGV(2006.941,"HH",TAG,VALUE) Q
. I 'NOFILTER D
. . S IEN=0
. . F S IEN=$O(FLTITM(IEN)) Q:'IEN D
. . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . . I $D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
. . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
;
K FLTITM3,FLTITM4
S TAG="Source",VALUE=$G(FILTER(TAG))
S NOFILTER='$D(FLTITM)
I VALUE'="",NOFILTER D Q:'$D(FLTITM) 1 ;can't find such Source
. I $L(VALUE)<31 M FLTITM=^MAGV(2006.941,"HH",TAG,VALUE) Q
. I $L(VALUE)>30 D
. . S IEN=0
. . F S IEN=$O(^MAGV(2006.941,"H",TAG,IEN)) Q:'IEN D
. . . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
. . . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
. . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . . I TAGVAL=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
. . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
;
I VALUE'="",'NOFILTER D Q:'$D(FLTITM) 1 ;can't find such source
. I $L(VALUE)<31 D
. . S IEN=0
. . F S IEN=$O(FLTITM(IEN)) Q:'IEN D
. . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . . I $D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
. I $L(VALUE)>30 D
. . S IEN=0
. . F S IEN=$O(FLTITM(IEN)) Q:'IEN D
. . . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
. . . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
. . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . . I TAGVAL=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
. K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
;
K FLTITM3,FLTITM4
S TAG="Service",VALUE=$G(FILTER(TAG))
I VALUE'="",VALUE'="[No Service]",'$D(FLTITM) Q 0 ;Service is a calculated field, can't use "HH" index
I VALUE'="",VALUE'="[No Service]",$D(FLTITM) D
. S IEN=0
. F S IEN=$O(FLTITM(IEN)) Q:'IEN D
. . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
. . I $$SRV(IEN)=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
. K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
;
S TAG="PatientName",VALUE=$G(FILTER(TAG))
I VALUE'="",'$D(FLTITM) Q 0 ;can't use index, patientname can be filtered using partial
;
Q 1 ;use the filtered items for further processing
;
SRV(IEN) ;return Service
N MTGIDX,MOD,MODS,PTGIDX,PROC,SRV
N CM S CM=","
S MTGIDX=0,MODS=""
F S MTGIDX=$O(^MAGV(2006.941,"H","Modality",IEN,MTGIDX)) Q:'MTGIDX D
. S MOD=$P(^MAGV(2006.941,IEN,4,MTGIDX,0),U,2)
. I (CM_MODS_CM)'[(CM_MOD_CM) S MODS=MODS_MOD_","
I MODS'="" S MODS=$E(MODS,1,$L(MODS)-1)
I MODS="" Q ""
;
S PTGIDX=$O(^MAGV(2006.941,"H","Procedure",IEN,""))
I 'PTGIDX Q $$DESCR($$GETS^MAGVIM12(MODS,""))
S PROC=$P(^MAGV(2006.941,IEN,4,PTGIDX,0),U,2)
I PROC="" Q $$DESCR($$GETS^MAGVIM12(MODS,""))
;
Q $$DESCR($$GETS^MAGVIM12(MODS,PROC))
;
DESCR(SRV) ;
I SRV="RAD" Q "Radiology"
I SRV="CON" Q "Consult"
I SRV="LAB" Q "Lab"
Q ""
;
; RPC: MAGV GET WORK ITEM
GETITEM(OUT,ID,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP) ; Find work item with matching ID and return tags
N I,J,SSEP,RSTAT,FDA,APPIEN
S SSEP=$$STATSEP
K OUT
I $G(ID)="" S OUT(0)=-1_SSEP_"No work item ID" Q
I $G(EXPSTAT)="" S OUT(0)=-2_SSEP_"No expected status" Q
I $G(NEWSTAT)="" S OUT(0)=-3_SSEP_"No new status" Q
I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT(0)=-4_SSEP_"No updated by user/application" Q
I '$D(^MAGV(2006.941,ID)) S OUT(0)=-5_SSEP_"No work item with matching ID" Q
S RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
I EXPSTAT'=RSTAT S OUT(0)=-6_SSEP_"Work item "_ID_" has a status of "_RSTAT_", not the expected status of "_EXPSTAT L -^MAGV(2006.941,ID) Q
L +^MAGV(2006.941,ID):1999999
S OUT(0)=0
I NEWSTAT'=EXPSTAT D UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
I +OUT(0)=0 D
. S OUT(0)=0
. D GETWI^MAGVIM09(.OUT,ID) ; Get Work Item Record
. Q
L -^MAGV(2006.941,ID)
Q
; RPC: MAGV DELETE WORK ITEM
DELWITEM(OUT,ID) ; Delete Work Item
N FDA,SSEP
S SSEP=$$STATSEP
I '$D(^MAGV(2006.941,ID)) S OUT=-1_SSEP_"Work item "_ID_" not found." Q
S FDA(2006.941,ID_",",.01)="@"
L +^MAGV(2006.941,0):5 I $T D
. ;--- Do not decrement FileMan highest entry value during delete.
. N MAXIEN S MAXIEN=$P(^MAGV(2006.941,0),U,3)
. D FILE^DIE("","FDA")
. S:$P(^MAGV(2006.941,0),U,3)<MAXIEN $P(^MAGV(2006.941,0),U,3)=MAXIEN
. S OUT=0_SSEP_"Work item "_ID_" deleted."
. L -^MAGV(2006.941,0)
. Q
E D
. S OUT=-2_SSEP_"Work item "_ID_" is locked."
. Q
Q
; RPC: MAGV ADD WORK ITEM TAGS
ADDTAG(OUT,ID,EXPSTAT,UPDUSR,UPDAPP,TAG) ; Add tags to work item
N FDA1,FDA2,ERR1,ERR4,STATMATCH,STATUS,SSEP,ISEP,I,APPIEN,MSGUPD
S SSEP=$$STATSEP,ISEP=$$INPUTSEP
I $G(ID)="" S OUT=-9_SSEP_"No work item ID" Q
I '$D(^MAGV(2006.941,ID)) S OUT=-5_SSEP_"No work item with matching ID" Q
I '$D(EXPSTAT) S OUT=-6_SSEP_"No status provided" Q
I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT=-7_SSEP_"No updated by user/application" Q
I $G(TAG(1))="" S OUT=-8_SSEP_"No tag" Q
S STATUS=$$GET1^DIQ(2006.941,ID,"STATUS")
S STATMATCH=0
F I=1:1 Q:$P(EXPSTAT,ISEP,I)="" Q:STATMATCH D
. I $P(EXPSTAT,ISEP,I)=STATUS S STATMATCH=1
. Q
I STATMATCH=0 S OUT=-9_SSEP_"work item does not have expected status" Q
L +^MAGV(2006.941,ID):1999999
F I=1:1 Q:'$D(TAG(I)) D
. S FDA1(2006.94111,"+"_I_","_ID_",",.01)=$P(TAG(I),ISEP,1) ; TAG NAME
. S FDA1(2006.94111,"+"_I_","_ID_",",1)=$P(TAG(I),ISEP,2) ; TAG VALUE
. Q
D VALIDATE^MAGVIM06(.FDA1,.ERR4)
I $D(ERR4) S OUT="-11"_SSEP_$G(ERR4) L -^MAGV(2006.941,ID) Q ; Unlock/quit
D UPDATE^DIE("","FDA1","","ERR1")
I $D(ERR1("DIERR",1,"TEXT",1)) S OUT="-10"_SSEP_$G(ERR1("DIERR",1,"TEXT",1)) L -^MAGV(2006.941,ID) Q ; Unlock/quit
; Set Work Item
S FDA2(2006.941,ID_",",9)=$$NOW^XLFDT
S:$G(UPDUSR)'="" FDA2(2006.941,ID_",",10)="`"_UPDUSR ; LAST UPDATING USER - User DUZ is passed
I $G(UPDAPP)'="" D
. S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1) ; Get application IEN or create a new one first
. S FDA2(2006.941,ID_",",15)=UPDAPP ; LAST UPDATING APP
. Q
S OUT=$$UPDWI^MAGVIM09(ID,.FDA2,.MSGUPD) ; Update Work Item ID with FDA data, MSGUPD message
L -^MAGV(2006.941,ID)
Q
; RPC: MAGV GET NEXT WORK ITEM
GETNEXT(OUT,ETYPE,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP,LOCATION) ; Find last update work item on worklist type provided
N SSEP,ID,ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT
K OUT
S SSEP=$$STATSEP
I $G(ETYPE)="" S OUT(0)=-1_SSEP_"Work Item type not specified" Q
I $G(EXPSTAT)="" S OUT(0)=-2_SSEP_"Work Item expected status not specified" Q
I $G(NEWSTAT)="" S OUT(0)=-3_SSEP_"Work Item new status not specified" Q
I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT(0)=-4_SSEP_"No updated by user/application provided" Q
I $G(LOCATION)="" S OUT(0)=-5_SSEP_"Work Item Place ID not specified" Q
;
S ETYPEIEN=$O(^MAGV(2006.9412,"B",ETYPE,""))
S ESTATIEN=$O(^MAGV(2006.9413,"B",EXPSTAT,""))
S ELOCIEN=$$IEN^XUAF4(LOCATION) ; get Location IEN
;
I ETYPEIEN'>0 S OUT(0)=-6_SSEP_"Work Item type IEN not found: "_ETYPE Q
I ESTATIEN'>0 S OUT(0)=-7_SSEP_"Work Item expected status IEN not found: "_EXPSTAT Q
I ELOCIEN'>0 S OUT(0)=-8_SSEP_"Work Item Place ID not found: "_LOCATION Q
;
;Get last updated record with matching parameters
S UPDATEDT=$O(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,""))
I 'UPDATEDT S OUT(0)=0_SSEP_"No matching work item found" Q
S ID=$O(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT,""))
I 'ID S OUT(0)=0_SSEP_"No matching work item found" Q
L +^MAGV(2006.941,ID):1999999
S OUT(0)=0
I NEWSTAT'=EXPSTAT D UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
I +OUT(0)=0 D
. S OUT(0)=0
. D GETWI^MAGVIM09(.OUT,ID) ; Get Work Item Record
. Q
L -^MAGV(2006.941,ID)
Q
; RPC: MAGV IMPORT STATUS
IMSTATUS(OUT,UIDS) ; Get import status
D IMSTATUS^MAGVIM09(.OUT,.UIDS) ;P332 routine size exceeded - Moved to MAGVIM09
Q
UPUSRAPP(OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
N FDA,APPIEN
S FDA(2006.941,ID_",",3)=NEWSTAT
S FDA(2006.941,ID_",",9)=$$NOW^XLFDT
S:$G(UPDUSR)'="" FDA(2006.941,ID_",",10)="`"_UPDUSR ; LAST UPDATING USER - User DUZ is passed
I $G(UPDAPP)'="" D
. S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1) ; Get application IEN or create a new one first
. S FDA(2006.941,ID_",",15)=UPDAPP ; LAST UPDATING APPLICATION
. Q
S OUT(0)=$$UPDWI^MAGVIM09(ID,.FDA) ; Update Work Item ID with FDA data and MSGUPD message
Q
UPCASE(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM01 16716 printed Mar 13, 2025@21:14:44 Page 2
MAGVIM01 ;WOIFO/DAC/NST/JSJ/BT - Utilities for RPC calls for DICOM file processing ; Nov 05, 2020@07:26:32
+1 ;;3.0;IMAGING;**118,138,221,250,283,332,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
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
+1 QUIT "|"
STATSEP() ; Status and result separator ie. -3``No record IEN
+1 QUIT "`"
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
+1 QUIT "`"
+2 ; RPC: MAGV GET WORKLISTS
GETLIST(OUT) ; Returns all worklist names and statuses
+1 NEW IEN,OSEP,SSEP,FILE,WORKLIST,I
+2 SET IEN=0
SET I=0
SET OSEP=$$OUTSEP
SET SSEP=$$STATSEP
SET FILE=2006.9412
+3 FOR
SET IEN=$ORDER(^MAGV(FILE,IEN))
if +IEN=0
QUIT
Begin DoDot:1
+4 SET I=I+1
SET WORKLIST=$GET(^MAGV(FILE,IEN,0))
+5 SET OUT(I+1)=$PIECE(WORKLIST,U,1)_OSEP_$PIECE(WORKLIST,U,2)
End DoDot:1
+6 IF I>0
SET OUT(1)=0_SSEP_I
+7 QUIT
+8 ; RPC: MAGV CREATE WORK ITEM
CRTITEM(OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,MSGTAGS,CRTUSR,CRTAPP,UPDSRV) ; Creates an entry in the work item file and the work history file
+1 NEW FDA,FDA2,ERR,ERR2,SMIEN,ISEP,SSEP,MSG,APPIEN,LOCIEN,I,CRTDAT,SRV,MDL,PROC,SRC,TAGN,TAGV,TAGIDX
+2 SET SSEP=$$STATSEP
SET ISEP=$$INPUTSEP
+3 ; CREATED DATE/TIME
SET CRTDAT=$$NOW^XLFDT
+4 ;Set Service based on modality and procedure
SET UPDSRV=$GET(UPDSRV,0)
+5 KILL OUT
+6 IF $GET(TYPE)=""
SET OUT=-6_SSEP_"No work item TYPE provided"
QUIT
+7 IF $GET(SUBTYPE)=""
SET OUT=-7_SSEP_"No work item SUBTYPE provided"
QUIT
+8 IF $GET(STATUS)=""
SET OUT=-8_SSEP_"No work item STATUS provided"
QUIT
+9 IF $GET(PLACEID)=""
SET OUT=-9_SSEP_"No work item LOCATION provided"
QUIT
+10 IF $GET(PRIORITY)=""
SET OUT=-10_SSEP_"No work item PRIORITY provided"
QUIT
+11 IF ($GET(CRTUSR)="")&($GET(CRTAPP)="")
SET OUT=-11_SSEP_"No work item USER/APPLICATION provided"
QUIT
+12 ; P250 DAC - Removed P142 LOCATION screen
+13 ; P283 DAC - This function will now only accepts Station Numbers as inputs. Will convert to Institution IEN before filing.
+14 ; If it wasn't a LOCATION IEN, it should be a STATION NUMBER
SET LOCIEN=$$IEN^XUAF4(PLACEID)
+15 ; If it was a LOCATION IEN or a STATION NUMBER
IF '$GET(LOCIEN)
SET OUT=-11_SSEP_"Invalid LOCATION provided"
QUIT
+16 SET FDA(2006.941,"+1,",.01)=CRTDAT
+17 SET FDA(2006.941,"+1,",1)=TYPE
+18 SET FDA(2006.941,"+1,",2)=SUBTYPE
+19 SET FDA(2006.941,"+1,",3)=STATUS
+20 SET FDA(2006.941,"+1,",5)=PRIORITY
+21 SET FDA(2006.941,"+1,",9)=CRTDAT
+22 ; user DUZ is passed
if $GET(CRTUSR)'=""
SET (FDA(2006.941,"+1,",8),FDA(2006.941,"+1,",10))="`"_CRTUSR
+23 IF $GET(CRTAPP)'=""
Begin DoDot:1
+24 ; Get application IEN
SET APPIEN=$$GETIEN^MAGVAF05(2006.9193,CRTAPP,1)
+25 SET (FDA(2006.941,"+1,",14),FDA(2006.941,"+1,",15))=CRTAPP
+26 QUIT
End DoDot:1
+27 ; Add message text and tag names and values
+28 FOR I=1:1
if '$DATA(MSGTAGS(I))
QUIT
Begin DoDot:1
+29 SET TAGN=$PIECE(MSGTAGS(I),ISEP,1)
+30 SET TAGV=$PIECE(MSGTAGS(I),ISEP,2)
+31 SET TAGIDX=I+1
+32 IF $EXTRACT(TAGN,1,3)="MSG"
SET MSG(TAGIDX)=TAGV
QUIT
+33 ; TAG NAME
SET FDA(2006.94111,"+"_TAGIDX_",+1,",.01)=TAGN
+34 ; TAG VALUE
SET FDA(2006.94111,"+"_TAGIDX_",+1,",1)=TAGV
+35 IF UPDSRV
IF TAGN="Modality"
SET MDL=TAGV
QUIT
+36 IF UPDSRV
IF TAGN="Procedure"
SET PROC=TAGV
QUIT
+37 IF UPDSRV
IF TAGN="Source"
SET SRC=TAGV
QUIT
+38 QUIT
End DoDot:1
+39 ; Update Service based on Modality and Procedure
+40 SET ERR=""
+41 IF UPDSRV
IF $GET(MDL)'=""
Begin DoDot:1
+42 SET SRV=$$GETSRV^MAGVIM12(MDL,$GET(PROC))
+43 IF $PIECE(SRV,U,1)="-1"
SET ERR=SRV
QUIT
+44 QUIT
End DoDot:1
+45 IF ERR'=""
SET OUT="-1"_SSEP_$PIECE(ERR,U,2)
QUIT
+46 KILL ERR
+47 DO VALIDATE^MAGVIM06(.FDA,.ERR)
+48 ; Quit on validation error
+49 IF $DATA(ERR)
SET OUT="-4"_SSEP_$GET(ERR)
QUIT
+50 ; Set Work Item
+51 KILL ERR
+52 LOCK +^MAGV(2006.941,0):5
IF $TEST
Begin DoDot:1
+53 DO UPDATE^DIE("E","FDA","SMIEN","ERR")
+54 SET FDA2(2006.941,SMIEN(1)_",",4)=LOCIEN
+55 ; P250 DAC - Update LOCATION separately with the internal value
DO FILE^DIE("I","FDA2","ERR2")
+56 ; P250 DAC - If there was no error on the first UPDATE set the ERR to the 2nd update
IF '$DATA(ERR)
SET ERR=$GET(ERR2)
+57 Begin DoDot:2
+58 IF $DATA(ERR("DIERR",1,"TEXT",1))
SET OUT="-1"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
QUIT
+59 ; File message as word processing field
+60 KILL ERR
+61 ; Quit if error during saving
IF $DATA(MSG)
Begin DoDot:3
+62 DO WP^DIE(2006.941,SMIEN(1)_",",13,"K","MSG","ERR")
+63 IF $DATA(ERR)
SET OUT="-3"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+64 QUIT
End DoDot:3
if $DATA(ERR)
QUIT
+65 ; Return ID of new entry
+66 SET OUT=0_SSEP_SMIEN(1)
+67 QUIT
End DoDot:2
+68 LOCK -^MAGV(2006.941,0)
End DoDot:1
+69 IF '$TEST
Begin DoDot:1
+70 SET OUT=-5_SSEP_"Unable to lock MAG WORK ITEM file."
+71 QUIT
End DoDot:1
+72 QUIT
+73 ;
+74 ; RPC: MAGV UPDATE WORK ITEM
UPDITEM(OUT,ID,EXPSTAT,NEWSTAT,MESSAGE,UPDUSR,UPDAPP) ; Update work item status and create an entry in the work history file
+1 NEW FDA,SSEP,ISEP,MSGUPD,APPIEN
+2 SET SSEP=$$STATSEP
SET ISEP=$$INPUTSEP
+3 IF '$DATA(^MAGV(2006.941,ID))
SET OUT="-6"_SSEP_"Work item "_ID_" not found"
QUIT
+4 IF $GET(EXPSTAT)=""
SET OUT=-7_SSEP_"No work item expected status provided"
QUIT
+5 IF ($GET(UPDUSR)="")&($GET(UPDAPP)="")
SET OUT=-8_SSEP_"No updated by user/application provided"
QUIT
+6 LOCK +^MAGV(2006.941,ID):1999999
+7 SET RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
+8 IF EXPSTAT'=RSTAT
SET OUT=-9_SSEP_"Work item "_ID_" has a status of "_RSTAT_", not the expected status of "_EXPSTAT
LOCK -^MAGV(2006.941,ID)
QUIT
+9 IF NEWSTAT'=""
SET FDA(2006.941,ID_",",3)=NEWSTAT
+10 ;
+11 FOR I=1:1
if '$DATA(MESSAGE(I))
QUIT
Begin DoDot:1
+12 IF $EXTRACT($PIECE(MESSAGE(I),ISEP,1),1,3)="MSG"
SET MSGUPD(I+1)=$PIECE(MESSAGE(I),ISEP,2)
+13 QUIT
End DoDot:1
+14 ;
+15 ; LAST UPDATED DATE/TIME
SET FDA(2006.941,ID_",",9)=$$NOW^XLFDT
+16 ; LAST UPDATING USER - User DUZ
if $GET(UPDUSR)'=""
SET FDA(2006.941,ID_",",10)="`"_UPDUSR
+17 IF $GET(UPDAPP)'=""
Begin DoDot:1
+18 ; Get application IEN or create a new one
SET APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)
+19 ; LAST UPDATING APP
SET FDA(2006.941,ID_",",15)=UPDAPP
+20 QUIT
End DoDot:1
+21 ;
+22 ; Update Work Item ID with FDA data, MSGUPD message
SET OUT=$$UPDWI^MAGVIM09(ID,.FDA,.MSGUPD)
+23 LOCK -^MAGV(2006.941,ID)
+24 QUIT
+25 ;
+26 ; RPC: MAGV FIND WORK ITEM
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 ;P357 routine size exceeded - Moved to MAGVIM09
DO FIND^MAGVIM09(.OUT,.TYPE,.SUBTYPE,.STATUS,.PLACEID,.PRIORITY,.STOPTAG,.MAXROWS,.TAGS,.LASTIEN,.ORDER,.DTFROM,.DTTO)
+3 QUIT
+4 ;
DTINRNG(IEN,DTFROM,DTTO) ;
+1 NEW DAT
SET DAT=+$PIECE($PIECE($GET(^MAGV(2006.941,IEN,0)),U),".")
+2 QUIT (DAT'<DTFROM)&(DAT'>DTTO)
+3 ;
GFLTITM(FLTITM,TAGS) ;This to improve loading performance
+1 NEW TAGITM,TAG,TAGVAL,VALUE,IEN,IEN2,FILTER,FLTITM2,NOFILTER,DAT
+2 ;
+3 KILL FILTER
+4 SET TAGITM=0
+5 FOR
SET TAGITM=$ORDER(TAGS(TAGITM))
if TAGITM=""
QUIT
Begin DoDot:1
+6 SET TAG=$PIECE(TAGS(TAGITM),ISEP,1)
SET VALUE=$PIECE(TAGS(TAGITM),ISEP,2)
+7 IF TAG'="Procedure"&(TAG'="Modality")&(TAG'="Source")&(TAG'="Service")&(TAG'="PatientName")
QUIT
+8 IF TAG'=""
IF VALUE'=""
IF VALUE'="[No Procedure]"
IF VALUE'="[No Modality]"
IF VALUE'="[No Service]"
SET FILTER(TAG)=VALUE
End DoDot:1
+9 ;
+10 ;no filter on service, source, procedure, modality
if '$DATA(FILTER)
QUIT 0
+11 ;
+12 KILL FLTITM,FLTITM2
+13 SET TAG="Procedure"
+14 SET VALUE=$GET(FILTER(TAG))
+15 ;can't find such procedure
IF VALUE'=""
IF VALUE'="[No Procedure]"
IF $LENGTH(VALUE)<31
MERGE FLTITM=^MAGV(2006.941,"HH",TAG,VALUE)
if '$DATA(FLTITM)
QUIT 1
+16 ;can't find such procedure
IF VALUE'=""
IF VALUE'="[No Procedure]"
IF $LENGTH(VALUE)>30
Begin DoDot:1
+17 SET IEN=0
+18 FOR
SET IEN=$ORDER(^MAGV(2006.941,"H",TAG,IEN))
if 'IEN
QUIT
Begin DoDot:2
+19 SET IEN2=$ORDER(^MAGV(2006.941,"H",TAG,IEN,""))
+20 SET TAGVAL=$PIECE($GET(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
+21 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+22 ;,FLTITM2(DAT,IEN)=""
IF TAGVAL=VALUE
SET FLTITM(IEN)=""
End DoDot:2
End DoDot:1
if '$DATA(FLTITM)
QUIT 1
+23 ;
+24 KILL FLTITM3,FLTITM4
+25 SET TAG="Modality"
SET VALUE=$GET(FILTER(TAG))
+26 ;can't find such modality
IF VALUE'=""
IF VALUE'="[No Modality]"
Begin DoDot:1
+27 SET NOFILTER='$DATA(FLTITM)
+28 IF NOFILTER
MERGE FLTITM=^MAGV(2006.941,"HH",TAG,VALUE)
QUIT
+29 IF 'NOFILTER
Begin DoDot:2
+30 SET IEN=0
+31 FOR
SET IEN=$ORDER(FLTITM(IEN))
if 'IEN
QUIT
Begin DoDot:3
+32 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+33 ;,FLTITM4(DAT,IEN)=""
IF $DATA(^MAGV(2006.941,"HH",TAG,VALUE,IEN))
SET FLTITM3(IEN)=""
End DoDot:3
+34 ;,FLTITM2=FLTITM4
KILL FLTITM,FLTITM2
MERGE FLTITM=FLTITM3
End DoDot:2
End DoDot:1
if '$DATA(FLTITM)
QUIT 1
+35 ;
+36 KILL FLTITM3,FLTITM4
+37 SET TAG="Source"
SET VALUE=$GET(FILTER(TAG))
+38 SET NOFILTER='$DATA(FLTITM)
+39 ;can't find such Source
IF VALUE'=""
IF NOFILTER
Begin DoDot:1
+40 IF $LENGTH(VALUE)<31
MERGE FLTITM=^MAGV(2006.941,"HH",TAG,VALUE)
QUIT
+41 IF $LENGTH(VALUE)>30
Begin DoDot:2
+42 SET IEN=0
+43 FOR
SET IEN=$ORDER(^MAGV(2006.941,"H",TAG,IEN))
if 'IEN
QUIT
Begin DoDot:3
+44 SET IEN2=$ORDER(^MAGV(2006.941,"H",TAG,IEN,""))
+45 SET TAGVAL=$PIECE($GET(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
+46 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+47 ;,FLTITM4(DAT,IEN)=""
IF TAGVAL=VALUE
SET FLTITM3(IEN)=""
End DoDot:3
+48 ;,FLTITM2=FLTITM4
KILL FLTITM,FLTITM2
MERGE FLTITM=FLTITM3
End DoDot:2
End DoDot:1
if '$DATA(FLTITM)
QUIT 1
+49 ;
+50 ;can't find such source
IF VALUE'=""
IF 'NOFILTER
Begin DoDot:1
+51 IF $LENGTH(VALUE)<31
Begin DoDot:2
+52 SET IEN=0
+53 FOR
SET IEN=$ORDER(FLTITM(IEN))
if 'IEN
QUIT
Begin DoDot:3
+54 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+55 ;,FLTITM4(DAT,IEN)=""
IF $DATA(^MAGV(2006.941,"HH",TAG,VALUE,IEN))
SET FLTITM3(IEN)=""
End DoDot:3
End DoDot:2
+56 IF $LENGTH(VALUE)>30
Begin DoDot:2
+57 SET IEN=0
+58 FOR
SET IEN=$ORDER(FLTITM(IEN))
if 'IEN
QUIT
Begin DoDot:3
+59 SET IEN2=$ORDER(^MAGV(2006.941,"H",TAG,IEN,""))
+60 SET TAGVAL=$PIECE($GET(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
+61 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+62 ;,FLTITM4(DAT,IEN)=""
IF TAGVAL=VALUE
SET FLTITM3(IEN)=""
End DoDot:3
End DoDot:2
+63 ;,FLTITM2=FLTITM4
KILL FLTITM,FLTITM2
MERGE FLTITM=FLTITM3
End DoDot:1
if '$DATA(FLTITM)
QUIT 1
+64 ;
+65 KILL FLTITM3,FLTITM4
+66 SET TAG="Service"
SET VALUE=$GET(FILTER(TAG))
+67 ;Service is a calculated field, can't use "HH" index
IF VALUE'=""
IF VALUE'="[No Service]"
IF '$DATA(FLTITM)
QUIT 0
+68 IF VALUE'=""
IF VALUE'="[No Service]"
IF $DATA(FLTITM)
Begin DoDot:1
+69 SET IEN=0
+70 FOR
SET IEN=$ORDER(FLTITM(IEN))
if 'IEN
QUIT
Begin DoDot:2
+71 ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
+72 ;,FLTITM4(DAT,IEN)=""
IF $$SRV(IEN)=VALUE
SET FLTITM3(IEN)=""
End DoDot:2
+73 ;,FLTITM2=FLTITM4
KILL FLTITM,FLTITM2
MERGE FLTITM=FLTITM3
End DoDot:1
+74 ;
+75 SET TAG="PatientName"
SET VALUE=$GET(FILTER(TAG))
+76 ;can't use index, patientname can be filtered using partial
IF VALUE'=""
IF '$DATA(FLTITM)
QUIT 0
+77 ;
+78 ;use the filtered items for further processing
QUIT 1
+79 ;
SRV(IEN) ;return Service
+1 NEW MTGIDX,MOD,MODS,PTGIDX,PROC,SRV
+2 NEW CM
SET CM=","
+3 SET MTGIDX=0
SET MODS=""
+4 FOR
SET MTGIDX=$ORDER(^MAGV(2006.941,"H","Modality",IEN,MTGIDX))
if 'MTGIDX
QUIT
Begin DoDot:1
+5 SET MOD=$PIECE(^MAGV(2006.941,IEN,4,MTGIDX,0),U,2)
+6 IF (CM_MODS_CM)'[(CM_MOD_CM)
SET MODS=MODS_MOD_","
End DoDot:1
+7 IF MODS'=""
SET MODS=$EXTRACT(MODS,1,$LENGTH(MODS)-1)
+8 IF MODS=""
QUIT ""
+9 ;
+10 SET PTGIDX=$ORDER(^MAGV(2006.941,"H","Procedure",IEN,""))
+11 IF 'PTGIDX
QUIT $$DESCR($$GETS^MAGVIM12(MODS,""))
+12 SET PROC=$PIECE(^MAGV(2006.941,IEN,4,PTGIDX,0),U,2)
+13 IF PROC=""
QUIT $$DESCR($$GETS^MAGVIM12(MODS,""))
+14 ;
+15 QUIT $$DESCR($$GETS^MAGVIM12(MODS,PROC))
+16 ;
DESCR(SRV) ;
+1 IF SRV="RAD"
QUIT "Radiology"
+2 IF SRV="CON"
QUIT "Consult"
+3 IF SRV="LAB"
QUIT "Lab"
+4 QUIT ""
+5 ;
+6 ; RPC: MAGV GET WORK ITEM
GETITEM(OUT,ID,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP) ; Find work item with matching ID and return tags
+1 NEW I,J,SSEP,RSTAT,FDA,APPIEN
+2 SET SSEP=$$STATSEP
+3 KILL OUT
+4 IF $GET(ID)=""
SET OUT(0)=-1_SSEP_"No work item ID"
QUIT
+5 IF $GET(EXPSTAT)=""
SET OUT(0)=-2_SSEP_"No expected status"
QUIT
+6 IF $GET(NEWSTAT)=""
SET OUT(0)=-3_SSEP_"No new status"
QUIT
+7 IF ($GET(UPDUSR)="")&($GET(UPDAPP)="")
SET OUT(0)=-4_SSEP_"No updated by user/application"
QUIT
+8 IF '$DATA(^MAGV(2006.941,ID))
SET OUT(0)=-5_SSEP_"No work item with matching ID"
QUIT
+9 SET RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
+10 IF EXPSTAT'=RSTAT
SET OUT(0)=-6_SSEP_"Work item "_ID_" has a status of "_RSTAT_", not the expected status of "_EXPSTAT
LOCK -^MAGV(2006.941,ID)
QUIT
+11 LOCK +^MAGV(2006.941,ID):1999999
+12 SET OUT(0)=0
+13 ; Update user, app, updated time fields
IF NEWSTAT'=EXPSTAT
DO UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP)
+14 IF +OUT(0)=0
Begin DoDot:1
+15 SET OUT(0)=0
+16 ; Get Work Item Record
DO GETWI^MAGVIM09(.OUT,ID)
+17 QUIT
End DoDot:1
+18 LOCK -^MAGV(2006.941,ID)
+19 QUIT
+20 ; RPC: MAGV DELETE WORK ITEM
DELWITEM(OUT,ID) ; Delete Work Item
+1 NEW FDA,SSEP
+2 SET SSEP=$$STATSEP
+3 IF '$DATA(^MAGV(2006.941,ID))
SET OUT=-1_SSEP_"Work item "_ID_" not found."
QUIT
+4 SET FDA(2006.941,ID_",",.01)="@"
+5 LOCK +^MAGV(2006.941,0):5
IF $TEST
Begin DoDot:1
+6 ;--- Do not decrement FileMan highest entry value during delete.
+7 NEW MAXIEN
SET MAXIEN=$PIECE(^MAGV(2006.941,0),U,3)
+8 DO FILE^DIE("","FDA")
+9 if $PIECE(^MAGV(2006.941,0),U,3)<MAXIEN
SET $PIECE(^MAGV(2006.941,0),U,3)=MAXIEN
+10 SET OUT=0_SSEP_"Work item "_ID_" deleted."
+11 LOCK -^MAGV(2006.941,0)
+12 QUIT
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET OUT=-2_SSEP_"Work item "_ID_" is locked."
+15 QUIT
End DoDot:1
+16 QUIT
+17 ; RPC: MAGV ADD WORK ITEM TAGS
ADDTAG(OUT,ID,EXPSTAT,UPDUSR,UPDAPP,TAG) ; Add tags to work item
+1 NEW FDA1,FDA2,ERR1,ERR4,STATMATCH,STATUS,SSEP,ISEP,I,APPIEN,MSGUPD
+2 SET SSEP=$$STATSEP
SET ISEP=$$INPUTSEP
+3 IF $GET(ID)=""
SET OUT=-9_SSEP_"No work item ID"
QUIT
+4 IF '$DATA(^MAGV(2006.941,ID))
SET OUT=-5_SSEP_"No work item with matching ID"
QUIT
+5 IF '$DATA(EXPSTAT)
SET OUT=-6_SSEP_"No status provided"
QUIT
+6 IF ($GET(UPDUSR)="")&($GET(UPDAPP)="")
SET OUT=-7_SSEP_"No updated by user/application"
QUIT
+7 IF $GET(TAG(1))=""
SET OUT=-8_SSEP_"No tag"
QUIT
+8 SET STATUS=$$GET1^DIQ(2006.941,ID,"STATUS")
+9 SET STATMATCH=0
+10 FOR I=1:1
if $PIECE(EXPSTAT,ISEP,I)=""
QUIT
if STATMATCH
QUIT
Begin DoDot:1
+11 IF $PIECE(EXPSTAT,ISEP,I)=STATUS
SET STATMATCH=1
+12 QUIT
End DoDot:1
+13 IF STATMATCH=0
SET OUT=-9_SSEP_"work item does not have expected status"
QUIT
+14 LOCK +^MAGV(2006.941,ID):1999999
+15 FOR I=1:1
if '$DATA(TAG(I))
QUIT
Begin DoDot:1
+16 ; TAG NAME
SET FDA1(2006.94111,"+"_I_","_ID_",",.01)=$PIECE(TAG(I),ISEP,1)
+17 ; TAG VALUE
SET FDA1(2006.94111,"+"_I_","_ID_",",1)=$PIECE(TAG(I),ISEP,2)
+18 QUIT
End DoDot:1
+19 DO VALIDATE^MAGVIM06(.FDA1,.ERR4)
+20 ; Unlock/quit
IF $DATA(ERR4)
SET OUT="-11"_SSEP_$GET(ERR4)
LOCK -^MAGV(2006.941,ID)
QUIT
+21 DO UPDATE^DIE("","FDA1","","ERR1")
+22 ; Unlock/quit
IF $DATA(ERR1("DIERR",1,"TEXT",1))
SET OUT="-10"_SSEP_$GET(ERR1("DIERR",1,"TEXT",1))
LOCK -^MAGV(2006.941,ID)
QUIT
+23 ; Set Work Item
+24 SET FDA2(2006.941,ID_",",9)=$$NOW^XLFDT
+25 ; LAST UPDATING USER - User DUZ is passed
if $GET(UPDUSR)'=""
SET FDA2(2006.941,ID_",",10)="`"_UPDUSR
+26 IF $GET(UPDAPP)'=""
Begin DoDot:1
+27 ; Get application IEN or create a new one first
SET APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)
+28 ; LAST UPDATING APP
SET FDA2(2006.941,ID_",",15)=UPDAPP
+29 QUIT
End DoDot:1
+30 ; Update Work Item ID with FDA data, MSGUPD message
SET OUT=$$UPDWI^MAGVIM09(ID,.FDA2,.MSGUPD)
+31 LOCK -^MAGV(2006.941,ID)
+32 QUIT
+33 ; RPC: MAGV GET NEXT WORK ITEM
GETNEXT(OUT,ETYPE,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP,LOCATION) ; Find last update work item on worklist type provided
+1 NEW SSEP,ID,ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT
+2 KILL OUT
+3 SET SSEP=$$STATSEP
+4 IF $GET(ETYPE)=""
SET OUT(0)=-1_SSEP_"Work Item type not specified"
QUIT
+5 IF $GET(EXPSTAT)=""
SET OUT(0)=-2_SSEP_"Work Item expected status not specified"
QUIT
+6 IF $GET(NEWSTAT)=""
SET OUT(0)=-3_SSEP_"Work Item new status not specified"
QUIT
+7 IF ($GET(UPDUSR)="")&($GET(UPDAPP)="")
SET OUT(0)=-4_SSEP_"No updated by user/application provided"
QUIT
+8 IF $GET(LOCATION)=""
SET OUT(0)=-5_SSEP_"Work Item Place ID not specified"
QUIT
+9 ;
+10 SET ETYPEIEN=$ORDER(^MAGV(2006.9412,"B",ETYPE,""))
+11 SET ESTATIEN=$ORDER(^MAGV(2006.9413,"B",EXPSTAT,""))
+12 ; get Location IEN
SET ELOCIEN=$$IEN^XUAF4(LOCATION)
+13 ;
+14 IF ETYPEIEN'>0
SET OUT(0)=-6_SSEP_"Work Item type IEN not found: "_ETYPE
QUIT
+15 IF ESTATIEN'>0
SET OUT(0)=-7_SSEP_"Work Item expected status IEN not found: "_EXPSTAT
QUIT
+16 IF ELOCIEN'>0
SET OUT(0)=-8_SSEP_"Work Item Place ID not found: "_LOCATION
QUIT
+17 ;
+18 ;Get last updated record with matching parameters
+19 SET UPDATEDT=$ORDER(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,""))
+20 IF 'UPDATEDT
SET OUT(0)=0_SSEP_"No matching work item found"
QUIT
+21 SET ID=$ORDER(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT,""))
+22 IF 'ID
SET OUT(0)=0_SSEP_"No matching work item found"
QUIT
+23 LOCK +^MAGV(2006.941,ID):1999999
+24 SET OUT(0)=0
+25 ; Update user, app, updated time fields
IF NEWSTAT'=EXPSTAT
DO UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP)
+26 IF +OUT(0)=0
Begin DoDot:1
+27 SET OUT(0)=0
+28 ; Get Work Item Record
DO GETWI^MAGVIM09(.OUT,ID)
+29 QUIT
End DoDot:1
+30 LOCK -^MAGV(2006.941,ID)
+31 QUIT
+32 ; RPC: MAGV IMPORT STATUS
IMSTATUS(OUT,UIDS) ; Get import status
+1 ;P332 routine size exceeded - Moved to MAGVIM09
DO IMSTATUS^MAGVIM09(.OUT,.UIDS)
+2 QUIT
UPUSRAPP(OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
+1 NEW FDA,APPIEN
+2 SET FDA(2006.941,ID_",",3)=NEWSTAT
+3 SET FDA(2006.941,ID_",",9)=$$NOW^XLFDT
+4 ; LAST UPDATING USER - User DUZ is passed
if $GET(UPDUSR)'=""
SET FDA(2006.941,ID_",",10)="`"_UPDUSR
+5 IF $GET(UPDAPP)'=""
Begin DoDot:1
+6 ; Get application IEN or create a new one first
SET APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)
+7 ; LAST UPDATING APPLICATION
SET FDA(2006.941,ID_",",15)=UPDAPP
+8 QUIT
End DoDot:1
+9 ; Update Work Item ID with FDA data and MSGUPD message
SET OUT(0)=$$UPDWI^MAGVIM09(ID,.FDA)
+10 QUIT
UPCASE(X) ;
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
