PRCVPOSD ;WOIFO/DAP-DYNAMED COMBINED PO EVENTS SEND ; 12/13/04
V ;;5.1;IFCAP;**81**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
;This routine is used to send an ORM^O01 HL7 message to the DynaMed inventory system to report one of four Purchase Order operations.
;1-Purchase Order Obligations
;2-Amendments to Obligated Purchase Orders
;3-Purchase Order Receiving Reports
;4-Adjustments to Purchase Order Receiving Reports
;
Q
;
EN(PRCVX) ;Entry point for API Call
I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q
I $D(PRCVX)=0 Q
N HLA
S PRCVCNT=0,PRCVERG=0
D HDRBLD
I PRCVERG=1 K PRCVERG Q
S N=0 F S N=$O(^TMP("PRCV442A",$J,PRCVX,N)) Q:+N=0 D
. D MSGBLD
. Q
;
S PRCVDP="" D GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
I +$P(PRCVDP,"^",2) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP
;
K ^TMP("PRCV442A",$J,PRCVX)
D FIN
K PRCVERG
;
Q
;
HDRBLD ;Build message elements from provided header level data
;
;PRCVPO Purchase Order #
S PRCVPO=$P(^TMP("PRCV442A",$J,PRCVX),"^",1)
;PRCVTT Transaction Type
S PRCVTT=$P(^TMP("PRCV442A",$J,PRCVX),"^",2)
I PRCVTT=1 S PRCVT1="NW",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
I PRCVTT=2 S PRCVT1="XO",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
I PRCVTT=3 S PRCVT1="SC",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
I PRCVTT=4 S PRCVT1="XX",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
I PRCVTT=5 S PRCVT1="CA",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
;PRCVDZ IFCAP User DUZ
S PRCVDZ=$P(^TMP("PRCV442A",$J,PRCVX),"^",3)
;Retrieve user name based on DUZ from file 200 using $$HLNAME^XLFNAME call as detailed in DBIA #3065
S PRCVDNM("FILE")=200,PRCVDNM("FIELD")=.01,PRCVDNM("IENS")=PRCVDZ_","
S PRCVDNM=$P($$HLNAME^XLFNAME(.PRCVDNM," ","^"),"^",1,2)
S PRCVNML=$P(PRCVDNM,"^",1)
S PRCVNMF=$P(PRCVDNM,"^",2)
;PRCVVNI Vendor Number IEN
S PRCVVNI=$P(^TMP("PRCV442A",$J,PRCVX),"^",4)
;PRCVVNF Vendor Number FMS
S PRCVVNF=$P(^TMP("PRCV442A",$J,PRCVX),"^",5)
;
;##### FMS ALTERNATE ADDRESS INDICATOR #####
;PIECE 6
;
;PRCVDT Transaction Date / Time
S PRCVDT=$P(^TMP("PRCV442A",$J,PRCVX),"^",7)
S PRCVDT=$$FMTHL7^XLFDT(PRCVDT)
;PRCVSTA Station #
S PRCVSTA=$P(^TMP("PRCV442A",$J,PRCVX),"^",8)
;PRCVPSTA Purchasing Station #
S PRCVPSTA=+(PRCVPO)
;
K HL D INIT^HLFNC2(PRCVPRO,.HL)
I $G(HL) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP D FIN Q
;
S PRCVCS=$E(HL("ECH")),PRCVFS=HL("FS")
;
Q
;
MSGBLD ;Generate repeating message body for all line level data
;
;PRCVDDN DynaMed Document Number
S PRCVDDN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",1)
;S PRCVDDN=$E(PRCVDDN,1,4)_"-"_$E(PRCVDDN,5,8)_"-"_$E(PRCVDDN,9,11)
;PRCVIN Item Number
S PRCVIN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",2)
;PRCVLN PO Line Number
S PRCVLN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",3)
;PRCVTN 2237 Transaction Number
S PRCVTN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",4)
;PRCVUOP Unit Of Purchase
S PRCVUOP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",5)
;PRCVQO Quantity Ordered
S PRCVQO=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",6)
;PRCVUP Unit Price
S PRCVUP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",7)
;PRCVNIF NIF Number
S PRCVNIF=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",8)
;I PRCVNIF="" S PRCVNIF="1234"
;PRCVPM Packaging Multiple
S PRCVPM=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",9)
;PRCVQR Quantity Received
S PRCVQR=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",10)
;PRCVTIC Total Item Cost
S PRCVTIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",11)
;PRCVDIC Discounted Item Cost
S PRCVDIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",12)
;PRCVERD Expected Delivery Date
S PRCVERD=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",13)
S PRCVERD=$$FMTHL7^XLFDT(PRCVERD)
;PRCVAT Amendment/Adjustment Type
S PRCVAT=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",14)
I PRCVAT=1 S PRCVAT="1^Line Item Edit"
I PRCVAT=2 S PRCVAT="2^Line Item Delete"
I PRCVAT=3 S PRCVAT="3^Change Vendor"
I PRCVAT=4 S PRCVAT="4^Replace PO Number"
I PRCVAT=5 S PRCVAT="5^Authority Edit"
;
;Build ORC Segment
S PRCVCNT=PRCVCNT+1
S HLA("HLS",PRCVCNT)="ORC"_PRCVFS_PRCVT1_PRCVFS_PRCVPO_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS
S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVDZ_PRCVCS_PRCVNML_PRCVCS_PRCVNMF_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTA_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVAT_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVPSTA
;
;Build RQD Segment
S PRCVCNT=PRCVCNT+1
S HLA("HLS",PRCVCNT)="RQD"_PRCVFS_PRCVLN_PRCVFS_PRCVDDN_PRCVFS_PRCVIN_PRCVFS_PRCVPM_PRCVFS_PRCVQO_PRCVFS_PRCVUOP
S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVFS_PRCVTN_PRCVFS_PRCVERD
;
;Build RQ1 Segment
S PRCVCNT=PRCVCNT+1
S HLA("HLS",PRCVCNT)="RQ1"_PRCVFS_PRCVUP_PRCVFS_PRCVFS_PRCVFS_PRCVVNI_PRCVCS_PRCVCS_PRCVCS_PRCVVNF_PRCVFS_PRCVNIF
;
;Build FT1 Segment
S PRCVCNT=PRCVCNT+1
S HLA("HLS",PRCVCNT)="FT1"_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS_PRCVFS_PRCVT2_PRCVFS_PRCVPO_PRCVFS
S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVQR_PRCVFS_PRCVTIC_PRCVFS_PRCVDIC
;
Q
;
ORRPROC ;Process ORR^O02 response message
;
;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
X HLNEXT
;
X HLNEXT
S VAL=$$FLD^HLCSUTL(HLNODE,2)
I VAL'="AA" D ERROR
;
D FIN
;
Q
;
ERROR ;Process ERR Segments
S PRCVERC=1 F N=1:1 X HLNEXT Q:HLQUIT'>0 D
. S VAL=$$FLD^HLCSUTL(HLNODE,1)
. I VAL="ERR" S PRCVERC=PRCVERC+1,PRCVERM=$$FLD^HLCSUTL(HLNODE,6),PRCVERD=$$FLD^HLCSUTL(HLNODE,7)
. S PRCVPO2=$P(PRCVERD,"~",1)
. S PRCVERR(PRCVERC)="At Line Number "_$P(PRCVERD,"~",2)_" involving Document ID "_$P(PRCVERD,"~",3)_" the following errors occurred:"
. S PRCVERC=PRCVERC+1
. S PRCVERR(PRCVERC)=$P(PRCVERM,"^",2)
. Q
S PRCVERR(1)="PO # "_PRCVPO2_" failed to update in the DynaMed system"
;
D CLIFP
;
Q
;
CLIFP ;Call partner app w/ mail message for users on error
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
I $D(PRCVPO) S PRCVPO2=PRCVPO
S XMSUB="Inventory System PO # "_PRCVPO2_" Errors "_$$HTE^XLFDT($H)
S XMDUZ="IFCAP/COTS Inventory Interface"
S XMTEXT="PRCVERR("
;
S PRCVSIT=+PRCVPO2,PRCVFCP=$$FCP^PRCV442B(PRCVPO2)
D GETFCPU^PRCVLIC(.XMY,PRCVSIT,PRCVFCP)
;
D ^XMD
S PRCVERG=1
K PRCVPO2,PRCVFCP,PRCVSIT
;
Q
;
FIN ;Clean up variables
K PRCVINP,PRCVCNT,PRCVPO,PRCVTT,PRCVT1,PRCVT2,PRCVDZ,PRCVDNM,PRCVNML,PRCVNMF,PRCVVNI,PRCVVNF,PRCVDT,PRCVERD,PRCVSTA,N,PRCVX
K PRCVPRO,PRCVCS,PRCVFS,PRCVLN,PRCVDDN,PRCVIN,PRCVTN,PRCVUOP,PRCVQO,PRCVUP,PRCVNIF,PRCVPM,PRCVQR,PRCVTIC,PRCVDIC,PRCVAT,PRCVPSTA
K HLA,VAL,PRCVDP,PRCVERC,PRCVERM,PRCVERD,PRCVERR
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVPOSD 6755 printed Oct 16, 2024@18:20:53 Page 2
PRCVPOSD ;WOIFO/DAP-DYNAMED COMBINED PO EVENTS SEND ; 12/13/04
V ;;5.1;IFCAP;**81**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ;This routine is used to send an ORM^O01 HL7 message to the DynaMed inventory system to report one of four Purchase Order operations.
+4 ;1-Purchase Order Obligations
+5 ;2-Amendments to Obligated Purchase Orders
+6 ;3-Purchase Order Receiving Reports
+7 ;4-Adjustments to Purchase Order Receiving Reports
+8 ;
+9 QUIT
+10 ;
EN(PRCVX) ;Entry point for API Call
+1 IF $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
QUIT
+2 IF $DATA(PRCVX)=0
QUIT
+3 NEW HLA
+4 SET PRCVCNT=0
SET PRCVERG=0
+5 DO HDRBLD
+6 IF PRCVERG=1
KILL PRCVERG
QUIT
+7 SET N=0
FOR
SET N=$ORDER(^TMP("PRCV442A",$JOB,PRCVX,N))
if +N=0
QUIT
Begin DoDot:1
+8 DO MSGBLD
+9 QUIT
End DoDot:1
+10 ;
+11 SET PRCVDP=""
DO GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
+12 IF +$PIECE(PRCVDP,"^",2)
SET PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO
SET PRCVERD=PRCVPO
DO CLIFP
+13 ;
+14 KILL ^TMP("PRCV442A",$JOB,PRCVX)
+15 DO FIN
+16 KILL PRCVERG
+17 ;
+18 QUIT
+19 ;
HDRBLD ;Build message elements from provided header level data
+1 ;
+2 ;PRCVPO Purchase Order #
+3 SET PRCVPO=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",1)
+4 ;PRCVTT Transaction Type
+5 SET PRCVTT=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",2)
+6 IF PRCVTT=1
SET PRCVT1="NW"
SET PRCVT2="CG"
SET PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
+7 IF PRCVTT=2
SET PRCVT1="XO"
SET PRCVT2="AJ"
SET PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
+8 IF PRCVTT=3
SET PRCVT1="SC"
SET PRCVT2="CG"
SET PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
+9 IF PRCVTT=4
SET PRCVT1="XX"
SET PRCVT2="AJ"
SET PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
+10 IF PRCVTT=5
SET PRCVT1="CA"
SET PRCVT2="AJ"
SET PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
+11 ;PRCVDZ IFCAP User DUZ
+12 SET PRCVDZ=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",3)
+13 ;Retrieve user name based on DUZ from file 200 using $$HLNAME^XLFNAME call as detailed in DBIA #3065
+14 SET PRCVDNM("FILE")=200
SET PRCVDNM("FIELD")=.01
SET PRCVDNM("IENS")=PRCVDZ_","
+15 SET PRCVDNM=$PIECE($$HLNAME^XLFNAME(.PRCVDNM," ","^"),"^",1,2)
+16 SET PRCVNML=$PIECE(PRCVDNM,"^",1)
+17 SET PRCVNMF=$PIECE(PRCVDNM,"^",2)
+18 ;PRCVVNI Vendor Number IEN
+19 SET PRCVVNI=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",4)
+20 ;PRCVVNF Vendor Number FMS
+21 SET PRCVVNF=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",5)
+22 ;
+23 ;##### FMS ALTERNATE ADDRESS INDICATOR #####
+24 ;PIECE 6
+25 ;
+26 ;PRCVDT Transaction Date / Time
+27 SET PRCVDT=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",7)
+28 SET PRCVDT=$$FMTHL7^XLFDT(PRCVDT)
+29 ;PRCVSTA Station #
+30 SET PRCVSTA=$PIECE(^TMP("PRCV442A",$JOB,PRCVX),"^",8)
+31 ;PRCVPSTA Purchasing Station #
+32 SET PRCVPSTA=+(PRCVPO)
+33 ;
+34 KILL HL
DO INIT^HLFNC2(PRCVPRO,.HL)
+35 IF $GET(HL)
SET PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO
SET PRCVERD=PRCVPO
DO CLIFP
DO FIN
QUIT
+36 ;
+37 SET PRCVCS=$EXTRACT(HL("ECH"))
SET PRCVFS=HL("FS")
+38 ;
+39 QUIT
+40 ;
MSGBLD ;Generate repeating message body for all line level data
+1 ;
+2 ;PRCVDDN DynaMed Document Number
+3 SET PRCVDDN=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",1)
+4 ;S PRCVDDN=$E(PRCVDDN,1,4)_"-"_$E(PRCVDDN,5,8)_"-"_$E(PRCVDDN,9,11)
+5 ;PRCVIN Item Number
+6 SET PRCVIN=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",2)
+7 ;PRCVLN PO Line Number
+8 SET PRCVLN=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",3)
+9 ;PRCVTN 2237 Transaction Number
+10 SET PRCVTN=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",4)
+11 ;PRCVUOP Unit Of Purchase
+12 SET PRCVUOP=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",5)
+13 ;PRCVQO Quantity Ordered
+14 SET PRCVQO=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",6)
+15 ;PRCVUP Unit Price
+16 SET PRCVUP=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",7)
+17 ;PRCVNIF NIF Number
+18 SET PRCVNIF=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",8)
+19 ;I PRCVNIF="" S PRCVNIF="1234"
+20 ;PRCVPM Packaging Multiple
+21 SET PRCVPM=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",9)
+22 ;PRCVQR Quantity Received
+23 SET PRCVQR=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",10)
+24 ;PRCVTIC Total Item Cost
+25 SET PRCVTIC=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",11)
+26 ;PRCVDIC Discounted Item Cost
+27 SET PRCVDIC=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",12)
+28 ;PRCVERD Expected Delivery Date
+29 SET PRCVERD=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",13)
+30 SET PRCVERD=$$FMTHL7^XLFDT(PRCVERD)
+31 ;PRCVAT Amendment/Adjustment Type
+32 SET PRCVAT=$PIECE(^TMP("PRCV442A",$JOB,PRCVX,N),"^",14)
+33 IF PRCVAT=1
SET PRCVAT="1^Line Item Edit"
+34 IF PRCVAT=2
SET PRCVAT="2^Line Item Delete"
+35 IF PRCVAT=3
SET PRCVAT="3^Change Vendor"
+36 IF PRCVAT=4
SET PRCVAT="4^Replace PO Number"
+37 IF PRCVAT=5
SET PRCVAT="5^Authority Edit"
+38 ;
+39 ;Build ORC Segment
+40 SET PRCVCNT=PRCVCNT+1
+41 SET HLA("HLS",PRCVCNT)="ORC"_PRCVFS_PRCVT1_PRCVFS_PRCVPO_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS
+42 SET HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVDZ_PRCVCS_PRCVNML_PRCVCS_PRCVNMF_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTA_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVAT_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVPSTA
+43 ;
+44 ;Build RQD Segment
+45 SET PRCVCNT=PRCVCNT+1
+46 SET HLA("HLS",PRCVCNT)="RQD"_PRCVFS_PRCVLN_PRCVFS_PRCVDDN_PRCVFS_PRCVIN_PRCVFS_PRCVPM_PRCVFS_PRCVQO_PRCVFS_PRCVUOP
+47 SET HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVFS_PRCVTN_PRCVFS_PRCVERD
+48 ;
+49 ;Build RQ1 Segment
+50 SET PRCVCNT=PRCVCNT+1
+51 SET HLA("HLS",PRCVCNT)="RQ1"_PRCVFS_PRCVUP_PRCVFS_PRCVFS_PRCVFS_PRCVVNI_PRCVCS_PRCVCS_PRCVCS_PRCVVNF_PRCVFS_PRCVNIF
+52 ;
+53 ;Build FT1 Segment
+54 SET PRCVCNT=PRCVCNT+1
+55 SET HLA("HLS",PRCVCNT)="FT1"_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS_PRCVFS_PRCVT2_PRCVFS_PRCVPO_PRCVFS
+56 SET HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVQR_PRCVFS_PRCVTIC_PRCVFS_PRCVDIC
+57 ;
+58 QUIT
+59 ;
ORRPROC ;Process ORR^O02 response message
+1 ;
+2 ;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
+3 XECUTE HLNEXT
+4 ;
+5 XECUTE HLNEXT
+6 SET VAL=$$FLD^HLCSUTL(HLNODE,2)
+7 IF VAL'="AA"
DO ERROR
+8 ;
+9 DO FIN
+10 ;
+11 QUIT
+12 ;
ERROR ;Process ERR Segments
+1 SET PRCVERC=1
FOR N=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+2 SET VAL=$$FLD^HLCSUTL(HLNODE,1)
+3 IF VAL="ERR"
SET PRCVERC=PRCVERC+1
SET PRCVERM=$$FLD^HLCSUTL(HLNODE,6)
SET PRCVERD=$$FLD^HLCSUTL(HLNODE,7)
+4 SET PRCVPO2=$PIECE(PRCVERD,"~",1)
+5 SET PRCVERR(PRCVERC)="At Line Number "_$PIECE(PRCVERD,"~",2)_" involving Document ID "_$PIECE(PRCVERD,"~",3)_" the following errors occurred:"
+6 SET PRCVERC=PRCVERC+1
+7 SET PRCVERR(PRCVERC)=$PIECE(PRCVERM,"^",2)
+8 QUIT
End DoDot:1
+9 SET PRCVERR(1)="PO # "_PRCVPO2_" failed to update in the DynaMed system"
+10 ;
+11 DO CLIFP
+12 ;
+13 QUIT
+14 ;
CLIFP ;Call partner app w/ mail message for users on error
+1 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 IF $DATA(PRCVPO)
SET PRCVPO2=PRCVPO
+3 SET XMSUB="Inventory System PO # "_PRCVPO2_" Errors "_$$HTE^XLFDT($HOROLOG)
+4 SET XMDUZ="IFCAP/COTS Inventory Interface"
+5 SET XMTEXT="PRCVERR("
+6 ;
+7 SET PRCVSIT=+PRCVPO2
SET PRCVFCP=$$FCP^PRCV442B(PRCVPO2)
+8 DO GETFCPU^PRCVLIC(.XMY,PRCVSIT,PRCVFCP)
+9 ;
+10 DO ^XMD
+11 SET PRCVERG=1
+12 KILL PRCVPO2,PRCVFCP,PRCVSIT
+13 ;
+14 QUIT
+15 ;
FIN ;Clean up variables
+1 KILL PRCVINP,PRCVCNT,PRCVPO,PRCVTT,PRCVT1,PRCVT2,PRCVDZ,PRCVDNM,PRCVNML,PRCVNMF,PRCVVNI,PRCVVNF,PRCVDT,PRCVERD,PRCVSTA,N,PRCVX
+2 KILL PRCVPRO,PRCVCS,PRCVFS,PRCVLN,PRCVDDN,PRCVIN,PRCVTN,PRCVUOP,PRCVQO,PRCVUP,PRCVNIF,PRCVPM,PRCVQR,PRCVTIC,PRCVDIC,PRCVAT,PRCVPSTA
+3 KILL HLA,VAL,PRCVDP,PRCVERC,PRCVERM,PRCVERD,PRCVERR
+4 ;
+5 QUIT
