- 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 Jan 18, 2025@03:21:21 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