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. ;