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. 
MAGVCWIA ;WOIFO/MAT,DAC - DICOM Storage Commit RPCs  ; Nov 05, 2020@07:23:38

 ;;3.0;IMAGING;**138,162,283**;Mar 19, 2002;Build 5;Nov 20, 2015

 ;; Per VHA Directive 2004-038, 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

 ;##### Create Storage Commit Work Item w/ optional pre-store processing.

 ;      RPC: MAGVC WI SUBMIT NEW

 ;

 ;       Calls: CRTITEM^MAGVIM01 [RPC: MAGV SUBMIT WORK ITEM]

 ;              

 ; Input

 ; =====

 ;

 ;  RETURN      Array for output

 ;  MSGTAGS     Array of Tag`Value pairs:

 ;

 ;                Item##### tag values are "~"-delimited artifact UIDs.

 ;

 ;  STAT        Boolean: 1=Process when submitted; 0=not (default)

 ;

 ; Output

 ; ======

 ;  

 ;  Error ..... <0`errmsg

 ;  Success ...  0`## lines returned

 ;               (1..n) echo MSGTAGS input (w/ "~"-3,4 piece status flags).

 ;

ACTCRE8(RETURN,MSGTAGS,STAT) ;

 ;

 ;--- Quit on invalid KERNEL service account user identifier.

 I ($G(DUZ)="")!($G(DUZ(2))="") D  Q

 . S RETURN(0)="-1`Invalid user service account."

 . Q

 ;

 ;

 I $G(STAT)="" S STAT=0

 ;--- Default status subject to change if Item UIDs not unique.

 N STATUS S STATUS="RECEIVED"

 ;--- Note DICOM UID format etc. is pre-validated by Java side.

 N CTITEMS,CTWINS,ITEMCT,MAGERR S (CTITEMS,CTWINS,ITEMCT,MAGERR)=0

 ;

 ;--- Initialize tag(name)=variable array.

 N TAGS K TAGS

 N APPNAME S APPNAME="",TAGS("ApplicationName")="APPNAME"

 N HOSTNAME S HOSTNAME="",TAGS("HostName")="HOSTNAME"

 N ITEMCT S ITEMCT="",TAGS("ItemCount")="ITEMCT"

 N RESPDTTM S RESPDTTM="",TAGS("ResponseDateTime")="RESPDTTM"

 N RETRY2GO S RETRY2GO="",TAGS("RetriesLeft")="RETRY2GO"

 N TRANSXID S TRANSXID="",TAGS("TransactionID")="TRANSXID"

 ;

 N UIDZ K UIDZ

 N TXTAG S TXTAG=0

 ;--- Parse MSGTAGS array for item meta-info.

 D

 . N TAGCT S TAGCT=0

 . F  S TAGCT=$O(MSGTAGS(TAGCT)) Q:TAGCT=""  D

 . . ;

 . . ;--- Recover tag-embedded data.

 . . N VAR S VAR=0

 . . S TAG=$P(MSGTAGS(TAGCT),"`")

 . . S:$D(TAGS(TAG)) VAR=TAGS(TAG),@VAR=$P(MSGTAGS(TAGCT),"`",2)

 . . S:(TAG="TransactionID") TXTAG=TAGCT

 . . ;--- Process "Item#####" tags.

 . . D:TAG?1"Item"5N

 . . . ;

 . . . ;--- Array Item#####s to verify Instance UIDs are unique.

 . . . ;--- ANY duplication FAILS the SC Request at the Work Item level.

 . . . N YNTWIN

 . . . S YNTWIN=$$ACTCRE8A(.MSGTAGS,TAGCT,STAT) S:YNTWIN CTWINS=CTWINS+1

 . . . S CTITEMS=CTITEMS+1

 . . . ;--- Rename tag so MAGVIM01 files values as WP field lines.

 . . . S $P(MSGTAGS(TAGCT),"`")="MSG"_TAG

 . . . Q

 . . Q

 . ;--- Quit (-2) if TransactionID already on file.

 . I ''$D(^MAGV(2006.941,"SCTX",TRANSXID)) D  Q

 . . S MAGERR=-2_"`"_"TransactionID already in use."

 . . Q

 . ;--- Quit (-4) if ItemCT '= Count of Item#####s

 . I ITEMCT'=CTITEMS D  Q

 . . S MAGERR=-4_"`"_"ItemCount ("_ITEMCT_") <> ("_CTITEMS_") Items Submitted."

 . . Q

 . Q

 ;

 I +MAGERR<0 S RETURN(0)=MAGERR Q

 ;

 ;--- Set WI STATUS to FAILED if any UID is duplicated.

 S:+CTWINS STATUS="FAILURE"

 ;

 ;--- Delete the TransactionID tag and re-subscript remaining array elements.

 D:TXTAG

 . K MSGTAGS(TXTAG)

 . F  S TXTAG=$O(MSGTAGS(TXTAG)) Q:TXTAG=""  D

 . . S MSGTAGS(TXTAG-1)=MSGTAGS(TXTAG) K MSGTAGS(TXTAG)

 . . Q

 . Q

 ;--- If STAT was invoked and WI did not fail due to item duplication,

 ;      set WI STATUS (=FAILURE on first "U" encountered).

 D:(STAT&(STATUS'="FAILURE"))

 . ;--- Set aggregate STATUS.

 . N FAILURE,TAG S (FAILURE,TAG)=0

 . F  S TAG=$O(MSGTAGS(TAG)) Q:TAG=""  Q:FAILURE  D

 . . ;

 . . S:($P(MSGTAGS(TAG),"~",3)="U") FAILURE=1

 . . Q

 . ;

 . S STATUS=$S(FAILURE:"FAILURE",1:"SUCCESS")

 . Q

 ;--- Initialize variables for call to CRTITEM^MAGVIM01.

 N CRTUSR,PLACEID S CRTUSR=DUZ,PLACEID=DUZ(2) ;--- Service Account User.

 N CRTAPP,SUBTYPE,TYPE S (CRTAPP,SUBTYPE,TYPE)="StorageCommit"

 N PRIORITY S PRIORITY="0"

 S PLACEID=$$STA^XUAF4(PLACEID) ; P283 DAC - the MAG WORK ITEM will now only accept Station Numbers

 ;--- Post entry to the MAG WORK ITEM & MAG WORK ITEM HISTORY files.

 D CRTITEM^MAGVIM01(.OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)

 ;

 ;--- Quit on error from the create call.

 I +OUT<0 S RETURN(0)=OUT Q

 N WIIEN S WIIEN=$P(OUT,"`",2)

 K OUT

 ;

 ;--- Store the TransactionId

 N FDA S FDA(2006.941,WIIEN_",",16)=TRANSXID

 D FILE^DIE("","FDA")

 ;

 ;--- Return the work item. Note this call makes assumptions about STATUS which

 ;      may changed when on-demand processing is invoked.

 D ACTGET(.RETURN,WIIEN)

 Q

 ;+++++ Internal Entry Point: Array item Instance UIDs & detect duplicates.

ACTCRE8A(MSGTAGS,TAGCT,STAT) ;

 ;

 N YNTWIN S YNTWIN=0

 N UIDI S UIDI=$P(MSGTAGS(TAGCT),"~",2)

 ;--- Set new array entry ...

 I '$D(UIDZ(UIDI)) D

 . S UIDZ(UIDI)=""

 . Q

 ;--- ... or mark as duplicate (do not mark older twin per CPT).

 E  D

 . S YNTWIN=1,$P(MSGTAGS(TAGCT),"~",3,4)="U~D"

 . Q

 ;--- Do not process a known duplicated UID.

 Q:YNTWIN YNTWIN

 ;--- Conditional branch to on-demand processing.

 D:STAT

 . ;--- Query < MAG*3.0*34 structure.

 . N STATITEM S STATITEM=$$QRYLEGAC^MAGVCQRY(UIDI)

 . ;--- Query >= MAG*3.0*34 structure.

 . I 'STATITEM S STATITEM=$$QRYCURNT^MAGVCQRY(UIDI)

 . S $P(MSGTAGS(TAGCT),"~",3,4)=$S(STATITEM:"C~",1:"U~U")

 . Q

 Q YNTWIN

 ;

 ;##### Delete Storage Commit Work Item

 ;      RPC: MAGVC WI DELETE

 ;

 ; Inputs

 ; ======

 ;

 ;  RETURN      Target array for output

 ;  WIIEN       IEN of the MAG WORK ITEM (#2006.941) entry to delete.

 ;

ACTDEL(RETURN,WIIEN) ;

 ;

 I '$D(^MAGV(2006.941,WIIEN)) S RETURN=-1_"`"_"Work item "_WIIEN_" not found." Q 

 ;

 ; RPC: MAGV DELETE WORK ITEM

 D DELWITEM^MAGVIM01(.RETURN,WIIEN)

 Q

 ;##### Get Storage Commit Work Item(s)

 ;      RPC: MAGVC WI GET

 ;

 ;       Calls: GETITEM^MAGVIM01 [RPC: MAGV GET WORK ITEM]

 ;

 ; Inputs

 ; ======

 ;

 ;  RETURN      Target array for output

 ;  WIIEN       IEN of the MAG WORK ITEM (#2006.941) entry to return. 

 ;  STAT        Boolean: 1=Process; 0=not (default)

 ;

 ; Output

 ; ======

 ;  

 ;  Error ..... <0`errmsg

 ;  Success ...  0`## lines returned

 ;               (1..n) lines of tag`value data w/ "~"-3,4 piece status flags.

 ;

ACTGET(RETURN,WIIEN,STAT) ;

 ;

 ;--- Quit on invalid KERNEL service account user identifier.

 I $G(DUZ)="" S RETURN(0)="-1`Invalid user service account." Q

 ;

 S:$G(STAT)="" STAT=0

 N CALLSTAT S CALLSTAT=0

 ;--- Process first if STAT.

 N WISTAT ; P162 DAC - No need to look up failed statuses and prevent statuses to be reset to "FAILURE"

 S WISTAT=$$GET1^DIQ(2006.941,WIIEN,3) ; P162 DAC

 I (WISTAT="SENDING RESPONSE FAILED")!(WISTAT="FAILURE") S STAT=0 ; P162 DAC

 I STAT=1 N ERROR S CALLSTAT=$$MAIN^MAGVCQRY(.ERROR,WIIEN)

 I +CALLSTAT<0 S RETURN(0)=CALLSTAT Q

 ;

 ;--- Set EXPSTAT as f(STAT).

 N EXPSTAT S EXPSTAT=$$GET1^DIQ(2006.941,WIIEN,3)

 N NEWSTAT S NEWSTAT=EXPSTAT

 N UPDAPP S UPDAPP="StorageCommit"

 N UPDUSR S UPDUSR=DUZ

 ;

 ; RPC: MAGV GET WORK ITEM

 ; Find work item with matching ID and return tags - Get and transition

 ;

 K OUT

 D GETITEM^MAGVIM01(.OUT,WIIEN,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP)

 ;

 ;--- Output error from the GETITEM call.

 I +OUT(0)<0 M RETURN=OUT Q

 ;

 K OUTB

 ;--- Arrange meta-tag output.

 N ND S ND=""

 F  S ND=$O(OUT(ND)) Q:ND=""  D

 . ;

 . Q:OUT(ND)'["Tag"

 . S OUTB($P($P(OUT(ND),"`",2),"|"))=$P(OUT(ND),"|",2)

 . Q

 K OUT

 S OUT(1)="ApplicationName"_"`"_OUTB("ApplicationName")

 S OUT(2)="TransactionID"_"`"_$$GET1^DIQ(2006.941,WIIEN,16)

 S OUT(3)="HostName"_"`"_OUTB("HostName")

 S OUT(4)="ResponseDateTime"_"`"_OUTB("ResponseDateTime")

 S OUT(5)="RetriesLeft"_"`"_OUTB("RetriesLeft")

 S OUT(6)="scWIstatus"_"`"_$$GET1^DIQ(2006.941,WIIEN,3)

 S OUT(7)="ItemCount"_"`"_OUTB("ItemCount")

 ;

 ;--- Rebuild Item##### tags from WP field data.

 N LN S LN=7

 N LNWP S LNWP=0

 F  S LNWP=$O(^MAGV(2006.941,WIIEN,2,LNWP)) Q:LNWP=""  D

 . S LN=LN+1

 . S OUT(LN)="Item"_$E((100000+LNWP),2,6)_"`"_$G(^MAGV(2006.941,WIIEN,2,LNWP,0))

 . Q

 M RETURN=OUT

 S RETURN(0)=0_"`"_WIIEN

 Q

 ;##### List Storage Commit Work Item(s)

 ;      RPC: MAGVC WI LIST

 ;

 ; Input

 ; =====

 ;   RETURN     target output array

 ;   [HOSTNAME] value of input tag "HostName" on which to filter.

 ;                    (if omitted, returns all HostNames)

 ;

 ;   [WILIMIT]  maxium number of work items to return in one RPC call

 ;   [LASTIEN]  the last work item IEN returned in the previous RPC call

 ;

 ; Output

 ; ======

 ;   Error:   (0)    <0`errmsg

 ;   Success: (0)     0`n lines returned

 ;            (1..n)  |-1 IEN of WorkItem

 ;                     -2 Status 

 ;                     -3 ResponseDateTime (in "millis"econds)

 ;                     -4 Retries Left

 ;                     -5 HostName

 ;

ACTLIST(RETURN,HOSTNAME,WILIMIT,LASTIEN) ; P162 DAC - Modified to support additional parameters and return smaller lists

 ;

 S HOSTNAME=$G(HOSTNAME),WILIMIT=$G(WILIMIT),LASTIEN=$G(LASTIEN)

 ;

 ;--- Get IEN of "StorageCommit" entry in WORKLIST file (#2006.9412).

 N SCIEN S SCIEN=$$FIND1^DIC(2006.9412,,,"StorageCommit")

 ;

 ;--- Traverse IEN's "T" cross-reference for member Work Items.

 N OUT K OUT

 N FILE S FILE=2006.941

 N WIIEN S WIIEN=""

 N COUNTER S COUNTER=0

 I LASTIEN'="" S WIIEN=LASTIEN

 F  S WIIEN=$O(^MAGV(FILE,"T",SCIEN,WIIEN)) Q:WIIEN=""  Q:COUNTER=WILIMIT  D  ; P162 DAC - Added work Item Limit check

 . ;

 . N WISTATUS S WISTATUS=$$GET1^DIQ(FILE,WIIEN,3)

 . ;--- Recover tag-embedded data.

 . N HOST S HOST=""

 . N RESPDTTM,RETRY2GO S (RESPDTTM,RETRY2GO)=""

 . N TGIEN S TGIEN=0

 . F  S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN=""  D

 . . ;

 . . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)

 . . N VAL S VAL=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)

 . . S:TAG="ResponseDateTime" RESPDTTM=VAL

 . . S:TAG="RetriesLeft" RETRY2GO=VAL

 . . S:TAG="HostName" HOST=VAL

 . . Q

 . Q:(RESPDTTM="")

 . ;

 . ;--- Optional filter by HOSTNAME.

 . I HOSTNAME="" D

 . . S OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST

 . . S COUNTER=COUNTER+1  ; P162 DAC - Increment record returned counter

 . . Q

 . E  D

 . . S:HOSTNAME=HOST OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST

 . . S COUNTER=COUNTER+1  ; P162 DAC - Increment record returned counter

 . . Q

 . Q

 ;--- Re-index array & return.

 N CT,NOD S (CT,NOD)=0

 F  S NOD=$O(OUT(NOD)) Q:NOD=""  S CT=CT+1,RETURN(CT)=OUT(NOD)

 S RETURN(0)=0_"`"_CT  ; P162 DAC  - Return record count

 Q

 ;##### Update Storage Commit Work Item Status

 ;      RPC: MAGVC WI UPDATE STATUS

 ;

ACTUPD8(RETURN,WIIEN,NEWSTAT) ;

 ;

 ;--- Get Current Status

 N NOWSTAT S NOWSTAT=$$GET1^DIQ(2006.941,WIIEN,3)

 ;

 ;--- Quit (-2) if status is IN PROGRESS.

 I NOWSTAT="IN PROGRESS" D  Q

 . S RETURN(0)=-2_"`"_"WI is "_NOWSTAT_"."

 ;

 ;--- Handle subsequent "SENDING RESPONSE FAILED" set requests.

 I (NEWSTAT="SENDING RESPONSE FAILED")&(NOWSTAT=NEWSTAT) D  Q

 . ;

 . ;--- Decrement RetriesLeft tag.

 . D ZUPD8FLG(.OUT,.WIIEN,"RetriesLeft")

 . I +OUT<0 S RETURN(0)=OUT Q

 . N RETRY2GO S RETRY2GO=$P(OUT,"`",2)

 . ;

 . ;--- Return.

 . D ACTGET(.RETURN,.WIIEN)

 . S RETURN(0)=0_"`"_WIIEN_"`"_"Decremented RetriesLeft to "_RETRY2GO_"."

 . Q

 ;--- Otherwise quit (-4) if status is already at the requested status.

 I NOWSTAT=NEWSTAT D  Q

 . S RETURN(0)=-4_"`"_"WI Status is already "_NEWSTAT_"."

 . Q

 ;--- Update the item's STATUS.

 N FDA S FDA(2006.941,WIIEN_",",3)=NEWSTAT

 N MAGERR

 D FILE^DIE("E","FDA","MAGERR")

 ;--- Quit on trapped UPDATER Error

 I $D(MAGERR) D  Q

 . S RETURN(0)=-6_"`"_MAGERR("DIERR",1,"TEXT",1)

 . Q

 ;--- Return.

 D ACTGET(.RETURN,.WIIEN)

 S RETURN(0)=0_"`"_WIIEN_"`"_"Updated to "_NEWSTAT_"."

 Q

 ;--- Decrement RetriesLeft Tag if >1 "Sending Response Failed" set attempt.

 ;

ZUPD8FLG(OUT,WIIEN,TAGIN) ;

 ;

 K OUT S OUT="0`"

 ;

 ;--- Recover tag-embedded data.

 N FILE S FILE=2006.941

 N TGIEN S TGIEN=0

 F  S TGIEN=$O(^MAGV(FILE,WIIEN,4,TGIEN)) Q:TGIEN=""  D

 . ;

 . N TAG S TAG=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)

 . D:(TAG=TAGIN)

 . . N RETRIES,RETRY2GO S (RETRIES,RETRY2GO)=""

 . . S RETRIES=$P($G(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)

 . . S RETRY2GO=RETRIES-1

 . . I RETRY2GO<0 S OUT=-1_"`RetriesLeft is already "_0_"." Q

 . . S $P(^MAGV(FILE,WIIEN,4,TGIEN,0),U,2)=RETRY2GO

 . . S $P(OUT,"`",2)=RETRY2GO

 . . Q

 . Q

 Q

 ;