184 lines
6.4 KiB
Mathematica
184 lines
6.4 KiB
Mathematica
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
|