- 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 Jan 18, 2025@03:11 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 ;