PRCHJTA ;OI&T/DDA - MANAGES DATA FROM MESSAGING EVENTS INTO 414.06 ;5/25/12 8:53am
;;5.1;IFCAP;**167,174**;Oct 20,2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
;
Q
;FOR ENTRY POINT "LOG":
;API CALLED AS: LOG^PRCHJTA(var1,var2,var3,.array,.return)
; Globals are locked within the API
;INPUT
; var1 PRCHJID - FREE TEXT - EXTERNAL OF '410;.01' AS SHARED WITH ECMS (required for all)
; var2 ECMSID - FREE TEXT - AS SENT FROM ECMS [ActionID] (for inbound types if available)
; var3 TYPE - FREE TEXT or CODE of MESSAGE TYPE as defined in 'EVENT TYPE' '414.06;10;.02' (required for all)
; array EVENT - ARRAY THAT HOLDS THE EVENT SPECIFIC DATA TO BE STORED IN THE FILE (required, elements vary)
; EVENT("MSGID")= FREE TEXT STRING OF HLO MESSAGE ID (if available)
; EVENT("IEN410")= FM INTERNAL OF THE 410 RECORD (required for outbound, non-acknowledgement, types only)
; EVENT("IFCAPU")= FM INTERNAL/DUZ OF IFCAP USER(required for outbound, non-acknowledgement, types only)
; EVENT("STN")= FREE TEXT STRING OF THE STATION AS PASSED FROM ECMS (always store if available)
; EVENT("SUBSTN")= FREE TEXT STRING OF THE SUB-STATION AS PASSED FROM ECMS (always store if available)
; EVENT("ECMSU")= FREE TEXT OF ECMS USER AS PASSED FROM ECMS (always store if available)
; EVENT("ECMSPH")= FREE TEXT OF THE ECMS CONTACT PHONE (always store if available)
; EVENT("ECMSEM")= FREE TEXT OF THE ECMS CONTACT EMAIL (always store if available)
; EVENT("ECMSDT")= DATE OF THE USER ACTION, RETURN/CANCEL, ON ECMS (always store if available)
; EVENT("ECMSRN")= FREE TEXT OF THE RETURN/CANCEL REASON FROM ECMS (always store if available)
; EVENT("ECMSCM")= FREE TEXT OF COMMENTS FROM ECMS (always store if available)
; EVENT("ERROR",n)= FREE TEXT, INDIVIDUAL ERROR LINE TO BE STORED. n= non-zero, non-repeating integer
;OUTPUT
; .return ERR - 1^"error text"= ERROR STORING DATA, 0= NO ERROR
;
LOG(PRCHJID,ECMSID,TYPE,EVENT,ERR) ; params defined above
N LINE,PRCERR,PRCIEN,PRCTIEN,PRCVIEN,PRCVSTN,PRCVSUB,TYPETXT
S ERR=0
D TYPE
S:(+TYPE<1)!(+TYPE>11)!(+TYPE=5) ERR="1^Unknown TYPE "_TYPE
I +$G(PRCHJID)=0 S ERR="2^Missing Transaction Number" Q
I '((TYPE=1)!(TYPE=4)) G OTHER
; TYPE 1 or TYPE 4 CREATE A NEW ENTRY IN 414.06 unless a record already exists for this Transaction ID
S PRCTIEN=0
S PRCTIEN=$O(^PRCV(414.06,"B",PRCHJID,PRCTIEN))
G:+PRCTIEN>0 OTHER
;lock the file to get IEN for new TRANSACTION record
S PRCVIEN=0
L +^PRCV(414.06,PRCVIEN):$S($G(DILOCKTM)>60:DILOCKTM,1:60) E S ERR="3^Unable to lock record" K PRCVIEN Q
; Create parent record
I +$G(EVENT("IEN410"))=0 S ERR="4^Missing CONTROL POINT ACTIVITY, IEN" S PRCTIEN=0 G XLOG
S PRC41406(414.06,"+1,",.01)=PRCHJID
S PRC41406(414.06,"+1,",.03)=TYPETXT
S PRC41406(414.06,"+1,",1)=EVENT("IEN410")
S PRCIEN=""
D UPDATE^DIE("","PRC41406","PRCIEN","PRCERR")
L -^PRCV(414.06,PRCVIEN)
I $D(PRCERR) D
.S ERR="5^Error creating TRANSACTION record: "_$G(PRCERR("DIERR","1","TEXT",1))
G:+ERR XLOG
S PRCTIEN=PRCIEN(1)
L +^PRCV(414.06,PRCTIEN):$S($G(DILOCKTM)>60:DILOCKTM,1:60) E S ERR="3.1^Unable to lock record" K PRCTIEN Q
K PRC41406,PRCIEN,PRCERR
; Create EVENT sub-record
S PRC41406(414.061,"+2,"_PRCTIEN_",",.01)=$$NOW^XLFDT
S PRC41406(414.061,"+2,"_PRCTIEN_",",.02)=TYPE
S:$G(EVENT("MSGID"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",.03)=EVENT("MSGID")
S PRC41406(414.061,"+2,"_PRCTIEN_",",3)=EVENT("IFCAPU")
; STORE STN AND SUBSTN FOR OUTBOUND EVENTS
I (TYPE=1)!(TYPE=4) D GETSTN(EVENT("IEN410")) D
. S:PRCVSTN'="" PRC41406(414.061,"+2,"_PRCTIEN_",",1)=PRCVSTN
. S:PRCVSUB'="" PRC41406(414.061,"+2,"_PRCTIEN_",",2)=PRCVSUB
.Q
D UPDATE^DIE("","PRC41406","PRCIEN","PRCERR")
I $D(PRCERR) D
.S ERR="6^Error creating TRANSACTION record: "_$G(PRCERR("DIERR","1","TEXT",1))
; Store Transaction ERROR text if any
K PRCERR,PRC41406
S PRCIEN(1)=PRCTIEN
S PRCVIEN=""
S LINE=0
I $D(EVENT("ERROR")) F S LINE=$O(EVENT("ERROR",LINE)) Q:LINE="" D Q:+ERR
.K PRC41406
.S PRCVIEN(3)=LINE
.S:$G(EVENT("ERROR",LINE))'="" PRC41406(414.0613,"+3,"_PRCIEN(2)_","_PRCIEN(1)_",",.01)=EVENT("ERROR",LINE)
.D UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
.I $D(PRCERR) D
..S ERR="10.1^Error updating TRANSACTION word-processing field ERROR: "_$G(PRCERR("DIERR","1","TEXT",1))
..Q
.K PRC41406
.Q
G XLOG
OTHER ; LOG ALL OTHER TYPES
; Find the TRANSACTION record
S PRCTIEN=0
S PRCTIEN=$O(^PRCV(414.06,"B",PRCHJID,PRCTIEN))
I PRCTIEN="" S ERR="7^"_PRCHJID_" does not exist in the Transaction file." K PRCTIEN Q
L +^PRCV(414.06,PRCTIEN):$S($G(DILOCKTM)>60:DILOCKTM,1:60) E S ERR="8^Unable to lock record" K PRCTIEN Q
; Store header data
S:$G(ECMSID)'="" PRC41406(414.06,PRCTIEN_",",.02)=ECMSID
S PRC41406(414.06,PRCTIEN_",",.03)=TYPETXT
S:+$G(EVENT("IEN410")) PRC41406(414.06,PRCTIEN_",",1)=EVENT("IEN410")
D FILE^DIE("","PRC41406","PRCERR")
; Store Transaction data
K PRC41406
S PRC41406(414.061,"+2,"_PRCTIEN_",",.01)=$$NOW^XLFDT
S PRC41406(414.061,"+2,"_PRCTIEN_",",.02)=TYPE
S:$G(EVENT("MSGID"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",.03)=EVENT("MSGID")
S:$G(EVENT("STN"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",1)=EVENT("STN")
S:$G(EVENT("SUBSTN"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",2)=EVENT("SUBSTN")
; CHECK IF OUTBOUND EVENTS THEN SET STN AND SUBSTN FOR STORAGE
I (TYPE=1)!(TYPE=4) D GETSTN(EVENT("IEN410")) D
. S:PRCVSTN'="" PRC41406(414.061,"+2,"_PRCTIEN_",",1)=PRCVSTN
. S:PRCVSUB'="" PRC41406(414.061,"+2,"_PRCTIEN_",",2)=PRCVSUB
.Q
S:$G(EVENT("IFCAPU"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",3)=EVENT("IFCAPU")
S:$G(EVENT("ECMSPH"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",5)=EVENT("ECMSPH")
S:$G(EVENT("ECMSEM"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",6)=EVENT("ECMSEM")
S:$G(EVENT("ECMSDT"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",7)=EVENT("ECMSDT")
S:$G(EVENT("ECMSRN"))'="" PRC41406(414.061,"+2,"_PRCTIEN_",",10)=EVENT("ECMSRN")
S PRC41406(414.061,"+2,"_PRCTIEN_",",11)=$S($G(EVENT("ECMSCM"))'="":EVENT("ECMSCM")_" ",1:"")_$S($G(EVENT("ECMSU"))'="":"{"_EVENT("ECMSU")_"}",1:"")
S PRC41406(414.061,"+2,"_PRCTIEN_",",11)=$E(PRC41406(414.061,"+2,"_PRCTIEN_",",11),1,100)
D UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
I $D(PRCERR) D
.S ERR="9^Error updating TRANSACTION record: "_$G(PRCERR("DIERR","1","TEXT",1))
K PRC41406
G:+ERR XLOG
; Store Transaction ERROR text if any
K PRCERR
S PRCVIEN(1)=PRCTIEN
S PRCVIEN=""
S LINE=0
I $D(EVENT("ERROR")) F S LINE=$O(EVENT("ERROR",LINE)) Q:LINE="" D Q:+ERR
.K PRC41406
.S PRCVIEN(3)=LINE
.S:$G(EVENT("ERROR",LINE))'="" PRC41406(414.0613,"+3,"_PRCVIEN(2)_","_PRCVIEN(1)_",",.01)=EVENT("ERROR",LINE)
.D UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
.I $D(PRCERR) D
..S ERR="10^Error updating TRANSACTION word-processing field ERROR: "_$G(PRCERR("DIERR","1","TEXT",1))
..Q
.K PRC41406
.Q
XLOG ;EXIT
L -^PRCV(414.06,PRCTIEN)
; A Hang command is needed because multiple calls to this API in succession may lead to an attempt to overwrite.
H 1
; No kills needed, variables were Newed.
Q
GETSTN(IEN) ;API TO GRAB STATION AND SUBSTATION DATA OUT OF 410 FOR STORAGE IN 414.06 OUTBOUND EVENTS.
; Passes in IEN of 410
; Output is PRCVSTN and PRCVSUB
S PRCVSTN=$P($G(^PRCS(410,IEN,0)),"^",5)
S PRCVSUB=$P($G(^PRCS(410,IEN,0)),"^",10)
I PRCVSUB'="" S PRCVSUB=$P(^PRC(411,PRCVSUB,0),"^")
Q
TYPE ; set TYPE and TYPETXT
I $G(TYPE)'="" D
. S:(TYPE="2237 SENT")!(TYPE=1) TYPE=1,TYPETXT="2237 SENT"
. S:(TYPE="2237 ACKNOWLEDGED")!(TYPE=2) TYPE=2,TYPETXT="2237 ACKNOWLEDGED"
. S:(TYPE="2237 APPLICATION ERROR")!(TYPE=3) TYPE=3,TYPETXT="2237 APPLICATION ERROR"
. S:(TYPE="2237 RESENT")!(TYPE=4) TYPE=4,TYPETXT="2237 RESENT"
. S:(TYPE="RETURN TO ACCOUNTABLE OFFICER")!(TYPE=6) TYPE=6,TYPETXT="RETURN TO ACCOUNTABLE OFFICER"
. S:(TYPE="RETURN TO AO ACK")!(TYPE=7) TYPE=7,TYPETXT="RETURN TO AO ACK"
. S:(TYPE="RETURN TO CONTROL POINT")!(TYPE=8) TYPE=8,TYPETXT="RETURN TO CONTROL POINT"
. S:(TYPE="RETURN TO CP ACK")!(TYPE=9) TYPE=9,TYPETXT="RETURN TO CP ACK"
. S:(TYPE="2237 CANCELED")!(TYPE=10) TYPE=10,TYPETXT="2237 CANCELED"
. S:(TYPE="2237 CANCEL ACK")!(TYPE=11) TYPE=11,TYPETXT="2237 CANCEL ACK"
. Q
Q
CONTACT(NAME) ; Call to transform the data for use within the "ACONTACT" and "AUNQEC" xrefs for 414.06;10;6 ECMS EMAIL field
N PRCC,PRCL,PRCF,PRCR,PRCN
S PRCC=$P(NAME,"@",1),PRCL=$L(PRCC,".")
S PRCF=$P(PRCC,".",PRCL)
S PRCR=""
F PRCN=1:1:(PRCL-1) S PRCR=PRCR_" "_$P(PRCC,".",PRCN)
S PRCC=PRCF_PRCR
S PRCC=$$UP^XLFSTR(PRCC)
Q PRCC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJTA 8717 printed Sep 23, 2025@19:44:25 Page 2
PRCHJTA ;OI&T/DDA - MANAGES DATA FROM MESSAGING EVENTS INTO 414.06 ;5/25/12 8:53am
+1 ;;5.1;IFCAP;**167,174**;Oct 20,2000;Build 23
+2 ;Per VHA Directive 2004-38, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;FOR ENTRY POINT "LOG":
+6 ;API CALLED AS: LOG^PRCHJTA(var1,var2,var3,.array,.return)
+7 ; Globals are locked within the API
+8 ;INPUT
+9 ; var1 PRCHJID - FREE TEXT - EXTERNAL OF '410;.01' AS SHARED WITH ECMS (required for all)
+10 ; var2 ECMSID - FREE TEXT - AS SENT FROM ECMS [ActionID] (for inbound types if available)
+11 ; var3 TYPE - FREE TEXT or CODE of MESSAGE TYPE as defined in 'EVENT TYPE' '414.06;10;.02' (required for all)
+12 ; array EVENT - ARRAY THAT HOLDS THE EVENT SPECIFIC DATA TO BE STORED IN THE FILE (required, elements vary)
+13 ; EVENT("MSGID")= FREE TEXT STRING OF HLO MESSAGE ID (if available)
+14 ; EVENT("IEN410")= FM INTERNAL OF THE 410 RECORD (required for outbound, non-acknowledgement, types only)
+15 ; EVENT("IFCAPU")= FM INTERNAL/DUZ OF IFCAP USER(required for outbound, non-acknowledgement, types only)
+16 ; EVENT("STN")= FREE TEXT STRING OF THE STATION AS PASSED FROM ECMS (always store if available)
+17 ; EVENT("SUBSTN")= FREE TEXT STRING OF THE SUB-STATION AS PASSED FROM ECMS (always store if available)
+18 ; EVENT("ECMSU")= FREE TEXT OF ECMS USER AS PASSED FROM ECMS (always store if available)
+19 ; EVENT("ECMSPH")= FREE TEXT OF THE ECMS CONTACT PHONE (always store if available)
+20 ; EVENT("ECMSEM")= FREE TEXT OF THE ECMS CONTACT EMAIL (always store if available)
+21 ; EVENT("ECMSDT")= DATE OF THE USER ACTION, RETURN/CANCEL, ON ECMS (always store if available)
+22 ; EVENT("ECMSRN")= FREE TEXT OF THE RETURN/CANCEL REASON FROM ECMS (always store if available)
+23 ; EVENT("ECMSCM")= FREE TEXT OF COMMENTS FROM ECMS (always store if available)
+24 ; EVENT("ERROR",n)= FREE TEXT, INDIVIDUAL ERROR LINE TO BE STORED. n= non-zero, non-repeating integer
+25 ;OUTPUT
+26 ; .return ERR - 1^"error text"= ERROR STORING DATA, 0= NO ERROR
+27 ;
LOG(PRCHJID,ECMSID,TYPE,EVENT,ERR) ; params defined above
+1 NEW LINE,PRCERR,PRCIEN,PRCTIEN,PRCVIEN,PRCVSTN,PRCVSUB,TYPETXT
+2 SET ERR=0
+3 DO TYPE
+4 if (+TYPE<1)!(+TYPE>11)!(+TYPE=5)
SET ERR="1^Unknown TYPE "_TYPE
+5 IF +$GET(PRCHJID)=0
SET ERR="2^Missing Transaction Number"
QUIT
+6 IF '((TYPE=1)!(TYPE=4))
GOTO OTHER
+7 ; TYPE 1 or TYPE 4 CREATE A NEW ENTRY IN 414.06 unless a record already exists for this Transaction ID
+8 SET PRCTIEN=0
+9 SET PRCTIEN=$ORDER(^PRCV(414.06,"B",PRCHJID,PRCTIEN))
+10 if +PRCTIEN>0
GOTO OTHER
+11 ;lock the file to get IEN for new TRANSACTION record
+12 SET PRCVIEN=0
+13 LOCK +^PRCV(414.06,PRCVIEN):$SELECT($GET(DILOCKTM)>60:DILOCKTM,1:60)
IF '$TEST
SET ERR="3^Unable to lock record"
KILL PRCVIEN
QUIT
+14 ; Create parent record
+15 IF +$GET(EVENT("IEN410"))=0
SET ERR="4^Missing CONTROL POINT ACTIVITY, IEN"
SET PRCTIEN=0
GOTO XLOG
+16 SET PRC41406(414.06,"+1,",.01)=PRCHJID
+17 SET PRC41406(414.06,"+1,",.03)=TYPETXT
+18 SET PRC41406(414.06,"+1,",1)=EVENT("IEN410")
+19 SET PRCIEN=""
+20 DO UPDATE^DIE("","PRC41406","PRCIEN","PRCERR")
+21 LOCK -^PRCV(414.06,PRCVIEN)
+22 IF $DATA(PRCERR)
Begin DoDot:1
+23 SET ERR="5^Error creating TRANSACTION record: "_$GET(PRCERR("DIERR","1","TEXT",1))
End DoDot:1
+24 if +ERR
GOTO XLOG
+25 SET PRCTIEN=PRCIEN(1)
+26 LOCK +^PRCV(414.06,PRCTIEN):$SELECT($GET(DILOCKTM)>60:DILOCKTM,1:60)
IF '$TEST
SET ERR="3.1^Unable to lock record"
KILL PRCTIEN
QUIT
+27 KILL PRC41406,PRCIEN,PRCERR
+28 ; Create EVENT sub-record
+29 SET PRC41406(414.061,"+2,"_PRCTIEN_",",.01)=$$NOW^XLFDT
+30 SET PRC41406(414.061,"+2,"_PRCTIEN_",",.02)=TYPE
+31 if $GET(EVENT("MSGID"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",.03)=EVENT("MSGID")
+32 SET PRC41406(414.061,"+2,"_PRCTIEN_",",3)=EVENT("IFCAPU")
+33 ; STORE STN AND SUBSTN FOR OUTBOUND EVENTS
+34 IF (TYPE=1)!(TYPE=4)
DO GETSTN(EVENT("IEN410"))
Begin DoDot:1
+35 if PRCVSTN'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",1)=PRCVSTN
+36 if PRCVSUB'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",2)=PRCVSUB
+37 QUIT
End DoDot:1
+38 DO UPDATE^DIE("","PRC41406","PRCIEN","PRCERR")
+39 IF $DATA(PRCERR)
Begin DoDot:1
+40 SET ERR="6^Error creating TRANSACTION record: "_$GET(PRCERR("DIERR","1","TEXT",1))
End DoDot:1
+41 ; Store Transaction ERROR text if any
+42 KILL PRCERR,PRC41406
+43 SET PRCIEN(1)=PRCTIEN
+44 SET PRCVIEN=""
+45 SET LINE=0
+46 IF $DATA(EVENT("ERROR"))
FOR
SET LINE=$ORDER(EVENT("ERROR",LINE))
if LINE=""
QUIT
Begin DoDot:1
+47 KILL PRC41406
+48 SET PRCVIEN(3)=LINE
+49 if $GET(EVENT("ERROR",LINE))'=""
SET PRC41406(414.0613,"+3,"_PRCIEN(2)_","_PRCIEN(1)_",",.01)=EVENT("ERROR",LINE)
+50 DO UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
+51 IF $DATA(PRCERR)
Begin DoDot:2
+52 SET ERR="10.1^Error updating TRANSACTION word-processing field ERROR: "_$GET(PRCERR("DIERR","1","TEXT",1))
+53 QUIT
End DoDot:2
+54 KILL PRC41406
+55 QUIT
End DoDot:1
if +ERR
QUIT
+56 GOTO XLOG
OTHER ; LOG ALL OTHER TYPES
+1 ; Find the TRANSACTION record
+2 SET PRCTIEN=0
+3 SET PRCTIEN=$ORDER(^PRCV(414.06,"B",PRCHJID,PRCTIEN))
+4 IF PRCTIEN=""
SET ERR="7^"_PRCHJID_" does not exist in the Transaction file."
KILL PRCTIEN
QUIT
+5 LOCK +^PRCV(414.06,PRCTIEN):$SELECT($GET(DILOCKTM)>60:DILOCKTM,1:60)
IF '$TEST
SET ERR="8^Unable to lock record"
KILL PRCTIEN
QUIT
+6 ; Store header data
+7 if $GET(ECMSID)'=""
SET PRC41406(414.06,PRCTIEN_",",.02)=ECMSID
+8 SET PRC41406(414.06,PRCTIEN_",",.03)=TYPETXT
+9 if +$GET(EVENT("IEN410"))
SET PRC41406(414.06,PRCTIEN_",",1)=EVENT("IEN410")
+10 DO FILE^DIE("","PRC41406","PRCERR")
+11 ; Store Transaction data
+12 KILL PRC41406
+13 SET PRC41406(414.061,"+2,"_PRCTIEN_",",.01)=$$NOW^XLFDT
+14 SET PRC41406(414.061,"+2,"_PRCTIEN_",",.02)=TYPE
+15 if $GET(EVENT("MSGID"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",.03)=EVENT("MSGID")
+16 if $GET(EVENT("STN"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",1)=EVENT("STN")
+17 if $GET(EVENT("SUBSTN"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",2)=EVENT("SUBSTN")
+18 ; CHECK IF OUTBOUND EVENTS THEN SET STN AND SUBSTN FOR STORAGE
+19 IF (TYPE=1)!(TYPE=4)
DO GETSTN(EVENT("IEN410"))
Begin DoDot:1
+20 if PRCVSTN'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",1)=PRCVSTN
+21 if PRCVSUB'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",2)=PRCVSUB
+22 QUIT
End DoDot:1
+23 if $GET(EVENT("IFCAPU"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",3)=EVENT("IFCAPU")
+24 if $GET(EVENT("ECMSPH"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",5)=EVENT("ECMSPH")
+25 if $GET(EVENT("ECMSEM"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",6)=EVENT("ECMSEM")
+26 if $GET(EVENT("ECMSDT"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",7)=EVENT("ECMSDT")
+27 if $GET(EVENT("ECMSRN"))'=""
SET PRC41406(414.061,"+2,"_PRCTIEN_",",10)=EVENT("ECMSRN")
+28 SET PRC41406(414.061,"+2,"_PRCTIEN_",",11)=$SELECT($GET(EVENT("ECMSCM"))'="":EVENT("ECMSCM")_" ",1:"")_$SELECT($GET(EVENT("ECMSU"))'="":"{"_EVENT("ECMSU")_"}",1:"")
+29 SET PRC41406(414.061,"+2,"_PRCTIEN_",",11)=$EXTRACT(PRC41406(414.061,"+2,"_PRCTIEN_",",11),1,100)
+30 DO UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
+31 IF $DATA(PRCERR)
Begin DoDot:1
+32 SET ERR="9^Error updating TRANSACTION record: "_$GET(PRCERR("DIERR","1","TEXT",1))
End DoDot:1
+33 KILL PRC41406
+34 if +ERR
GOTO XLOG
+35 ; Store Transaction ERROR text if any
+36 KILL PRCERR
+37 SET PRCVIEN(1)=PRCTIEN
+38 SET PRCVIEN=""
+39 SET LINE=0
+40 IF $DATA(EVENT("ERROR"))
FOR
SET LINE=$ORDER(EVENT("ERROR",LINE))
if LINE=""
QUIT
Begin DoDot:1
+41 KILL PRC41406
+42 SET PRCVIEN(3)=LINE
+43 if $GET(EVENT("ERROR",LINE))'=""
SET PRC41406(414.0613,"+3,"_PRCVIEN(2)_","_PRCVIEN(1)_",",.01)=EVENT("ERROR",LINE)
+44 DO UPDATE^DIE("","PRC41406","PRCVIEN","PRCERR")
+45 IF $DATA(PRCERR)
Begin DoDot:2
+46 SET ERR="10^Error updating TRANSACTION word-processing field ERROR: "_$GET(PRCERR("DIERR","1","TEXT",1))
+47 QUIT
End DoDot:2
+48 KILL PRC41406
+49 QUIT
End DoDot:1
if +ERR
QUIT
XLOG ;EXIT
+1 LOCK -^PRCV(414.06,PRCTIEN)
+2 ; A Hang command is needed because multiple calls to this API in succession may lead to an attempt to overwrite.
+3 HANG 1
+4 ; No kills needed, variables were Newed.
+5 QUIT
GETSTN(IEN) ;API TO GRAB STATION AND SUBSTATION DATA OUT OF 410 FOR STORAGE IN 414.06 OUTBOUND EVENTS.
+1 ; Passes in IEN of 410
+2 ; Output is PRCVSTN and PRCVSUB
+3 SET PRCVSTN=$PIECE($GET(^PRCS(410,IEN,0)),"^",5)
+4 SET PRCVSUB=$PIECE($GET(^PRCS(410,IEN,0)),"^",10)
+5 IF PRCVSUB'=""
SET PRCVSUB=$PIECE(^PRC(411,PRCVSUB,0),"^")
+6 QUIT
TYPE ; set TYPE and TYPETXT
+1 IF $GET(TYPE)'=""
Begin DoDot:1
+2 if (TYPE="2237 SENT")!(TYPE=1)
SET TYPE=1
SET TYPETXT="2237 SENT"
+3 if (TYPE="2237 ACKNOWLEDGED")!(TYPE=2)
SET TYPE=2
SET TYPETXT="2237 ACKNOWLEDGED"
+4 if (TYPE="2237 APPLICATION ERROR")!(TYPE=3)
SET TYPE=3
SET TYPETXT="2237 APPLICATION ERROR"
+5 if (TYPE="2237 RESENT")!(TYPE=4)
SET TYPE=4
SET TYPETXT="2237 RESENT"
+6 if (TYPE="RETURN TO ACCOUNTABLE OFFICER")!(TYPE=6)
SET TYPE=6
SET TYPETXT="RETURN TO ACCOUNTABLE OFFICER"
+7 if (TYPE="RETURN TO AO ACK")!(TYPE=7)
SET TYPE=7
SET TYPETXT="RETURN TO AO ACK"
+8 if (TYPE="RETURN TO CONTROL POINT")!(TYPE=8)
SET TYPE=8
SET TYPETXT="RETURN TO CONTROL POINT"
+9 if (TYPE="RETURN TO CP ACK")!(TYPE=9)
SET TYPE=9
SET TYPETXT="RETURN TO CP ACK"
+10 if (TYPE="2237 CANCELED")!(TYPE=10)
SET TYPE=10
SET TYPETXT="2237 CANCELED"
+11 if (TYPE="2237 CANCEL ACK")!(TYPE=11)
SET TYPE=11
SET TYPETXT="2237 CANCEL ACK"
+12 QUIT
End DoDot:1
+13 QUIT
CONTACT(NAME) ; Call to transform the data for use within the "ACONTACT" and "AUNQEC" xrefs for 414.06;10;6 ECMS EMAIL field
+1 NEW PRCC,PRCL,PRCF,PRCR,PRCN
+2 SET PRCC=$PIECE(NAME,"@",1)
SET PRCL=$LENGTH(PRCC,".")
+3 SET PRCF=$PIECE(PRCC,".",PRCL)
+4 SET PRCR=""
+5 FOR PRCN=1:1:(PRCL-1)
SET PRCR=PRCR_" "_$PIECE(PRCC,".",PRCN)
+6 SET PRCC=PRCF_PRCR
+7 SET PRCC=$$UP^XLFSTR(PRCC)
+8 QUIT PRCC
