Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGVIM01

MAGVIM01.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VA Directive 6402, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1. OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
  1.  Q "|"
  1. STATSEP() ; Status and result separator ie. -3``No record IEN
  1.  Q "`"
  1. INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
  1.  Q "`"
  1.  ; RPC: MAGV GET WORKLISTS
  1. GETLIST(OUT) ; Returns all worklist names and statuses
  1.  N IEN,OSEP,SSEP,FILE,WORKLIST,I
  1.  S IEN=0,I=0,OSEP=$$OUTSEP,SSEP=$$STATSEP,FILE=2006.9412
  1.  F  S IEN=$O(^MAGV(FILE,IEN)) Q:+IEN=0  D
  1.  . S I=I+1,WORKLIST=$G(^MAGV(FILE,IEN,0))
  1.  . S OUT(I+1)=$P(WORKLIST,U,1)_OSEP_$P(WORKLIST,U,2)
  1.  I I>0 S OUT(1)=0_SSEP_I
  1.  Q
  1.  ; RPC: MAGV CREATE WORK ITEM
  1. 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.  N FDA,FDA2,ERR,ERR2,SMIEN,ISEP,SSEP,MSG,APPIEN,LOCIEN,I,CRTDAT,SRV,MDL,PROC,SRC,TAGN,TAGV,TAGIDX
  1.  S SSEP=$$STATSEP,ISEP=$$INPUTSEP
  1.  S CRTDAT=$$NOW^XLFDT ; CREATED DATE/TIME
  1.  S UPDSRV=$G(UPDSRV,0) ;Set Service based on modality and procedure
  1.  K OUT
  1.  I $G(TYPE)="" S OUT=-6_SSEP_"No work item TYPE provided" Q
  1.  I $G(SUBTYPE)="" S OUT=-7_SSEP_"No work item SUBTYPE provided" Q
  1.  I $G(STATUS)="" S OUT=-8_SSEP_"No work item STATUS provided" Q
  1.  I $G(PLACEID)="" S OUT=-9_SSEP_"No work item LOCATION provided" Q
  1.  I $G(PRIORITY)="" S OUT=-10_SSEP_"No work item PRIORITY provided" Q
  1.  I ($G(CRTUSR)="")&($G(CRTAPP)="") S OUT=-11_SSEP_"No work item USER/APPLICATION provided" Q
  1.  ; P250 DAC - Removed P142 LOCATION screen
  1.  ; P283 DAC - This function will now only accepts Station Numbers as inputs. Will convert to Institution IEN before filing.
  1.  S LOCIEN=$$IEN^XUAF4(PLACEID) ; If it wasn't a LOCATION IEN, it should be a STATION NUMBER
  1.  I '$G(LOCIEN) S OUT=-11_SSEP_"Invalid LOCATION provided" Q  ; If it was a LOCATION IEN or a STATION NUMBER
  1.  S FDA(2006.941,"+1,",.01)=CRTDAT
  1.  S FDA(2006.941,"+1,",1)=TYPE
  1.  S FDA(2006.941,"+1,",2)=SUBTYPE
  1.  S FDA(2006.941,"+1,",3)=STATUS
  1.  S FDA(2006.941,"+1,",5)=PRIORITY
  1.  S FDA(2006.941,"+1,",9)=CRTDAT
  1.  S:$G(CRTUSR)'="" (FDA(2006.941,"+1,",8),FDA(2006.941,"+1,",10))="`"_CRTUSR  ; user DUZ is passed
  1.  I $G(CRTAPP)'="" D
  1.  . S APPIEN=$$GETIEN^MAGVAF05(2006.9193,CRTAPP,1)  ; Get application IEN
  1.  . S (FDA(2006.941,"+1,",14),FDA(2006.941,"+1,",15))=CRTAPP
  1.  . Q
  1.  ; Add message text and tag names and values
  1.  F I=1:1 Q:'$D(MSGTAGS(I))  D
  1.  . S TAGN=$P(MSGTAGS(I),ISEP,1)
  1.  . S TAGV=$P(MSGTAGS(I),ISEP,2)
  1.  . S TAGIDX=I+1
  1.  . I $E(TAGN,1,3)="MSG" S MSG(TAGIDX)=TAGV Q
  1.  . S FDA(2006.94111,"+"_TAGIDX_",+1,",.01)=TAGN  ; TAG NAME
  1.  . S FDA(2006.94111,"+"_TAGIDX_",+1,",1)=TAGV    ; TAG VALUE
  1.  . I UPDSRV,TAGN="Modality" S MDL=TAGV Q
  1.  . I UPDSRV,TAGN="Procedure" S PROC=TAGV Q
  1.  . I UPDSRV,TAGN="Source" S SRC=TAGV Q
  1.  . Q
  1.  ; Update Service based on Modality and Procedure
  1.  S ERR=""
  1.  I UPDSRV,$G(MDL)'="" D
  1.  . S SRV=$$GETSRV^MAGVIM12(MDL,$G(PROC))
  1.  . I $P(SRV,U,1)="-1" S ERR=SRV Q
  1.  . Q
  1.  I ERR'="" S OUT="-1"_SSEP_$P(ERR,U,2) Q
  1.  K ERR
  1.  D VALIDATE^MAGVIM06(.FDA,.ERR)
  1.  ; Quit on validation error
  1.  I $D(ERR) S OUT="-4"_SSEP_$G(ERR) Q
  1.  ; Set Work Item
  1.  K ERR
  1.  L +^MAGV(2006.941,0):5 I $T D
  1.  . D UPDATE^DIE("E","FDA","SMIEN","ERR")
  1.  . S FDA2(2006.941,SMIEN(1)_",",4)=LOCIEN
  1.  . D FILE^DIE("I","FDA2","ERR2") ; P250 DAC - Update LOCATION separately with the internal value
  1.  . 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
  1.  . D
  1.  . . I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-1"_SSEP_$G(ERR("DIERR",1,"TEXT",1)) Q
  1.  . . ; File message as word processing field
  1.  . . K ERR
  1.  . . I $D(MSG) D  Q:$D(ERR)  ; Quit if error during saving
  1.  . . . D WP^DIE(2006.941,SMIEN(1)_",",13,"K","MSG","ERR")
  1.  . . . I $D(ERR) S OUT="-3"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
  1.  . . . Q
  1.  . . ; Return ID of new entry
  1.  . . S OUT=0_SSEP_SMIEN(1)
  1.  . . Q
  1.  . L -^MAGV(2006.941,0)
  1.  E  D
  1.  . S OUT=-5_SSEP_"Unable to lock MAG WORK ITEM file."
  1.  . Q
  1.  Q
  1.  ;
  1.  ; RPC: MAGV UPDATE WORK ITEM
  1. UPDITEM(OUT,ID,EXPSTAT,NEWSTAT,MESSAGE,UPDUSR,UPDAPP) ; Update work item status and create an entry in the work history file
  1.  N FDA,SSEP,ISEP,MSGUPD,APPIEN
  1.  S SSEP=$$STATSEP,ISEP=$$INPUTSEP
  1.  I '$D(^MAGV(2006.941,ID)) S OUT="-6"_SSEP_"Work item "_ID_" not found" Q
  1.  I $G(EXPSTAT)="" S OUT=-7_SSEP_"No work item expected status provided" Q
  1.  I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT=-8_SSEP_"No updated by user/application provided" Q
  1.  L +^MAGV(2006.941,ID):1999999
  1.  S RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
  1.  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
  1.  I NEWSTAT'="" S FDA(2006.941,ID_",",3)=NEWSTAT
  1.  ;
  1.  F I=1:1 Q:'$D(MESSAGE(I))  D
  1.  . I $E($P(MESSAGE(I),ISEP,1),1,3)="MSG" S MSGUPD(I+1)=$P(MESSAGE(I),ISEP,2)
  1.  . Q
  1.  ;
  1.  S FDA(2006.941,ID_",",9)=$$NOW^XLFDT  ; LAST UPDATED DATE/TIME
  1.  S:$G(UPDUSR)'="" FDA(2006.941,ID_",",10)="`"_UPDUSR  ; LAST UPDATING USER - User DUZ
  1.  I $G(UPDAPP)'="" D
  1.  . S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)  ; Get application IEN or create a new one
  1.  . S FDA(2006.941,ID_",",15)=UPDAPP      ; LAST UPDATING APP
  1.  . Q
  1.  ;
  1.  S OUT=$$UPDWI^MAGVIM09(ID,.FDA,.MSGUPD)  ; Update Work Item ID with FDA data, MSGUPD message
  1.  L -^MAGV(2006.941,ID)
  1.  Q
  1.  ;
  1.  ; RPC: MAGV FIND WORK ITEM
  1. 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
  1.  D FIND^MAGVIM09(.OUT,.TYPE,.SUBTYPE,.STATUS,.PLACEID,.PRIORITY,.STOPTAG,.MAXROWS,.TAGS,.LASTIEN,.ORDER,.DTFROM,.DTTO)  ;P357 routine size exceeded - Moved to MAGVIM09
  1.  Q
  1.  ;
  1. DTINRNG(IEN,DTFROM,DTTO) ;
  1.  N DAT S DAT=+$P($P($G(^MAGV(2006.941,IEN,0)),U),".")
  1.  Q (DAT'<DTFROM)&(DAT'>DTTO)
  1.  ;
  1. GFLTITM(FLTITM,TAGS) ;This to improve loading performance
  1.  N TAGITM,TAG,TAGVAL,VALUE,IEN,IEN2,FILTER,FLTITM2,NOFILTER,DAT
  1.  ;
  1.  K FILTER
  1.  S TAGITM=0
  1.  F  S TAGITM=$O(TAGS(TAGITM)) Q:TAGITM=""  D
  1.  . S TAG=$P(TAGS(TAGITM),ISEP,1),VALUE=$P(TAGS(TAGITM),ISEP,2)
  1.  . I TAG'="Procedure"&(TAG'="Modality")&(TAG'="Source")&(TAG'="Service")&(TAG'="PatientName") Q
  1.  . I TAG'="",VALUE'="",VALUE'="[No Procedure]",VALUE'="[No Modality]",VALUE'="[No Service]" S FILTER(TAG)=VALUE
  1.  ;
  1.  Q:'$D(FILTER) 0  ;no filter on service, source, procedure, modality 
  1.  ;
  1.  K FLTITM,FLTITM2
  1.  S TAG="Procedure"
  1.  S VALUE=$G(FILTER(TAG))
  1.  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
  1.  I VALUE'="",VALUE'="[No Procedure]",$L(VALUE)>30 D  Q:'$D(FLTITM) 1  ;can't find such procedure
  1.  . S IEN=0
  1.  . F  S IEN=$O(^MAGV(2006.941,"H",TAG,IEN)) Q:'IEN  D
  1.  . . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
  1.  . . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
  1.  . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . I TAGVAL=VALUE S FLTITM(IEN)="" ;,FLTITM2(DAT,IEN)=""
  1.  ;
  1.  K FLTITM3,FLTITM4
  1.  S TAG="Modality",VALUE=$G(FILTER(TAG))
  1.  I VALUE'="",VALUE'="[No Modality]" D  Q:'$D(FLTITM) 1  ;can't find such modality
  1.  . S NOFILTER='$D(FLTITM)
  1.  . I NOFILTER M FLTITM=^MAGV(2006.941,"HH",TAG,VALUE) Q
  1.  . I 'NOFILTER D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(FLTITM(IEN)) Q:'IEN  D
  1.  . . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . . I $D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
  1.  . . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
  1.  ;
  1.  K FLTITM3,FLTITM4
  1.  S TAG="Source",VALUE=$G(FILTER(TAG))
  1.  S NOFILTER='$D(FLTITM)
  1.  I VALUE'="",NOFILTER D  Q:'$D(FLTITM) 1  ;can't find such Source
  1.  . I $L(VALUE)<31 M FLTITM=^MAGV(2006.941,"HH",TAG,VALUE) Q
  1.  . I $L(VALUE)>30 D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(^MAGV(2006.941,"H",TAG,IEN)) Q:'IEN  D
  1.  . . . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
  1.  . . . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
  1.  . . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . . I TAGVAL=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
  1.  . . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
  1.  ; 
  1.  I VALUE'="",'NOFILTER D  Q:'$D(FLTITM) 1  ;can't find such source
  1.  . I $L(VALUE)<31 D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(FLTITM(IEN)) Q:'IEN  D
  1.  . . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . . I $D(^MAGV(2006.941,"HH",TAG,VALUE,IEN)) S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
  1.  . I $L(VALUE)>30 D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(FLTITM(IEN)) Q:'IEN  D
  1.  . . . S IEN2=$O(^MAGV(2006.941,"H",TAG,IEN,""))
  1.  . . . S TAGVAL=$P($G(^MAGV(2006.941,IEN,4,IEN2,0)),U,2)
  1.  . . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . . I TAGVAL=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
  1.  . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
  1.  ;
  1.  K FLTITM3,FLTITM4
  1.  S TAG="Service",VALUE=$G(FILTER(TAG))
  1.  I VALUE'="",VALUE'="[No Service]",'$D(FLTITM) Q 0  ;Service is a calculated field, can't use "HH" index
  1.  I VALUE'="",VALUE'="[No Service]",$D(FLTITM) D
  1.  . S IEN=0
  1.  . F  S IEN=$O(FLTITM(IEN)) Q:'IEN  D
  1.  . . ;S DAT=$P($G(^MAGV(2006.941,IEN,0)),U)
  1.  . . I $$SRV(IEN)=VALUE S FLTITM3(IEN)="" ;,FLTITM4(DAT,IEN)=""
  1.  . K FLTITM,FLTITM2 M FLTITM=FLTITM3 ;,FLTITM2=FLTITM4
  1.  ;
  1.  S TAG="PatientName",VALUE=$G(FILTER(TAG))
  1.  I VALUE'="",'$D(FLTITM) Q 0  ;can't use index, patientname can be filtered using partial
  1.  ;
  1.  Q 1  ;use the filtered items for further processing
  1.  ;
  1. SRV(IEN) ;return Service
  1.  N MTGIDX,MOD,MODS,PTGIDX,PROC,SRV
  1.  N CM S CM=","
  1.  S MTGIDX=0,MODS=""
  1.  F  S MTGIDX=$O(^MAGV(2006.941,"H","Modality",IEN,MTGIDX)) Q:'MTGIDX  D
  1.  . S MOD=$P(^MAGV(2006.941,IEN,4,MTGIDX,0),U,2)
  1.  . I (CM_MODS_CM)'[(CM_MOD_CM) S MODS=MODS_MOD_","
  1.  I MODS'="" S MODS=$E(MODS,1,$L(MODS)-1)
  1.  I MODS="" Q ""
  1.  ; 
  1.  S PTGIDX=$O(^MAGV(2006.941,"H","Procedure",IEN,""))
  1.  I 'PTGIDX Q $$DESCR($$GETS^MAGVIM12(MODS,""))
  1.  S PROC=$P(^MAGV(2006.941,IEN,4,PTGIDX,0),U,2)
  1.  I PROC="" Q $$DESCR($$GETS^MAGVIM12(MODS,""))
  1.  ;
  1.  Q $$DESCR($$GETS^MAGVIM12(MODS,PROC))
  1.  ;
  1. DESCR(SRV) ;
  1.  I SRV="RAD" Q "Radiology"
  1.  I SRV="CON" Q "Consult"
  1.  I SRV="LAB" Q "Lab"
  1.  Q ""
  1.  ;
  1.  ; RPC: MAGV GET WORK ITEM
  1. GETITEM(OUT,ID,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP) ; Find work item with matching ID and return tags
  1.  N I,J,SSEP,RSTAT,FDA,APPIEN
  1.  S SSEP=$$STATSEP
  1.  K OUT
  1.  I $G(ID)="" S OUT(0)=-1_SSEP_"No work item ID" Q
  1.  I $G(EXPSTAT)="" S OUT(0)=-2_SSEP_"No expected status" Q
  1.  I $G(NEWSTAT)="" S OUT(0)=-3_SSEP_"No new status" Q
  1.  I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT(0)=-4_SSEP_"No updated by user/application" Q
  1.  I '$D(^MAGV(2006.941,ID)) S OUT(0)=-5_SSEP_"No work item with matching ID" Q
  1.  S RSTAT=$$GET1^DIQ(2006.941,ID,"STATUS")
  1.  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
  1.  L +^MAGV(2006.941,ID):1999999
  1.  S OUT(0)=0
  1.  I NEWSTAT'=EXPSTAT D UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
  1.  I +OUT(0)=0 D
  1.  . S OUT(0)=0
  1.  . D GETWI^MAGVIM09(.OUT,ID)  ; Get Work Item Record
  1.  . Q 
  1.  L -^MAGV(2006.941,ID)
  1.  Q
  1.  ; RPC: MAGV DELETE WORK ITEM
  1. DELWITEM(OUT,ID) ; Delete Work Item
  1.  N FDA,SSEP
  1.  S SSEP=$$STATSEP
  1.  I '$D(^MAGV(2006.941,ID)) S OUT=-1_SSEP_"Work item "_ID_" not found." Q
  1.  S FDA(2006.941,ID_",",.01)="@"
  1.  L +^MAGV(2006.941,0):5 I $T D
  1.  . ;--- Do not decrement FileMan highest entry value during delete.
  1.  . N MAXIEN S MAXIEN=$P(^MAGV(2006.941,0),U,3)
  1.  . D FILE^DIE("","FDA")
  1.  . S:$P(^MAGV(2006.941,0),U,3)<MAXIEN $P(^MAGV(2006.941,0),U,3)=MAXIEN
  1.  . S OUT=0_SSEP_"Work item "_ID_" deleted."
  1.  . L -^MAGV(2006.941,0)
  1.  . Q
  1.  E  D
  1.  . S OUT=-2_SSEP_"Work item "_ID_" is locked."
  1.  . Q
  1.  Q
  1.  ; RPC: MAGV ADD WORK ITEM TAGS
  1. ADDTAG(OUT,ID,EXPSTAT,UPDUSR,UPDAPP,TAG) ; Add tags to work item
  1.  N FDA1,FDA2,ERR1,ERR4,STATMATCH,STATUS,SSEP,ISEP,I,APPIEN,MSGUPD
  1.  S SSEP=$$STATSEP,ISEP=$$INPUTSEP
  1.  I $G(ID)="" S OUT=-9_SSEP_"No work item ID" Q
  1.  I '$D(^MAGV(2006.941,ID)) S OUT=-5_SSEP_"No work item with matching ID" Q
  1.  I '$D(EXPSTAT) S OUT=-6_SSEP_"No status provided" Q
  1.  I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT=-7_SSEP_"No updated by user/application" Q
  1.  I $G(TAG(1))="" S OUT=-8_SSEP_"No tag" Q
  1.  S STATUS=$$GET1^DIQ(2006.941,ID,"STATUS")
  1.  S STATMATCH=0
  1.  F I=1:1  Q:$P(EXPSTAT,ISEP,I)=""  Q:STATMATCH  D
  1.  . I $P(EXPSTAT,ISEP,I)=STATUS S STATMATCH=1
  1.  . Q
  1.  I STATMATCH=0 S OUT=-9_SSEP_"work item does not have expected status" Q
  1.  L +^MAGV(2006.941,ID):1999999
  1.  F I=1:1  Q:'$D(TAG(I))  D
  1.  . S FDA1(2006.94111,"+"_I_","_ID_",",.01)=$P(TAG(I),ISEP,1)  ; TAG NAME
  1.  . S FDA1(2006.94111,"+"_I_","_ID_",",1)=$P(TAG(I),ISEP,2)    ; TAG VALUE
  1.  . Q
  1.  D VALIDATE^MAGVIM06(.FDA1,.ERR4)
  1.  I $D(ERR4) S OUT="-11"_SSEP_$G(ERR4) L -^MAGV(2006.941,ID) Q  ; Unlock/quit
  1.  D UPDATE^DIE("","FDA1","","ERR1")
  1.  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
  1.  ; Set Work Item
  1.  S FDA2(2006.941,ID_",",9)=$$NOW^XLFDT
  1.  S:$G(UPDUSR)'="" FDA2(2006.941,ID_",",10)="`"_UPDUSR  ; LAST UPDATING USER - User DUZ is passed
  1.  I $G(UPDAPP)'="" D
  1.  . S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)  ; Get application IEN or create a new one first
  1.  . S FDA2(2006.941,ID_",",15)=UPDAPP      ; LAST UPDATING APP
  1.  . Q
  1.  S OUT=$$UPDWI^MAGVIM09(ID,.FDA2,.MSGUPD)  ; Update Work Item ID with FDA data, MSGUPD message
  1.  L -^MAGV(2006.941,ID)
  1.  Q
  1.  ; RPC: MAGV GET NEXT WORK ITEM
  1. GETNEXT(OUT,ETYPE,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP,LOCATION) ; Find last update work item on worklist type provided
  1.  N SSEP,ID,ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT
  1.  K OUT
  1.  S SSEP=$$STATSEP
  1.  I $G(ETYPE)="" S OUT(0)=-1_SSEP_"Work Item type not specified" Q
  1.  I $G(EXPSTAT)="" S OUT(0)=-2_SSEP_"Work Item expected status not specified" Q
  1.  I $G(NEWSTAT)="" S OUT(0)=-3_SSEP_"Work Item new status not specified" Q
  1.  I ($G(UPDUSR)="")&($G(UPDAPP)="") S OUT(0)=-4_SSEP_"No updated by user/application provided" Q
  1.  I $G(LOCATION)="" S OUT(0)=-5_SSEP_"Work Item Place ID not specified" Q
  1.  ; 
  1.  S ETYPEIEN=$O(^MAGV(2006.9412,"B",ETYPE,""))
  1.  S ESTATIEN=$O(^MAGV(2006.9413,"B",EXPSTAT,""))
  1.  S ELOCIEN=$$IEN^XUAF4(LOCATION) ; get Location IEN
  1.  ;
  1.  I ETYPEIEN'>0 S OUT(0)=-6_SSEP_"Work Item type IEN not found: "_ETYPE Q
  1.  I ESTATIEN'>0 S OUT(0)=-7_SSEP_"Work Item expected status IEN not found: "_EXPSTAT Q 
  1.  I ELOCIEN'>0 S OUT(0)=-8_SSEP_"Work Item Place ID not found: "_LOCATION Q
  1.  ; 
  1.  ;Get last updated record with matching parameters
  1.  S UPDATEDT=$O(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,""))
  1.  I 'UPDATEDT S OUT(0)=0_SSEP_"No matching work item found" Q
  1.  S ID=$O(^MAGV(2006.941,"C",ETYPEIEN,ESTATIEN,ELOCIEN,UPDATEDT,""))
  1.  I 'ID S OUT(0)=0_SSEP_"No matching work item found" Q
  1.  L +^MAGV(2006.941,ID):1999999
  1.  S OUT(0)=0
  1.  I NEWSTAT'=EXPSTAT D UPUSRAPP(.OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
  1.  I +OUT(0)=0 D
  1.  . S OUT(0)=0
  1.  . D GETWI^MAGVIM09(.OUT,ID)  ; Get Work Item Record
  1.  . Q 
  1.  L -^MAGV(2006.941,ID)
  1.  Q
  1.  ; RPC: MAGV IMPORT STATUS
  1. IMSTATUS(OUT,UIDS) ; Get import status
  1.  D IMSTATUS^MAGVIM09(.OUT,.UIDS)  ;P332 routine size exceeded - Moved to MAGVIM09
  1.  Q
  1. UPUSRAPP(OUT,ID,NEWSTAT,UPDUSR,UPDAPP) ; Update user, app, updated time fields
  1.  N FDA,APPIEN
  1.  S FDA(2006.941,ID_",",3)=NEWSTAT
  1.  S FDA(2006.941,ID_",",9)=$$NOW^XLFDT
  1.  S:$G(UPDUSR)'="" FDA(2006.941,ID_",",10)="`"_UPDUSR  ; LAST UPDATING USER - User DUZ is passed
  1.  I $G(UPDAPP)'="" D
  1.  . S APPIEN=$$GETIEN^MAGVAF05(2006.9193,UPDAPP,1)  ; Get application IEN or create a new one first
  1.  . S FDA(2006.941,ID_",",15)=UPDAPP      ; LAST UPDATING APPLICATION
  1.  . Q
  1.  S OUT(0)=$$UPDWI^MAGVIM09(ID,.FDA)  ; Update Work Item ID with FDA data and MSGUPD message
  1.  Q
  1. UPCASE(X) ;
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;