PRCVEE5 ;WOIFO/VAC - Routine to handle Error Messages sent from DynaMed ; 5/16/05 4:34pm
;;5.1;IFCAP;**81**;Oct 20, 2000
;PER VHA Directive 10-93-142, this routine should not be modified
;
;This routine reads an ACK from DynaMed in answer to a message sent
;regarding an Edit/Cancel/Approval to a RIL/2237.
;ERRTXT - Text of the error message severity
;MSGDAT -A single field that holds an error segment
;MSGDAT2 - MSGDAT without the segment identifier
;MSGDAT3 - Message type/Event type
;MSGTYP - Indicates if there are errors in the message
;PRCCNT - Record counter -indicates the message line number
;PRCERCD - Error code returned
;PRCERTX - Error text returned with error code
;PRCFLD - Field where error occurred
;PRCSEG - Segment where error has occurred
;PRCSEQ - Sequence number where error occurred
;PRCTYP - Type of form RIL or 2237
;PRCVACK - Acknowledgement type AA, AE, AR, etc
;PRCVAEC - Application error code string returned in message - ERR-5
;PRCVDT - Second node level of ^XTMP
;PRCVEC - Error component - ERR-3
;PRCVERR - Array of email message
;PRCVID - RIL/2237 ID - ERR-6
;PRCVLOC - Error Location component - ERR-2
;PRCMID - Message ID of original message
;PRCVMID2 - Cross reference into ^XTMP
;PRCVPTR - First node level of ^XTMP
;PRCVSEV - Severity Component ERR-4
;PRCVTYP - Original Form Type - RIL or 2237
;SSTOP - Stop flag
;PRCFS - Field separator
;PRCCS - Component separator
;PRCRS - Repetition separator
;PRCSC - Sub-component separator
;PRCDET - Array of field names inside of HL7 segments
;PRCFCP - Fund Control Point for message
;PRCSITE and PRCSITE0 - Receiving facility number
;ERRCNT - a counter
;^TMP - Global to hold error message information
BEGIN N I,J
N PRCFS,PRCCS,PRCDET,ERRCNT,ERRTXT
N MSGDAT,PRCCNT,MSGTYP
N MSGDAT2,MSGDAT3,PRCERCD,PRCERTX,PRCFLD,PRCFCP,PRCSITE,PRCSITE0
N PRCSEG,PRCSEQ,PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR
N PRCVID,PRCVLOC,PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,SSTOP
S PRCFS=HL("FS"),PRCCS=$E(HL("ECH"),1)
K ^TMP($J)
SETUP ;Set up array for HL7 crosswalk
S PRCDET("ORC",1)="Order Control"
S PRCDET("ORC",9)="Date/Time Created"
S PRCDET("ORC",10)="Entered by"
S PRCDET("ORC",21)="Ordering Facility"
S PRCDET("RQD",1)="Line number"
S PRCDET("RQD",2)="DM Document ID"
S PRCDET("RQD",3)="Item number"
S PRCDET("RQD",4)="Packaging Multiple"
S PRCDET("RQD",5)="Quantity"
S PRCDET("RQD",6)="Unit of purchase"
S PRCDET("RQD",9)="Identifier"
S PRCDET("RQD",10)="Date needed"
S PRCDET("RQ1",1)="Unit cost"
S PRCDET("RQ1",2)="Vendor Stock Number"
S PRCDET("RQ1",3)="BOC"
S PRCDET("RQ1",4)="Vendor and/or FMS Vendor"
S PRCDET("RQ1",5)="NIF number"
S MSGTYP="",PRCVTYP=""
F I=1:1 X HLNEXT Q:HLQUIT'>0 D
.S ^TMP($J,I)=HLNODE,J=0
.F S J=$O(HLNODE(J)) Q:'J S ^TMP($J,I,J)=HLNODE(J)
;
S PRCCNT="",SSTOP="GO"
F I=1:1:2 S PRCCNT=$G(^TMP($J,I)) Q:PRCCNT="" Q:SSTOP="STOP" D
.S MSGDAT=$G(^TMP($J,I))
.Q:MSGDAT=""
.S MSGDAT2=$P(MSGDAT,PRCFS,2,21)
.I $E(MSGDAT,1,3)="MSH" D Q
..S MSGDAT3=$P(MSGDAT2,PRCFS,8)
..I MSGDAT3'["ORN"_PRCCS_"O08" D
...S SSTOP="STOP",MSGTYP="NOK"
...S PRCVTYP="ACK",PRCVID=$P(MSGDAT2,PRCFS,9)
...S PRCVERR(1)="IN "_PRCVTYP_" "_PRCVID_" there was a bad message type"
...S PRCVPTR="*"_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)_"- - -076"
.I $E(MSGDAT,1,3)="MSA" D Q
..S PRCVACK=$P(MSGDAT2,PRCFS,1)
..S PRCVMID=$P(MSGDAT2,PRCFS,2)
..S PRCVMID2="PRCVMID*"_PRCVMID
..S PRCVPTR=$P($G(^XTMP(PRCVMID2,1)),U,1)
..S PRCVDT=$P($G(^XTMP(PRCVMID2,1)),U,2)
..I PRCVACK="AA" D Q
...S MSGTYP="OK"
..I (PRCVACK="AE")!(PRCVACK="AR") D Q
...S MSGTYP="NOK"
I $E(MSGTYP,1,2)="OK" D VALID Q
I PRCVTYP="ACK" D NOVALID Q
ERROR ;Now process error messages
;
S ERRCNT=1
S PRCCNT="" F I=3:1 S PRCCNT=$G(^TMP($J,I)) Q:PRCCNT="" D
.S MSGDAT=$G(^TMP($J,I))
.Q:MSGDAT=""
.S MSGDAT2=$P(MSGDAT,PRCFS,2,7)
.S PRCVLOC=$P(MSGDAT2,PRCFS,2)
.S PRCVEC=$P(MSGDAT2,PRCFS,3)
.S PRCVSEV=$P(MSGDAT2,PRCFS,4)
.S PRCVAEC=$P(MSGDAT2,PRCFS,5)
.S PRCVID=$P(MSGDAT2,PRCFS,6)
.S PRCVTYP="RIL"
.I PRCVID?.N1"-".N1"-".N1"-".E1"-".N S PRCVTYP="2237"
.S PRCSEG=$P(PRCVLOC,PRCCS,1)
.S PRCSEQ=$P(PRCVLOC,PRCCS,2)
.S PRCFLD=$P(PRCVLOC,PRCCS,3)
.S PRCERCD=$P(PRCVAEC,PRCCS,1)
.S PRCERTX=$P(PRCVAEC,PRCCS,2)
.S ERRTXT="Error"
.I PRCVSEV="W" S ERRTXT="Warning"
.S PRCVERR(ERRCNT)="In "_PRCVTYP_" "_PRCVID_" the following occurred"
.S ERRCNT=ERRCNT+1
.S PRCVERR(ERRCNT)="For Line item "_PRCSEQ_" the "_PRCDET(PRCSEG,PRCFLD)_" had the following "_ERRTXT_": "
.S ERRCNT=ERRCNT+1
.S PRCVERR(ERRCNT)=PRCERTX
.S ERRCNT=ERRCNT+1
D NOVALID
Q
VALID ;Do NOTHING to notify user that message is ok.
D CLEANUP
Q
NOVALID ;Mailman message
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S XMSUB="IFCAP to DynaMed "_PRCVTYP_" Errors "_PRCVID_" "
S XMDUZ="IFCAP/DynaMed Interface"
S XMTEXT="PRCVERR("
;S XMY("CARR.VICTOR@CSL.FO-WASH.DOMAIN.EXT")=""
S PRCFCP=$P(PRCVPTR,"-",4)
S PRCSITE0=$P(PRCVPTR,"-",1)
S PRCSITE=$P(PRCSITE0,"*",2)
D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
D ^XMD
K XMSUB,XMMG,XMDUZ,XMTEXT,XMY,XMZ
D CLEANUP
Q
;
CLEANUP ; Clean up data
K MSGTYP,MSGDAT,MSGDAT2,MSGDAT3,ERRTXT
K PRCCNT,PRCFS,PRCCS,I,J,SSTOP,PRCFCP,PRCSITE,PRCSITE0
K ^TMP($J),ERRCNT,PRCERCD,PRCERTX,PRCFLD,PRCSEG,PRCSEQ
K PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR,PRCVID,PRCVLOC
K PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,PRCDET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVEE5 5506 printed Sep 02, 2024@19:05:16 Page 2
PRCVEE5 ;WOIFO/VAC - Routine to handle Error Messages sent from DynaMed ; 5/16/05 4:34pm
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;PER VHA Directive 10-93-142, this routine should not be modified
+3 ;
+4 ;This routine reads an ACK from DynaMed in answer to a message sent
+5 ;regarding an Edit/Cancel/Approval to a RIL/2237.
+6 ;ERRTXT - Text of the error message severity
+7 ;MSGDAT -A single field that holds an error segment
+8 ;MSGDAT2 - MSGDAT without the segment identifier
+9 ;MSGDAT3 - Message type/Event type
+10 ;MSGTYP - Indicates if there are errors in the message
+11 ;PRCCNT - Record counter -indicates the message line number
+12 ;PRCERCD - Error code returned
+13 ;PRCERTX - Error text returned with error code
+14 ;PRCFLD - Field where error occurred
+15 ;PRCSEG - Segment where error has occurred
+16 ;PRCSEQ - Sequence number where error occurred
+17 ;PRCTYP - Type of form RIL or 2237
+18 ;PRCVACK - Acknowledgement type AA, AE, AR, etc
+19 ;PRCVAEC - Application error code string returned in message - ERR-5
+20 ;PRCVDT - Second node level of ^XTMP
+21 ;PRCVEC - Error component - ERR-3
+22 ;PRCVERR - Array of email message
+23 ;PRCVID - RIL/2237 ID - ERR-6
+24 ;PRCVLOC - Error Location component - ERR-2
+25 ;PRCMID - Message ID of original message
+26 ;PRCVMID2 - Cross reference into ^XTMP
+27 ;PRCVPTR - First node level of ^XTMP
+28 ;PRCVSEV - Severity Component ERR-4
+29 ;PRCVTYP - Original Form Type - RIL or 2237
+30 ;SSTOP - Stop flag
+31 ;PRCFS - Field separator
+32 ;PRCCS - Component separator
+33 ;PRCRS - Repetition separator
+34 ;PRCSC - Sub-component separator
+35 ;PRCDET - Array of field names inside of HL7 segments
+36 ;PRCFCP - Fund Control Point for message
+37 ;PRCSITE and PRCSITE0 - Receiving facility number
+38 ;ERRCNT - a counter
+39 ;^TMP - Global to hold error message information
BEGIN NEW I,J
+1 NEW PRCFS,PRCCS,PRCDET,ERRCNT,ERRTXT
+2 NEW MSGDAT,PRCCNT,MSGTYP
+3 NEW MSGDAT2,MSGDAT3,PRCERCD,PRCERTX,PRCFLD,PRCFCP,PRCSITE,PRCSITE0
+4 NEW PRCSEG,PRCSEQ,PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR
+5 NEW PRCVID,PRCVLOC,PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,SSTOP
+6 SET PRCFS=HL("FS")
SET PRCCS=$EXTRACT(HL("ECH"),1)
+7 KILL ^TMP($JOB)
SETUP ;Set up array for HL7 crosswalk
+1 SET PRCDET("ORC",1)="Order Control"
+2 SET PRCDET("ORC",9)="Date/Time Created"
+3 SET PRCDET("ORC",10)="Entered by"
+4 SET PRCDET("ORC",21)="Ordering Facility"
+5 SET PRCDET("RQD",1)="Line number"
+6 SET PRCDET("RQD",2)="DM Document ID"
+7 SET PRCDET("RQD",3)="Item number"
+8 SET PRCDET("RQD",4)="Packaging Multiple"
+9 SET PRCDET("RQD",5)="Quantity"
+10 SET PRCDET("RQD",6)="Unit of purchase"
+11 SET PRCDET("RQD",9)="Identifier"
+12 SET PRCDET("RQD",10)="Date needed"
+13 SET PRCDET("RQ1",1)="Unit cost"
+14 SET PRCDET("RQ1",2)="Vendor Stock Number"
+15 SET PRCDET("RQ1",3)="BOC"
+16 SET PRCDET("RQ1",4)="Vendor and/or FMS Vendor"
+17 SET PRCDET("RQ1",5)="NIF number"
+18 SET MSGTYP=""
SET PRCVTYP=""
+19 FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+20 SET ^TMP($JOB,I)=HLNODE
SET J=0
+21 FOR
SET J=$ORDER(HLNODE(J))
if 'J
QUIT
SET ^TMP($JOB,I,J)=HLNODE(J)
End DoDot:1
+22 ;
+23 SET PRCCNT=""
SET SSTOP="GO"
+24 FOR I=1:1:2
SET PRCCNT=$GET(^TMP($JOB,I))
if PRCCNT=""
QUIT
if SSTOP="STOP"
QUIT
Begin DoDot:1
+25 SET MSGDAT=$GET(^TMP($JOB,I))
+26 if MSGDAT=""
QUIT
+27 SET MSGDAT2=$PIECE(MSGDAT,PRCFS,2,21)
+28 IF $EXTRACT(MSGDAT,1,3)="MSH"
Begin DoDot:2
+29 SET MSGDAT3=$PIECE(MSGDAT2,PRCFS,8)
+30 IF MSGDAT3'["ORN"_PRCCS_"O08"
Begin DoDot:3
+31 SET SSTOP="STOP"
SET MSGTYP="NOK"
+32 SET PRCVTYP="ACK"
SET PRCVID=$PIECE(MSGDAT2,PRCFS,9)
+33 SET PRCVERR(1)="IN "_PRCVTYP_" "_PRCVID_" there was a bad message type"
+34 SET PRCVPTR="*"_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)_"- - -076"
End DoDot:3
End DoDot:2
QUIT
+35 IF $EXTRACT(MSGDAT,1,3)="MSA"
Begin DoDot:2
+36 SET PRCVACK=$PIECE(MSGDAT2,PRCFS,1)
+37 SET PRCVMID=$PIECE(MSGDAT2,PRCFS,2)
+38 SET PRCVMID2="PRCVMID*"_PRCVMID
+39 SET PRCVPTR=$PIECE($GET(^XTMP(PRCVMID2,1)),U,1)
+40 SET PRCVDT=$PIECE($GET(^XTMP(PRCVMID2,1)),U,2)
+41 IF PRCVACK="AA"
Begin DoDot:3
+42 SET MSGTYP="OK"
End DoDot:3
QUIT
+43 IF (PRCVACK="AE")!(PRCVACK="AR")
Begin DoDot:3
+44 SET MSGTYP="NOK"
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
+45 IF $EXTRACT(MSGTYP,1,2)="OK"
DO VALID
QUIT
+46 IF PRCVTYP="ACK"
DO NOVALID
QUIT
ERROR ;Now process error messages
+1 ;
+2 SET ERRCNT=1
+3 SET PRCCNT=""
FOR I=3:1
SET PRCCNT=$GET(^TMP($JOB,I))
if PRCCNT=""
QUIT
Begin DoDot:1
+4 SET MSGDAT=$GET(^TMP($JOB,I))
+5 if MSGDAT=""
QUIT
+6 SET MSGDAT2=$PIECE(MSGDAT,PRCFS,2,7)
+7 SET PRCVLOC=$PIECE(MSGDAT2,PRCFS,2)
+8 SET PRCVEC=$PIECE(MSGDAT2,PRCFS,3)
+9 SET PRCVSEV=$PIECE(MSGDAT2,PRCFS,4)
+10 SET PRCVAEC=$PIECE(MSGDAT2,PRCFS,5)
+11 SET PRCVID=$PIECE(MSGDAT2,PRCFS,6)
+12 SET PRCVTYP="RIL"
+13 IF PRCVID?.N1"-".N1"-".N1"-".E1"-".N
SET PRCVTYP="2237"
+14 SET PRCSEG=$PIECE(PRCVLOC,PRCCS,1)
+15 SET PRCSEQ=$PIECE(PRCVLOC,PRCCS,2)
+16 SET PRCFLD=$PIECE(PRCVLOC,PRCCS,3)
+17 SET PRCERCD=$PIECE(PRCVAEC,PRCCS,1)
+18 SET PRCERTX=$PIECE(PRCVAEC,PRCCS,2)
+19 SET ERRTXT="Error"
+20 IF PRCVSEV="W"
SET ERRTXT="Warning"
+21 SET PRCVERR(ERRCNT)="In "_PRCVTYP_" "_PRCVID_" the following occurred"
+22 SET ERRCNT=ERRCNT+1
+23 SET PRCVERR(ERRCNT)="For Line item "_PRCSEQ_" the "_PRCDET(PRCSEG,PRCFLD)_" had the following "_ERRTXT_": "
+24 SET ERRCNT=ERRCNT+1
+25 SET PRCVERR(ERRCNT)=PRCERTX
+26 SET ERRCNT=ERRCNT+1
End DoDot:1
+27 DO NOVALID
+28 QUIT
VALID ;Do NOTHING to notify user that message is ok.
+1 DO CLEANUP
+2 QUIT
NOVALID ;Mailman message
+1 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET XMSUB="IFCAP to DynaMed "_PRCVTYP_" Errors "_PRCVID_" "
+3 SET XMDUZ="IFCAP/DynaMed Interface"
+4 SET XMTEXT="PRCVERR("
+5 ;S XMY("CARR.VICTOR@CSL.FO-WASH.DOMAIN.EXT")=""
+6 SET PRCFCP=$PIECE(PRCVPTR,"-",4)
+7 SET PRCSITE0=$PIECE(PRCVPTR,"-",1)
+8 SET PRCSITE=$PIECE(PRCSITE0,"*",2)
+9 DO GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
+10 DO ^XMD
+11 KILL XMSUB,XMMG,XMDUZ,XMTEXT,XMY,XMZ
+12 DO CLEANUP
+13 QUIT
+14 ;
CLEANUP ; Clean up data
+1 KILL MSGTYP,MSGDAT,MSGDAT2,MSGDAT3,ERRTXT
+2 KILL PRCCNT,PRCFS,PRCCS,I,J,SSTOP,PRCFCP,PRCSITE,PRCSITE0
+3 KILL ^TMP($JOB),ERRCNT,PRCERCD,PRCERTX,PRCFLD,PRCSEG,PRCSEQ
+4 KILL PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR,PRCVID,PRCVLOC
+5 KILL PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,PRCDET
+6 ;
