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

MAGVCWIA.m

Go to the documentation of this file. 
  1. MAGVCWIA ;WOIFO/MAT,DAC - DICOM Storage Commit RPCs  ; Nov 05, 2020@07:23:38
  1.  ;;3.0;IMAGING;**138,162,283**;Mar 19, 2002;Build 5;Nov 20, 2015
  1.  ;; Per VHA Directive 2004-038, 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.  ;##### Create Storage Commit Work Item w/ optional pre-store processing.
  1.  ;      RPC: MAGVC WI SUBMIT NEW
  1.  ;
  1.  ;       Calls: CRTITEM^MAGVIM01 [RPC: MAGV SUBMIT WORK ITEM]
  1.  ;              
  1.  ; Input
  1.  ; =====
  1.  ;
  1.  ;  RETURN      Array for output
  1.  ;  MSGTAGS     Array of Tag`Value pairs:
  1.  ;
  1.  ;                Item##### tag values are "~"-delimited artifact UIDs.
  1.  ;
  1.  ;  STAT        Boolean: 1=Process when submitted; 0=not (default)
  1.  ;
  1.  ; Output
  1.  ; ======
  1.  ;  
  1.  ;  Error ..... <0`errmsg
  1.  ;  Success ...  0`## lines returned
  1.  ;               (1..n) echo MSGTAGS input (w/ "~"-3,4 piece status flags).
  1.  ;
  1. ACTCRE8(RETURN,MSGTAGS,STAT) ;
  1.  ;
  1.  ;--- Quit on invalid KERNEL service account user identifier.
  1.  I ($G(DUZ)="")!($G(DUZ(2))="") D  Q
  1.  . S RETURN(0)="-1`Invalid user service account."
  1.  . Q
  1.  ;
  1.  ;
  1.  I $G(STAT)="" S STAT=0
  1.  ;--- Default status subject to change if Item UIDs not unique.
  1.  N STATUS S STATUS="RECEIVED"
  1.  ;--- Note DICOM UID format etc. is pre-validated by Java side.
  1.  N CTITEMS,CTWINS,ITEMCT,MAGERR S (CTITEMS,CTWINS,ITEMCT,MAGERR)=0
  1.  ;
  1.  ;--- Initialize tag(name)=variable array.
  1.  N TAGS K TAGS
  1.  N APPNAME S APPNAME="",TAGS("ApplicationName")="APPNAME"
  1.  N HOSTNAME S HOSTNAME="",TAGS("HostName")="HOSTNAME"
  1.  N ITEMCT S ITEMCT="",TAGS("ItemCount")="ITEMCT"
  1.  N RESPDTTM S RESPDTTM="",TAGS("ResponseDateTime")="RESPDTTM"
  1.  N RETRY2GO S RETRY2GO="",TAGS("RetriesLeft")="RETRY2GO"
  1.  N TRANSXID S TRANSXID="",TAGS("TransactionID")="TRANSXID"
  1.  ;
  1.  N UIDZ K UIDZ
  1.  N TXTAG S TXTAG=0
  1.  ;--- Parse MSGTAGS array for item meta-info.
  1.  D
  1.  . N TAGCT S TAGCT=0
  1.  . F  S TAGCT=$O(MSGTAGS(TAGCT)) Q:TAGCT=""  D
  1.  . . ;
  1.  . . ;--- Recover tag-embedded data.
  1.  . . N VAR S VAR=0
  1.  . . S TAG=$P(MSGTAGS(TAGCT),"`")
  1.  . . S:$D(TAGS(TAG)) VAR=TAGS(TAG),@VAR=$P(MSGTAGS(TAGCT),"`",2)
  1.  . . S:(TAG="TransactionID") TXTAG=TAGCT
  1.  . . ;--- Process "Item#####" tags.
  1.  . . D:TAG?1"Item"5N
  1.  . . . ;
  1.  . . . ;--- Array Item#####s to verify Instance UIDs are unique.
  1.  . . . ;--- ANY duplication FAILS the SC Request at the Work Item level.
  1.  . . . N YNTWIN
  1.  . . . S YNTWIN=$$ACTCRE8A(.MSGTAGS,TAGCT,STAT) S:YNTWIN CTWINS=CTWINS+1
  1.  . . . S CTITEMS=CTITEMS+1
  1.  . . . ;--- Rename tag so MAGVIM01 files values as WP field lines.
  1.  . . . S $P(MSGTAGS(TAGCT),"`")="MSG"_TAG
  1.  . . . Q
  1.  . . Q
  1.  . ;--- Quit (-2) if TransactionID already on file.
  1.  . I ''$D(^MAGV(2006.941,"SCTX",TRANSXID)) D  Q
  1.  . . S MAGERR=-2_"`"_"TransactionID already in use."
  1.  . . Q
  1.  . ;--- Quit (-4) if ItemCT '= Count of Item#####s
  1.  . I ITEMCT'=CTITEMS D  Q
  1.  . . S MAGERR=-4_"`"_"ItemCount ("_ITEMCT_") <> ("_CTITEMS_") Items Submitted."
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I +MAGERR<0 S RETURN(0)=MAGERR Q
  1.  ;
  1.  ;--- Set WI STATUS to FAILED if any UID is duplicated.
  1.  S:+CTWINS STATUS="FAILURE"
  1.  ;
  1.  ;--- Delete the TransactionID tag and re-subscript remaining array elements.
  1.  D:TXTAG
  1.  . K MSGTAGS(TXTAG)
  1.  . F  S TXTAG=$O(MSGTAGS(TXTAG)) Q:TXTAG=""  D
  1.  . . S MSGTAGS(TXTAG-1)=MSGTAGS(TXTAG) K MSGTAGS(TXTAG)
  1.  . . Q
  1.  . Q
  1.  ;--- If STAT was invoked and WI did not fail due to item duplication,
  1.  ;      set WI STATUS (=FAILURE on first "U" encountered).
  1.  D:(STAT&(STATUS'="FAILURE"))
  1.  . ;--- Set aggregate STATUS.
  1.  . N FAILURE,TAG S (FAILURE,TAG)=0
  1.  . F  S TAG=$O(MSGTAGS(TAG)) Q:TAG=""  Q:FAILURE  D
  1.  . . ;
  1.  . . S:($P(MSGTAGS(TAG),"~",3)="U") FAILURE=1
  1.  . . Q
  1.  . ;
  1.  . S STATUS=$S(FAILURE:"FAILURE",1:"SUCCESS")
  1.  . Q
  1.  ;--- Initialize variables for call to CRTITEM^MAGVIM01.
  1.  N CRTUSR,PLACEID S CRTUSR=DUZ,PLACEID=DUZ(2) ;--- Service Account User.
  1.  N CRTAPP,SUBTYPE,TYPE S (CRTAPP,SUBTYPE,TYPE)="StorageCommit"
  1.  N PRIORITY S PRIORITY="0"
  1.  S PLACEID=$$STA^XUAF4(PLACEID) ; P283 DAC - the MAG WORK ITEM will now only accept Station Numbers
  1.  ;--- Post entry to the MAG WORK ITEM & MAG WORK ITEM HISTORY files.
  1.  D CRTITEM^MAGVIM01(.OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
  1.  ;
  1.  ;--- Quit on error from the create call.
  1.  I +OUT<0 S RETURN(0)=OUT Q
  1.  N WIIEN S WIIEN=$P(OUT,"`",2)
  1.  K OUT
  1.  ;
  1.  ;--- Store the TransactionId
  1.  N FDA S FDA(2006.941,WIIEN_",",16)=TRANSXID
  1.  D FILE^DIE("","FDA")
  1.  ;
  1.  ;--- Return the work item. Note this call makes assumptions about STATUS which
  1.  ;      may changed when on-demand processing is invoked.
  1.  D ACTGET(.RETURN,WIIEN)
  1.  Q
  1.  ;+++++ Internal Entry Point: Array item Instance UIDs & detect duplicates.
  1. ACTCRE8A(MSGTAGS,TAGCT,STAT) ;
  1.  ;
  1.  N YNTWIN S YNTWIN=0
  1.  N UIDI S UIDI=$P(MSGTAGS(TAGCT),"~",2)
  1.  ;--- Set new array entry ...
  1.  I '$D(UIDZ(UIDI)) D
  1.  . S UIDZ(UIDI)=""
  1.  . Q
  1.  ;--- ... or mark as duplicate (do not mark older twin per CPT).
  1.  E  D
  1.  . S YNTWIN=1,$P(MSGTAGS(TAGCT),"~",3,4)="U~D"
  1.  . Q
  1.  ;--- Do not process a known duplicated UID.
  1.  Q:YNTWIN YNTWIN
  1.  ;--- Conditional branch to on-demand processing.
  1.  D:STAT
  1.  . ;--- Query < MAG*3.0*34 structure.
  1.  . N STATITEM S STATITEM=$$QRYLEGAC^MAGVCQRY(UIDI)
  1.  . ;--- Query >= MAG*3.0*34 structure.
  1.  . I 'STATITEM S STATITEM=$$QRYCURNT^MAGVCQRY(UIDI)
  1.  . S $P(MSGTAGS(TAGCT),"~",3,4)=$S(STATITEM:"C~",1:"U~U")
  1.  . Q
  1.  Q YNTWIN
  1.  ;
  1.  ;##### Delete Storage Commit Work Item
  1.  ;      RPC: MAGVC WI DELETE
  1.  ;
  1.  ; Inputs
  1.  ; ======
  1.  ;
  1.  ;  RETURN      Target array for output
  1.  ;  WIIEN       IEN of the MAG WORK ITEM (#2006.941) entry to delete.
  1.  ;
  1. ACTDEL(RETURN,WIIEN) ;
  1.  ;
  1.  I '$D(^MAGV(2006.941,WIIEN)) S RETURN=-1_"`"_"Work item "_WIIEN_" not found." Q 
  1.  ;
  1.  ; RPC: MAGV DELETE WORK ITEM
  1.  D DELWITEM^MAGVIM01(.RETURN,WIIEN)
  1.  Q
  1.  ;##### Get Storage Commit Work Item(s)
  1.  ;      RPC: MAGVC WI GET
  1.  ;
  1.  ;       Calls: GETITEM^MAGVIM01 [RPC: MAGV GET WORK ITEM]
  1.  ;
  1.  ; Inputs
  1.  ; ======
  1.  ;
  1.  ;  RETURN      Target array for output
  1.  ;  WIIEN       IEN of the MAG WORK ITEM (#2006.941) entry to return. 
  1.  ;  STAT        Boolean: 1=Process; 0=not (default)
  1.  ;
  1.  ; Output
  1.  ; ======
  1.  ;  
  1.  ;  Error ..... <0`errmsg
  1.  ;  Success ...  0`## lines returned
  1.  ;               (1..n) lines of tag`value data w/ "~"-3,4 piece status flags.
  1.  ;
  1. ACTGET(RETURN,WIIEN,STAT) ;
  1.  ;
  1.  ;--- Quit on invalid KERNEL service account user identifier.
  1.  I $G(DUZ)="" S RETURN(0)="-1`Invalid user service account." Q
  1.  ;
  1.  S:$G(STAT)="" STAT=0
  1.  N CALLSTAT S CALLSTAT=0
  1.  ;--- Process first if STAT.
  1.  N WISTAT ; P162 DAC - No need to look up failed statuses and prevent statuses to be reset to "FAILURE"
  1.  S WISTAT=$$GET1^DIQ(2006.941,WIIEN,3) ; P162 DAC
  1.  I (WISTAT="SENDING RESPONSE FAILED")!(WISTAT="FAILURE") S STAT=0 ; P162 DAC
  1.  I STAT=1 N ERROR S CALLSTAT=$$MAIN^MAGVCQRY(.ERROR,WIIEN)
  1.  I +CALLSTAT<0 S RETURN(0)=CALLSTAT Q
  1.  ;
  1.  ;--- Set EXPSTAT as f(STAT).
  1.  N EXPSTAT S EXPSTAT=$$GET1^DIQ(2006.941,WIIEN,3)
  1.  N NEWSTAT S NEWSTAT=EXPSTAT
  1.  N UPDAPP S UPDAPP="StorageCommit"
  1.  N UPDUSR S UPDUSR=DUZ
  1.  ;
  1.  ; RPC: MAGV GET WORK ITEM
  1.  ; Find work item with matching ID and return tags - Get and transition
  1.  ;
  1.  K OUT
  1.  D GETITEM^MAGVIM01(.OUT,WIIEN,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP)
  1.  ;
  1.  ;--- Output error from the GETITEM call.
  1.  I +OUT(0)<0 M RETURN=OUT Q
  1.  ;
  1.  K OUTB
  1.  ;--- Arrange meta-tag output.
  1.  N ND S ND=""
  1.  F  S ND=$O(OUT(ND)) Q:ND=""  D
  1.  . ;
  1.  . Q:OUT(ND)'["Tag"
  1.  . S OUTB($P($P(OUT(ND),"`",2),"|"))=$P(OUT(ND),"|",2)
  1.  . Q
  1.  K OUT
  1.  S OUT(1)="ApplicationName"_"`"_OUTB("ApplicationName")
  1.  S OUT(2)="TransactionID"_"`"_$$GET1^DIQ(2006.941,WIIEN,16)
  1.  S OUT(3)="HostName"_"`"_OUTB("HostName")
  1.  S OUT(4)="ResponseDateTime"_"`"_OUTB("ResponseDateTime")
  1.  S OUT(5)="RetriesLeft"_"`"_OUTB("RetriesLeft")
  1.  S OUT(6)="scWIstatus"_"`"_$$GET1^DIQ(2006.941,WIIEN,3)
  1.  S OUT(7)="ItemCount"_"`"_OUTB("ItemCount")
  1.  ;
  1.  ;--- Rebuild Item##### tags from WP field data.
  1.  N LN S LN=7
  1.  N LNWP S LNWP=0
  1.  F  S LNWP=$O(^MAGV(2006.941,WIIEN,2,LNWP)) Q:LNWP=""  D
  1.  . S LN=LN+1
  1.  . S OUT(LN)="Item"_$E((100000+LNWP),2,6)_"`"_$G(^MAGV(2006.941,WIIEN,2,LNWP,0))
  1.  . Q
  1.  M RETURN=OUT
  1.  S RETURN(0)=0_"`"_WIIEN
  1.  Q
  1.  ;##### List Storage Commit Work Item(s)
  1.  ;      RPC: MAGVC WI LIST
  1.  ;
  1.  ; Input
  1.  ; =====
  1.  ;   RETURN     target output array
  1.  ;   [HOSTNAME] value of input tag "HostName" on which to filter.
  1.  ;                    (if omitted, returns all HostNames)
  1.  ;
  1.  ;   [WILIMIT]  maxium number of work items to return in one RPC call
  1.  ;   [LASTIEN]  the last work item IEN returned in the previous RPC call
  1.  ;
  1.  ; Output
  1.  ; ======
  1.  ;   Error:   (0)    <0`errmsg
  1.  ;   Success: (0)     0`n lines returned
  1.  ;            (1..n)  |-1 IEN of WorkItem
  1.  ;                     -2 Status 
  1.  ;                     -3 ResponseDateTime (in "millis"econds)
  1.  ;                     -4 Retries Left
  1.  ;                     -5 HostName
  1.  ;
  1. ACTLIST(RETURN,HOSTNAME,WILIMIT,LASTIEN) ; P162 DAC - Modified to support additional parameters and return smaller lists
  1.  ;
  1.  S HOSTNAME=$G(HOSTNAME),WILIMIT=$G(WILIMIT),LASTIEN=$G(LASTIEN)
  1.  ;
  1.  ;--- Get IEN of "StorageCommit" entry in WORKLIST file (#2006.9412).
  1.  N SCIEN S SCIEN=$$FIND1^DIC(2006.9412,,,"StorageCommit")
  1.  ;
  1.  ;--- Traverse IEN's "T" cross-reference for member Work Items.
  1.  N OUT K OUT
  1.  N FILE S FILE=2006.941
  1.  N WIIEN S WIIEN=""
  1.  N COUNTER S COUNTER=0
  1.  I LASTIEN'="" S WIIEN=LASTIEN
  1.  F  S WIIEN=$O(^MAGV(FILE,"T",SCIEN,WIIEN)) Q:WIIEN=""  Q:COUNTER=WILIMIT  D  ; P162 DAC - Added work Item Limit check
  1.  . ;
  1.  . N WISTATUS S WISTATUS=$$GET1^DIQ(FILE,WIIEN,3)
  1.  . ;--- Recover tag-embedded data.
  1.  . N HOST S HOST=""
  1.  . N RESPDTTM,RETRY2GO S (RESPDTTM,RETRY2GO)=""
  1.  . N TGIEN S TGIEN=0
  1.  . F  S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN=""  D
  1.  . . ;
  1.  . . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)
  1.  . . N VAL S VAL=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)
  1.  . . S:TAG="ResponseDateTime" RESPDTTM=VAL
  1.  . . S:TAG="RetriesLeft" RETRY2GO=VAL
  1.  . . S:TAG="HostName" HOST=VAL
  1.  . . Q
  1.  . Q:(RESPDTTM="")
  1.  . ;
  1.  . ;--- Optional filter by HOSTNAME.
  1.  . I HOSTNAME="" D
  1.  . . S OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST
  1.  . . S COUNTER=COUNTER+1  ; P162 DAC - Increment record returned counter
  1.  . . Q
  1.  . E  D
  1.  . . S:HOSTNAME=HOST OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST
  1.  . . S COUNTER=COUNTER+1  ; P162 DAC - Increment record returned counter
  1.  . . Q
  1.  . Q
  1.  ;--- Re-index array & return.
  1.  N CT,NOD S (CT,NOD)=0
  1.  F  S NOD=$O(OUT(NOD)) Q:NOD=""  S CT=CT+1,RETURN(CT)=OUT(NOD)
  1.  S RETURN(0)=0_"`"_CT  ; P162 DAC  - Return record count
  1.  Q
  1.  ;##### Update Storage Commit Work Item Status
  1.  ;      RPC: MAGVC WI UPDATE STATUS
  1.  ;
  1. ACTUPD8(RETURN,WIIEN,NEWSTAT) ;
  1.  ;
  1.  ;--- Get Current Status
  1.  N NOWSTAT S NOWSTAT=$$GET1^DIQ(2006.941,WIIEN,3)
  1.  ;
  1.  ;--- Quit (-2) if status is IN PROGRESS.
  1.  I NOWSTAT="IN PROGRESS" D  Q
  1.  . S RETURN(0)=-2_"`"_"WI is "_NOWSTAT_"."
  1.  ;
  1.  ;--- Handle subsequent "SENDING RESPONSE FAILED" set requests.
  1.  I (NEWSTAT="SENDING RESPONSE FAILED")&(NOWSTAT=NEWSTAT) D  Q
  1.  . ;
  1.  . ;--- Decrement RetriesLeft tag.
  1.  . D ZUPD8FLG(.OUT,.WIIEN,"RetriesLeft")
  1.  . I +OUT<0 S RETURN(0)=OUT Q
  1.  . N RETRY2GO S RETRY2GO=$P(OUT,"`",2)
  1.  . ;
  1.  . ;--- Return.
  1.  . D ACTGET(.RETURN,.WIIEN)
  1.  . S RETURN(0)=0_"`"_WIIEN_"`"_"Decremented RetriesLeft to "_RETRY2GO_"."
  1.  . Q
  1.  ;--- Otherwise quit (-4) if status is already at the requested status.
  1.  I NOWSTAT=NEWSTAT D  Q
  1.  . S RETURN(0)=-4_"`"_"WI Status is already "_NEWSTAT_"."
  1.  . Q
  1.  ;--- Update the item's STATUS.
  1.  N FDA S FDA(2006.941,WIIEN_",",3)=NEWSTAT
  1.  N MAGERR
  1.  D FILE^DIE("E","FDA","MAGERR")
  1.  ;--- Quit on trapped UPDATER Error
  1.  I $D(MAGERR) D  Q
  1.  . S RETURN(0)=-6_"`"_MAGERR("DIERR",1,"TEXT",1)
  1.  . Q
  1.  ;--- Return.
  1.  D ACTGET(.RETURN,.WIIEN)
  1.  S RETURN(0)=0_"`"_WIIEN_"`"_"Updated to "_NEWSTAT_"."
  1.  Q
  1.  ;--- Decrement RetriesLeft Tag if >1 "Sending Response Failed" set attempt.
  1.  ;
  1. ZUPD8FLG(OUT,WIIEN,TAGIN) ;
  1.  ;
  1.  K OUT S OUT="0`"
  1.  ;
  1.  ;--- Recover tag-embedded data.
  1.  N FILE S FILE=2006.941
  1.  N TGIEN S TGIEN=0
  1.  F  S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN=""  D
  1.  . ;
  1.  . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)
  1.  . D:(TAG=TAGIN)
  1.  . . N RETRIES,RETRY2GO S (RETRIES,RETRY2GO)=""
  1.  . . S RETRIES=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)
  1.  . . S RETRY2GO=RETRIES-1
  1.  . . I RETRY2GO<0 S OUT=-1_"`RetriesLeft is already "_0_"." Q
  1.  . . S $P(^MAGV(FILE,WIIEN,4,TGIEN,0),U,2)=RETRY2GO
  1.  . . S $P(OUT,"`",2)=RETRY2GO
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;