- 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 Mar 13, 2025@21:24:46 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 ;
