Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCVPOSD

PRCVPOSD.m

Go to the documentation of this file.
  1. PRCVPOSD ;WOIFO/DAP-DYNAMED COMBINED PO EVENTS SEND ; 12/13/04
  1. V ;;5.1;IFCAP;**81**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;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. ;1-Purchase Order Obligations
  1. ;2-Amendments to Obligated Purchase Orders
  1. ;3-Purchase Order Receiving Reports
  1. ;4-Adjustments to Purchase Order Receiving Reports
  1. ;
  1. Q
  1. ;
  1. EN(PRCVX) ;Entry point for API Call
  1. I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q
  1. I $D(PRCVX)=0 Q
  1. N HLA
  1. S PRCVCNT=0,PRCVERG=0
  1. D HDRBLD
  1. I PRCVERG=1 K PRCVERG Q
  1. S N=0 F S N=$O(^TMP("PRCV442A",$J,PRCVX,N)) Q:+N=0 D
  1. . D MSGBLD
  1. . Q
  1. ;
  1. S PRCVDP="" D GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
  1. I +$P(PRCVDP,"^",2) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP
  1. ;
  1. K ^TMP("PRCV442A",$J,PRCVX)
  1. D FIN
  1. K PRCVERG
  1. ;
  1. Q
  1. ;
  1. HDRBLD ;Build message elements from provided header level data
  1. ;
  1. ;PRCVPO Purchase Order #
  1. S PRCVPO=$P(^TMP("PRCV442A",$J,PRCVX),"^",1)
  1. ;PRCVTT Transaction Type
  1. S PRCVTT=$P(^TMP("PRCV442A",$J,PRCVX),"^",2)
  1. I PRCVTT=1 S PRCVT1="NW",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
  1. I PRCVTT=2 S PRCVT1="XO",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
  1. I PRCVTT=3 S PRCVT1="SC",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
  1. I PRCVTT=4 S PRCVT1="XX",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
  1. I PRCVTT=5 S PRCVT1="CA",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
  1. ;PRCVDZ IFCAP User DUZ
  1. S PRCVDZ=$P(^TMP("PRCV442A",$J,PRCVX),"^",3)
  1. ;Retrieve user name based on DUZ from file 200 using $$HLNAME^XLFNAME call as detailed in DBIA #3065
  1. S PRCVDNM("FILE")=200,PRCVDNM("FIELD")=.01,PRCVDNM("IENS")=PRCVDZ_","
  1. S PRCVDNM=$P($$HLNAME^XLFNAME(.PRCVDNM," ","^"),"^",1,2)
  1. S PRCVNML=$P(PRCVDNM,"^",1)
  1. S PRCVNMF=$P(PRCVDNM,"^",2)
  1. ;PRCVVNI Vendor Number IEN
  1. S PRCVVNI=$P(^TMP("PRCV442A",$J,PRCVX),"^",4)
  1. ;PRCVVNF Vendor Number FMS
  1. S PRCVVNF=$P(^TMP("PRCV442A",$J,PRCVX),"^",5)
  1. ;
  1. ;##### FMS ALTERNATE ADDRESS INDICATOR #####
  1. ;PIECE 6
  1. ;
  1. ;PRCVDT Transaction Date / Time
  1. S PRCVDT=$P(^TMP("PRCV442A",$J,PRCVX),"^",7)
  1. S PRCVDT=$$FMTHL7^XLFDT(PRCVDT)
  1. ;PRCVSTA Station #
  1. S PRCVSTA=$P(^TMP("PRCV442A",$J,PRCVX),"^",8)
  1. ;PRCVPSTA Purchasing Station #
  1. S PRCVPSTA=+(PRCVPO)
  1. ;
  1. K HL D INIT^HLFNC2(PRCVPRO,.HL)
  1. I $G(HL) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP D FIN Q
  1. ;
  1. S PRCVCS=$E(HL("ECH")),PRCVFS=HL("FS")
  1. ;
  1. Q
  1. ;
  1. MSGBLD ;Generate repeating message body for all line level data
  1. ;
  1. ;PRCVDDN DynaMed Document Number
  1. S PRCVDDN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",1)
  1. ;S PRCVDDN=$E(PRCVDDN,1,4)_"-"_$E(PRCVDDN,5,8)_"-"_$E(PRCVDDN,9,11)
  1. ;PRCVIN Item Number
  1. S PRCVIN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",2)
  1. ;PRCVLN PO Line Number
  1. S PRCVLN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",3)
  1. ;PRCVTN 2237 Transaction Number
  1. S PRCVTN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",4)
  1. ;PRCVUOP Unit Of Purchase
  1. S PRCVUOP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",5)
  1. ;PRCVQO Quantity Ordered
  1. S PRCVQO=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",6)
  1. ;PRCVUP Unit Price
  1. S PRCVUP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",7)
  1. ;PRCVNIF NIF Number
  1. S PRCVNIF=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",8)
  1. ;I PRCVNIF="" S PRCVNIF="1234"
  1. ;PRCVPM Packaging Multiple
  1. S PRCVPM=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",9)
  1. ;PRCVQR Quantity Received
  1. S PRCVQR=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",10)
  1. ;PRCVTIC Total Item Cost
  1. S PRCVTIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",11)
  1. ;PRCVDIC Discounted Item Cost
  1. S PRCVDIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",12)
  1. ;PRCVERD Expected Delivery Date
  1. S PRCVERD=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",13)
  1. S PRCVERD=$$FMTHL7^XLFDT(PRCVERD)
  1. ;PRCVAT Amendment/Adjustment Type
  1. S PRCVAT=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",14)
  1. I PRCVAT=1 S PRCVAT="1^Line Item Edit"
  1. I PRCVAT=2 S PRCVAT="2^Line Item Delete"
  1. I PRCVAT=3 S PRCVAT="3^Change Vendor"
  1. I PRCVAT=4 S PRCVAT="4^Replace PO Number"
  1. I PRCVAT=5 S PRCVAT="5^Authority Edit"
  1. ;
  1. ;Build ORC Segment
  1. S PRCVCNT=PRCVCNT+1
  1. S HLA("HLS",PRCVCNT)="ORC"_PRCVFS_PRCVT1_PRCVFS_PRCVPO_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS
  1. 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
  1. ;
  1. ;Build RQD Segment
  1. S PRCVCNT=PRCVCNT+1
  1. S HLA("HLS",PRCVCNT)="RQD"_PRCVFS_PRCVLN_PRCVFS_PRCVDDN_PRCVFS_PRCVIN_PRCVFS_PRCVPM_PRCVFS_PRCVQO_PRCVFS_PRCVUOP
  1. S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVFS_PRCVTN_PRCVFS_PRCVERD
  1. ;
  1. ;Build RQ1 Segment
  1. S PRCVCNT=PRCVCNT+1
  1. S HLA("HLS",PRCVCNT)="RQ1"_PRCVFS_PRCVUP_PRCVFS_PRCVFS_PRCVFS_PRCVVNI_PRCVCS_PRCVCS_PRCVCS_PRCVVNF_PRCVFS_PRCVNIF
  1. ;
  1. ;Build FT1 Segment
  1. S PRCVCNT=PRCVCNT+1
  1. S HLA("HLS",PRCVCNT)="FT1"_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS_PRCVFS_PRCVT2_PRCVFS_PRCVPO_PRCVFS
  1. S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVQR_PRCVFS_PRCVTIC_PRCVFS_PRCVDIC
  1. ;
  1. Q
  1. ;
  1. ORRPROC ;Process ORR^O02 response message
  1. ;
  1. ;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
  1. X HLNEXT
  1. ;
  1. X HLNEXT
  1. S VAL=$$FLD^HLCSUTL(HLNODE,2)
  1. I VAL'="AA" D ERROR
  1. ;
  1. D FIN
  1. ;
  1. Q
  1. ;
  1. ERROR ;Process ERR Segments
  1. S PRCVERC=1 F N=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. . S VAL=$$FLD^HLCSUTL(HLNODE,1)
  1. . I VAL="ERR" S PRCVERC=PRCVERC+1,PRCVERM=$$FLD^HLCSUTL(HLNODE,6),PRCVERD=$$FLD^HLCSUTL(HLNODE,7)
  1. . S PRCVPO2=$P(PRCVERD,"~",1)
  1. . S PRCVERR(PRCVERC)="At Line Number "_$P(PRCVERD,"~",2)_" involving Document ID "_$P(PRCVERD,"~",3)_" the following errors occurred:"
  1. . S PRCVERC=PRCVERC+1
  1. . S PRCVERR(PRCVERC)=$P(PRCVERM,"^",2)
  1. . Q
  1. S PRCVERR(1)="PO # "_PRCVPO2_" failed to update in the DynaMed system"
  1. ;
  1. D CLIFP
  1. ;
  1. Q
  1. ;
  1. CLIFP ;Call partner app w/ mail message for users on error
  1. N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
  1. I $D(PRCVPO) S PRCVPO2=PRCVPO
  1. S XMSUB="Inventory System PO # "_PRCVPO2_" Errors "_$$HTE^XLFDT($H)
  1. S XMDUZ="IFCAP/COTS Inventory Interface"
  1. S XMTEXT="PRCVERR("
  1. ;
  1. S PRCVSIT=+PRCVPO2,PRCVFCP=$$FCP^PRCV442B(PRCVPO2)
  1. D GETFCPU^PRCVLIC(.XMY,PRCVSIT,PRCVFCP)
  1. ;
  1. D ^XMD
  1. S PRCVERG=1
  1. K PRCVPO2,PRCVFCP,PRCVSIT
  1. ;
  1. Q
  1. ;
  1. FIN ;Clean up variables
  1. K PRCVINP,PRCVCNT,PRCVPO,PRCVTT,PRCVT1,PRCVT2,PRCVDZ,PRCVDNM,PRCVNML,PRCVNMF,PRCVVNI,PRCVVNF,PRCVDT,PRCVERD,PRCVSTA,N,PRCVX
  1. K PRCVPRO,PRCVCS,PRCVFS,PRCVLN,PRCVDDN,PRCVIN,PRCVTN,PRCVUOP,PRCVQO,PRCVUP,PRCVNIF,PRCVPM,PRCVQR,PRCVTIC,PRCVDIC,PRCVAT,PRCVPSTA
  1. K HLA,VAL,PRCVDP,PRCVERC,PRCVERM,PRCVERD,PRCVERR
  1. ;
  1. Q