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