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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVCWIA 13340 printed Oct 16, 2024@18:10:16 Page 2
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
+2 ;; Per VHA Directive 2004-038, 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
+18 ;##### Create Storage Commit Work Item w/ optional pre-store processing.
+19 ; RPC: MAGVC WI SUBMIT NEW
+20 ;
+21 ; Calls: CRTITEM^MAGVIM01 [RPC: MAGV SUBMIT WORK ITEM]
+22 ;
+23 ; Input
+24 ; =====
+25 ;
+26 ; RETURN Array for output
+27 ; MSGTAGS Array of Tag`Value pairs:
+28 ;
+29 ; Item##### tag values are "~"-delimited artifact UIDs.
+30 ;
+31 ; STAT Boolean: 1=Process when submitted; 0=not (default)
+32 ;
+33 ; Output
+34 ; ======
+35 ;
+36 ; Error ..... <0`errmsg
+37 ; Success ... 0`## lines returned
+38 ; (1..n) echo MSGTAGS input (w/ "~"-3,4 piece status flags).
+39 ;
ACTCRE8(RETURN,MSGTAGS,STAT) ;
+1 ;
+2 ;--- Quit on invalid KERNEL service account user identifier.
+3 IF ($GET(DUZ)="")!($GET(DUZ(2))="")
Begin DoDot:1
+4 SET RETURN(0)="-1`Invalid user service account."
+5 QUIT
End DoDot:1
QUIT
+6 ;
+7 ;
+8 IF $GET(STAT)=""
SET STAT=0
+9 ;--- Default status subject to change if Item UIDs not unique.
+10 NEW STATUS
SET STATUS="RECEIVED"
+11 ;--- Note DICOM UID format etc. is pre-validated by Java side.
+12 NEW CTITEMS,CTWINS,ITEMCT,MAGERR
SET (CTITEMS,CTWINS,ITEMCT,MAGERR)=0
+13 ;
+14 ;--- Initialize tag(name)=variable array.
+15 NEW TAGS
KILL TAGS
+16 NEW APPNAME
SET APPNAME=""
SET TAGS("ApplicationName")="APPNAME"
+17 NEW HOSTNAME
SET HOSTNAME=""
SET TAGS("HostName")="HOSTNAME"
+18 NEW ITEMCT
SET ITEMCT=""
SET TAGS("ItemCount")="ITEMCT"
+19 NEW RESPDTTM
SET RESPDTTM=""
SET TAGS("ResponseDateTime")="RESPDTTM"
+20 NEW RETRY2GO
SET RETRY2GO=""
SET TAGS("RetriesLeft")="RETRY2GO"
+21 NEW TRANSXID
SET TRANSXID=""
SET TAGS("TransactionID")="TRANSXID"
+22 ;
+23 NEW UIDZ
KILL UIDZ
+24 NEW TXTAG
SET TXTAG=0
+25 ;--- Parse MSGTAGS array for item meta-info.
+26 Begin DoDot:1
+27 NEW TAGCT
SET TAGCT=0
+28 FOR
SET TAGCT=$ORDER(MSGTAGS(TAGCT))
if TAGCT=""
QUIT
Begin DoDot:2
+29 ;
+30 ;--- Recover tag-embedded data.
+31 NEW VAR
SET VAR=0
+32 SET TAG=$PIECE(MSGTAGS(TAGCT),"`")
+33 if $DATA(TAGS(TAG))
SET VAR=TAGS(TAG)
SET @VAR=$PIECE(MSGTAGS(TAGCT),"`",2)
+34 if (TAG="TransactionID")
SET TXTAG=TAGCT
+35 ;--- Process "Item#####" tags.
+36 if TAG?1"Item"5N
Begin DoDot:3
+37 ;
+38 ;--- Array Item#####s to verify Instance UIDs are unique.
+39 ;--- ANY duplication FAILS the SC Request at the Work Item level.
+40 NEW YNTWIN
+41 SET YNTWIN=$$ACTCRE8A(.MSGTAGS,TAGCT,STAT)
if YNTWIN
SET CTWINS=CTWINS+1
+42 SET CTITEMS=CTITEMS+1
+43 ;--- Rename tag so MAGVIM01 files values as WP field lines.
+44 SET $PIECE(MSGTAGS(TAGCT),"`")="MSG"_TAG
+45 QUIT
End DoDot:3
+46 QUIT
End DoDot:2
+47 ;--- Quit (-2) if TransactionID already on file.
+48 IF ''$DATA(^MAGV(2006.941,"SCTX",TRANSXID))
Begin DoDot:2
+49 SET MAGERR=-2_"`"_"TransactionID already in use."
+50 QUIT
End DoDot:2
QUIT
+51 ;--- Quit (-4) if ItemCT '= Count of Item#####s
+52 IF ITEMCT'=CTITEMS
Begin DoDot:2
+53 SET MAGERR=-4_"`"_"ItemCount ("_ITEMCT_") <> ("_CTITEMS_") Items Submitted."
+54 QUIT
End DoDot:2
QUIT
+55 QUIT
End DoDot:1
+56 ;
+57 IF +MAGERR<0
SET RETURN(0)=MAGERR
QUIT
+58 ;
+59 ;--- Set WI STATUS to FAILED if any UID is duplicated.
+60 if +CTWINS
SET STATUS="FAILURE"
+61 ;
+62 ;--- Delete the TransactionID tag and re-subscript remaining array elements.
+63 if TXTAG
Begin DoDot:1
+64 KILL MSGTAGS(TXTAG)
+65 FOR
SET TXTAG=$ORDER(MSGTAGS(TXTAG))
if TXTAG=""
QUIT
Begin DoDot:2
+66 SET MSGTAGS(TXTAG-1)=MSGTAGS(TXTAG)
KILL MSGTAGS(TXTAG)
+67 QUIT
End DoDot:2
+68 QUIT
End DoDot:1
+69 ;--- If STAT was invoked and WI did not fail due to item duplication,
+70 ; set WI STATUS (=FAILURE on first "U" encountered).
+71 if (STAT&(STATUS'="FAILURE"))
Begin DoDot:1
+72 ;--- Set aggregate STATUS.
+73 NEW FAILURE,TAG
SET (FAILURE,TAG)=0
+74 FOR
SET TAG=$ORDER(MSGTAGS(TAG))
if TAG=""
QUIT
if FAILURE
QUIT
Begin DoDot:2
+75 ;
+76 if ($PIECE(MSGTAGS(TAG),"~",3)="U")
SET FAILURE=1
+77 QUIT
End DoDot:2
+78 ;
+79 SET STATUS=$SELECT(FAILURE:"FAILURE",1:"SUCCESS")
+80 QUIT
End DoDot:1
+81 ;--- Initialize variables for call to CRTITEM^MAGVIM01.
+82 ;--- Service Account User.
NEW CRTUSR,PLACEID
SET CRTUSR=DUZ
SET PLACEID=DUZ(2)
+83 NEW CRTAPP,SUBTYPE,TYPE
SET (CRTAPP,SUBTYPE,TYPE)="StorageCommit"
+84 NEW PRIORITY
SET PRIORITY="0"
+85 ; P283 DAC - the MAG WORK ITEM will now only accept Station Numbers
SET PLACEID=$$STA^XUAF4(PLACEID)
+86 ;--- Post entry to the MAG WORK ITEM & MAG WORK ITEM HISTORY files.
+87 DO CRTITEM^MAGVIM01(.OUT,TYPE,SUBTYPE,STATUS,PLACEID,PRIORITY,.MSGTAGS,CRTUSR,CRTAPP)
+88 ;
+89 ;--- Quit on error from the create call.
+90 IF +OUT<0
SET RETURN(0)=OUT
QUIT
+91 NEW WIIEN
SET WIIEN=$PIECE(OUT,"`",2)
+92 KILL OUT
+93 ;
+94 ;--- Store the TransactionId
+95 NEW FDA
SET FDA(2006.941,WIIEN_",",16)=TRANSXID
+96 DO FILE^DIE("","FDA")
+97 ;
+98 ;--- Return the work item. Note this call makes assumptions about STATUS which
+99 ; may changed when on-demand processing is invoked.
+100 DO ACTGET(.RETURN,WIIEN)
+101 QUIT
+102 ;+++++ Internal Entry Point: Array item Instance UIDs & detect duplicates.
ACTCRE8A(MSGTAGS,TAGCT,STAT) ;
+1 ;
+2 NEW YNTWIN
SET YNTWIN=0
+3 NEW UIDI
SET UIDI=$PIECE(MSGTAGS(TAGCT),"~",2)
+4 ;--- Set new array entry ...
+5 IF '$DATA(UIDZ(UIDI))
Begin DoDot:1
+6 SET UIDZ(UIDI)=""
+7 QUIT
End DoDot:1
+8 ;--- ... or mark as duplicate (do not mark older twin per CPT).
+9 IF '$TEST
Begin DoDot:1
+10 SET YNTWIN=1
SET $PIECE(MSGTAGS(TAGCT),"~",3,4)="U~D"
+11 QUIT
End DoDot:1
+12 ;--- Do not process a known duplicated UID.
+13 if YNTWIN
QUIT YNTWIN
+14 ;--- Conditional branch to on-demand processing.
+15 if STAT
Begin DoDot:1
+16 ;--- Query < MAG*3.0*34 structure.
+17 NEW STATITEM
SET STATITEM=$$QRYLEGAC^MAGVCQRY(UIDI)
+18 ;--- Query >= MAG*3.0*34 structure.
+19 IF 'STATITEM
SET STATITEM=$$QRYCURNT^MAGVCQRY(UIDI)
+20 SET $PIECE(MSGTAGS(TAGCT),"~",3,4)=$SELECT(STATITEM:"C~",1:"U~U")
+21 QUIT
End DoDot:1
+22 QUIT YNTWIN
+23 ;
+24 ;##### Delete Storage Commit Work Item
+25 ; RPC: MAGVC WI DELETE
+26 ;
+27 ; Inputs
+28 ; ======
+29 ;
+30 ; RETURN Target array for output
+31 ; WIIEN IEN of the MAG WORK ITEM (#2006.941) entry to delete.
+32 ;
ACTDEL(RETURN,WIIEN) ;
+1 ;
+2 IF '$DATA(^MAGV(2006.941,WIIEN))
SET RETURN=-1_"`"_"Work item "_WIIEN_" not found."
QUIT
+3 ;
+4 ; RPC: MAGV DELETE WORK ITEM
+5 DO DELWITEM^MAGVIM01(.RETURN,WIIEN)
+6 QUIT
+7 ;##### Get Storage Commit Work Item(s)
+8 ; RPC: MAGVC WI GET
+9 ;
+10 ; Calls: GETITEM^MAGVIM01 [RPC: MAGV GET WORK ITEM]
+11 ;
+12 ; Inputs
+13 ; ======
+14 ;
+15 ; RETURN Target array for output
+16 ; WIIEN IEN of the MAG WORK ITEM (#2006.941) entry to return.
+17 ; STAT Boolean: 1=Process; 0=not (default)
+18 ;
+19 ; Output
+20 ; ======
+21 ;
+22 ; Error ..... <0`errmsg
+23 ; Success ... 0`## lines returned
+24 ; (1..n) lines of tag`value data w/ "~"-3,4 piece status flags.
+25 ;
ACTGET(RETURN,WIIEN,STAT) ;
+1 ;
+2 ;--- Quit on invalid KERNEL service account user identifier.
+3 IF $GET(DUZ)=""
SET RETURN(0)="-1`Invalid user service account."
QUIT
+4 ;
+5 if $GET(STAT)=""
SET STAT=0
+6 NEW CALLSTAT
SET CALLSTAT=0
+7 ;--- Process first if STAT.
+8 ; P162 DAC - No need to look up failed statuses and prevent statuses to be reset to "FAILURE"
NEW WISTAT
+9 ; P162 DAC
SET WISTAT=$$GET1^DIQ(2006.941,WIIEN,3)
+10 ; P162 DAC
IF (WISTAT="SENDING RESPONSE FAILED")!(WISTAT="FAILURE")
SET STAT=0
+11 IF STAT=1
NEW ERROR
SET CALLSTAT=$$MAIN^MAGVCQRY(.ERROR,WIIEN)
+12 IF +CALLSTAT<0
SET RETURN(0)=CALLSTAT
QUIT
+13 ;
+14 ;--- Set EXPSTAT as f(STAT).
+15 NEW EXPSTAT
SET EXPSTAT=$$GET1^DIQ(2006.941,WIIEN,3)
+16 NEW NEWSTAT
SET NEWSTAT=EXPSTAT
+17 NEW UPDAPP
SET UPDAPP="StorageCommit"
+18 NEW UPDUSR
SET UPDUSR=DUZ
+19 ;
+20 ; RPC: MAGV GET WORK ITEM
+21 ; Find work item with matching ID and return tags - Get and transition
+22 ;
+23 KILL OUT
+24 DO GETITEM^MAGVIM01(.OUT,WIIEN,EXPSTAT,NEWSTAT,UPDUSR,UPDAPP)
+25 ;
+26 ;--- Output error from the GETITEM call.
+27 IF +OUT(0)<0
MERGE RETURN=OUT
QUIT
+28 ;
+29 KILL OUTB
+30 ;--- Arrange meta-tag output.
+31 NEW ND
SET ND=""
+32 FOR
SET ND=$ORDER(OUT(ND))
if ND=""
QUIT
Begin DoDot:1
+33 ;
+34 if OUT(ND)'["Tag"
QUIT
+35 SET OUTB($PIECE($PIECE(OUT(ND),"`",2),"|"))=$PIECE(OUT(ND),"|",2)
+36 QUIT
End DoDot:1
+37 KILL OUT
+38 SET OUT(1)="ApplicationName"_"`"_OUTB("ApplicationName")
+39 SET OUT(2)="TransactionID"_"`"_$$GET1^DIQ(2006.941,WIIEN,16)
+40 SET OUT(3)="HostName"_"`"_OUTB("HostName")
+41 SET OUT(4)="ResponseDateTime"_"`"_OUTB("ResponseDateTime")
+42 SET OUT(5)="RetriesLeft"_"`"_OUTB("RetriesLeft")
+43 SET OUT(6)="scWIstatus"_"`"_$$GET1^DIQ(2006.941,WIIEN,3)
+44 SET OUT(7)="ItemCount"_"`"_OUTB("ItemCount")
+45 ;
+46 ;--- Rebuild Item##### tags from WP field data.
+47 NEW LN
SET LN=7
+48 NEW LNWP
SET LNWP=0
+49 FOR
SET LNWP=$ORDER(^MAGV(2006.941,WIIEN,2,LNWP))
if LNWP=""
QUIT
Begin DoDot:1
+50 SET LN=LN+1
+51 SET OUT(LN)="Item"_$EXTRACT((100000+LNWP),2,6)_"`"_$GET(^MAGV(2006.941,WIIEN,2,LNWP,0))
+52 QUIT
End DoDot:1
+53 MERGE RETURN=OUT
+54 SET RETURN(0)=0_"`"_WIIEN
+55 QUIT
+56 ;##### List Storage Commit Work Item(s)
+57 ; RPC: MAGVC WI LIST
+58 ;
+59 ; Input
+60 ; =====
+61 ; RETURN target output array
+62 ; [HOSTNAME] value of input tag "HostName" on which to filter.
+63 ; (if omitted, returns all HostNames)
+64 ;
+65 ; [WILIMIT] maxium number of work items to return in one RPC call
+66 ; [LASTIEN] the last work item IEN returned in the previous RPC call
+67 ;
+68 ; Output
+69 ; ======
+70 ; Error: (0) <0`errmsg
+71 ; Success: (0) 0`n lines returned
+72 ; (1..n) |-1 IEN of WorkItem
+73 ; -2 Status
+74 ; -3 ResponseDateTime (in "millis"econds)
+75 ; -4 Retries Left
+76 ; -5 HostName
+77 ;
ACTLIST(RETURN,HOSTNAME,WILIMIT,LASTIEN) ; P162 DAC - Modified to support additional parameters and return smaller lists
+1 ;
+2 SET HOSTNAME=$GET(HOSTNAME)
SET WILIMIT=$GET(WILIMIT)
SET LASTIEN=$GET(LASTIEN)
+3 ;
+4 ;--- Get IEN of "StorageCommit" entry in WORKLIST file (#2006.9412).
+5 NEW SCIEN
SET SCIEN=$$FIND1^DIC(2006.9412,,,"StorageCommit")
+6 ;
+7 ;--- Traverse IEN's "T" cross-reference for member Work Items.
+8 NEW OUT
KILL OUT
+9 NEW FILE
SET FILE=2006.941
+10 NEW WIIEN
SET WIIEN=""
+11 NEW COUNTER
SET COUNTER=0
+12 IF LASTIEN'=""
SET WIIEN=LASTIEN
+13 ; P162 DAC - Added work Item Limit check
FOR
SET WIIEN=$ORDER(^MAGV(FILE,"T",SCIEN,WIIEN))
if WIIEN=""
QUIT
if COUNTER=WILIMIT
QUIT
Begin DoDot:1
+14 ;
+15 NEW WISTATUS
SET WISTATUS=$$GET1^DIQ(FILE,WIIEN,3)
+16 ;--- Recover tag-embedded data.
+17 NEW HOST
SET HOST=""
+18 NEW RESPDTTM,RETRY2GO
SET (RESPDTTM,RETRY2GO)=""
+19 NEW TGIEN
SET TGIEN=0
+20 FOR
SET TGIEN=$ORDER(^MAGV(FILE,WIIEN,4,TGIEN))
if TGIEN=""
QUIT
Begin DoDot:2
+21 ;
+22 NEW TAG
SET TAG=$PIECE($GET(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)
+23 NEW VAL
SET VAL=$PIECE($GET(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)
+24 if TAG="ResponseDateTime"
SET RESPDTTM=VAL
+25 if TAG="RetriesLeft"
SET RETRY2GO=VAL
+26 if TAG="HostName"
SET HOST=VAL
+27 QUIT
End DoDot:2
+28 if (RESPDTTM="")
QUIT
+29 ;
+30 ;--- Optional filter by HOSTNAME.
+31 IF HOSTNAME=""
Begin DoDot:2
+32 SET OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST
+33 ; P162 DAC - Increment record returned counter
SET COUNTER=COUNTER+1
+34 QUIT
End DoDot:2
+35 IF '$TEST
Begin DoDot:2
+36 if HOSTNAME=HOST
SET OUT(RESPDTTM)=WIIEN_"|"_WISTATUS_"|"_RESPDTTM_"|"_RETRY2GO_"|"_HOST
+37 ; P162 DAC - Increment record returned counter
SET COUNTER=COUNTER+1
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ;--- Re-index array & return.
+41 NEW CT,NOD
SET (CT,NOD)=0
+42 FOR
SET NOD=$ORDER(OUT(NOD))
if NOD=""
QUIT
SET CT=CT+1
SET RETURN(CT)=OUT(NOD)
+43 ; P162 DAC - Return record count
SET RETURN(0)=0_"`"_CT
+44 QUIT
+45 ;##### Update Storage Commit Work Item Status
+46 ; RPC: MAGVC WI UPDATE STATUS
+47 ;
ACTUPD8(RETURN,WIIEN,NEWSTAT) ;
+1 ;
+2 ;--- Get Current Status
+3 NEW NOWSTAT
SET NOWSTAT=$$GET1^DIQ(2006.941,WIIEN,3)
+4 ;
+5 ;--- Quit (-2) if status is IN PROGRESS.
+6 IF NOWSTAT="IN PROGRESS"
Begin DoDot:1
+7 SET RETURN(0)=-2_"`"_"WI is "_NOWSTAT_"."
End DoDot:1
QUIT
+8 ;
+9 ;--- Handle subsequent "SENDING RESPONSE FAILED" set requests.
+10 IF (NEWSTAT="SENDING RESPONSE FAILED")&(NOWSTAT=NEWSTAT)
Begin DoDot:1
+11 ;
+12 ;--- Decrement RetriesLeft tag.
+13 DO ZUPD8FLG(.OUT,.WIIEN,"RetriesLeft")
+14 IF +OUT<0
SET RETURN(0)=OUT
QUIT
+15 NEW RETRY2GO
SET RETRY2GO=$PIECE(OUT,"`",2)
+16 ;
+17 ;--- Return.
+18 DO ACTGET(.RETURN,.WIIEN)
+19 SET RETURN(0)=0_"`"_WIIEN_"`"_"Decremented RetriesLeft to "_RETRY2GO_"."
+20 QUIT
End DoDot:1
QUIT
+21 ;--- Otherwise quit (-4) if status is already at the requested status.
+22 IF NOWSTAT=NEWSTAT
Begin DoDot:1
+23 SET RETURN(0)=-4_"`"_"WI Status is already "_NEWSTAT_"."
+24 QUIT
End DoDot:1
QUIT
+25 ;--- Update the item's STATUS.
+26 NEW FDA
SET FDA(2006.941,WIIEN_",",3)=NEWSTAT
+27 NEW MAGERR
+28 DO FILE^DIE("E","FDA","MAGERR")
+29 ;--- Quit on trapped UPDATER Error
+30 IF $DATA(MAGERR)
Begin DoDot:1
+31 SET RETURN(0)=-6_"`"_MAGERR("DIERR",1,"TEXT",1)
+32 QUIT
End DoDot:1
QUIT
+33 ;--- Return.
+34 DO ACTGET(.RETURN,.WIIEN)
+35 SET RETURN(0)=0_"`"_WIIEN_"`"_"Updated to "_NEWSTAT_"."
+36 QUIT
+37 ;--- Decrement RetriesLeft Tag if >1 "Sending Response Failed" set attempt.
+38 ;
ZUPD8FLG(OUT,WIIEN,TAGIN) ;
+1 ;
+2 KILL OUT
SET OUT="0`"
+3 ;
+4 ;--- Recover tag-embedded data.
+5 NEW FILE
SET FILE=2006.941
+6 NEW TGIEN
SET TGIEN=0
+7 FOR
SET TGIEN=$ORDER(^MAGV(FILE,WIIEN,4,TGIEN))
if TGIEN=""
QUIT
Begin DoDot:1
+8 ;
+9 NEW TAG
SET TAG=$PIECE($GET(^MAGV(FILE,WIIEN,4,TGIEN,0)),U)
+10 if (TAG=TAGIN)
Begin DoDot:2
+11 NEW RETRIES,RETRY2GO
SET (RETRIES,RETRY2GO)=""
+12 SET RETRIES=$PIECE($GET(^MAGV(FILE,WIIEN,4,TGIEN,0)),U,2)
+13 SET RETRY2GO=RETRIES-1
+14 IF RETRY2GO<0
SET OUT=-1_"`RetriesLeft is already "_0_"."
QUIT
+15 SET $PIECE(^MAGV(FILE,WIIEN,4,TGIEN,0),U,2)=RETRY2GO
+16 SET $PIECE(OUT,"`",2)=RETRY2GO
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;