280 lines
8.9 KiB
Mathematica
280 lines
8.9 KiB
Mathematica
PRCVIMF ;WOIFO/DST - DynaMed ITEM update HL7 messaging interface; 03/07/05
|
|
;;5.1;IFCAP;**81**;Oct 20,2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
Q
|
|
;
|
|
EN(PRCVIN) ;Entry point for API Call
|
|
;
|
|
N PRCVSEG,PRCVFLD,PRCVFS,PRCVCS,PRCVRS,PRCVI,PRCVN,PRCVCON
|
|
N PRCVDT1,PRCVDUZ,PRCVND0,PRCVND2,PRCVND3,PRCVSTN,PRCVUP,PRCVERR
|
|
N PRCVDP,PRCVPRO
|
|
K HLA
|
|
;
|
|
I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q
|
|
I $D(PRCVIN)=0 Q
|
|
S PRCVN=0
|
|
D HDRBLD
|
|
I $G(PRCVERR) D FIN Q
|
|
D MSGBLD
|
|
;
|
|
S PRCVDP=""
|
|
D GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
|
|
I +$P(PRCVDP,U,2) S PRCVERR(1)="Error generating message through VistA HL7 package for ITEM Update with ITEM # "_PRCVIN D CLIFP
|
|
D FIN
|
|
;
|
|
Q
|
|
;
|
|
HDRBLD ;Generate message header, MFI Segment
|
|
;
|
|
K HL S PRCVPRO="PRCV_IFCAP_05_EV_ITEM_UPD"
|
|
D INIT^HLFNC2(PRCVPRO,.HL)
|
|
I $G(HL) S PRCVERR(1)="Error generating message through VistA HL7 package for ITEM Update involving ITEM # "_PRCVIN D CLIFP Q
|
|
S PRCVCS=$E(HL("ECH")),PRCVRS=$E(HL("ECH"),2),PRCVFS=HL("FS")
|
|
;
|
|
;PRCVDT Transaction Date/Time w/offset
|
|
D NOW^%DTC
|
|
S PRCVDT=$$FMTHL7^XLFDT(%)
|
|
;
|
|
;Build MFI Segment
|
|
S PRCVN=PRCVN+1
|
|
S HLA("HLS",PRCVN)="MFI"_PRCVFS_"OME"_PRCVFS_"441"_PRCVCS_"ITEM MASTER"_PRCVFS_"UPD"_PRCVFS_PRCVDT_PRCVFS_PRCVFS_"AL"
|
|
;
|
|
Q
|
|
;
|
|
MSGBLD ; Build Message Body
|
|
; PRCVFLD - Field
|
|
;
|
|
; ITEM short description
|
|
S PRCVND0=^TMP("PRCVIT",$J,PRCVIN,0)
|
|
S PRCVFLD=$$CONV^PRCVUTSC($P(PRCVND0,U,2),"C",HLFS_HLECH)
|
|
; Station Number
|
|
S PRCVSTN=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
|
|
;
|
|
; MFE segment
|
|
;
|
|
S PRCVN=PRCVN+1
|
|
S HLA("HLS",PRCVN)="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVIN_PRCVFS_PRCVDT_PRCVFS_PRCVIN_PRCVCS_PRCVFLD_PRCVCS_PRCVSTN_PRCVFS_"CE"
|
|
;
|
|
; ZIT segment
|
|
;
|
|
N PRCVN1,PRCVNM
|
|
S PRCVN=PRCVN+1
|
|
S PRCVN1=1
|
|
S PRCVND3=$G(^TMP("PRCVIT",$J,PRCVIN,3))
|
|
; Case/Cart Tray/instrument kit
|
|
S HLA("HLS",PRCVN)="ZIT"_PRCVFS_PRCVSTN_PRCVFS_$P(PRCVND0,U,6)_PRCVFS
|
|
; Description (Word Processing field)
|
|
I $D(^TMP("PRCVIT",$J,PRCVIN,1)) D
|
|
. S PRCVFLD=$$CONV^PRCVUTSC(^TMP("PRCVIT",$J,PRCVIN,1,1),"C",HLFS_HLECH)
|
|
. S HLA("HLS",PRCVN,PRCVN1)=PRCVFLD
|
|
. S PRCVI=1
|
|
. F S PRCVI=$O(^TMP("PRCVIT",$J,PRCVIN,1,PRCVI)) Q:'PRCVI D
|
|
.. S PRCVN1=PRCVN1+1
|
|
.. S HLA("HLS",PRCVN,PRCVN1)=PRCVRS_$$CONV^PRCVUTSC(^TMP("PRCVIT",$J,PRCVIN,1,PRCVI),"C",HLFS_HLECH)
|
|
.. Q
|
|
. Q
|
|
S PRCVSEG=PRCVFS
|
|
; FSC
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND0,U,3)_PRCVFS
|
|
; National Stock Number
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND0,U,5)_PRCVFS
|
|
; National Stock Number Verified Date
|
|
I $P(PRCVND3,U,6)'="" S PRCVSEG=PRCVSEG_$$FMTHL7^XLFDT($P(PRCVND3,U,6))
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
; Hazardous Material
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND0,U,14)_PRCVFS
|
|
S PRCVFLD=""
|
|
; Last Vendor Ordered
|
|
I $P(PRCVND0,U,4)'="" S PRCVFLD=$P(PRCVND0,U,4)_PRCVCS_$P(^PRC(440,$P(PRCVND0,U,4),0),U)_PRCVCS_PRCVSTN
|
|
S PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
|
|
; Mandatory Source
|
|
S PRCVFLD=""
|
|
I $P(PRCVND0,U,7)'="" S PRCVFLD=$P(PRCVND0,U,7)_PRCVCS_$P(^PRC(440,$P(PRCVND0,U,7),0),U)_PRCVCS_PRCVSTN
|
|
S PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
|
|
; Budget Object Code
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND0,U,9)_PRCVFS
|
|
; Created/Inactivated By
|
|
S PRCVDUZ=$P(PRCVND0,U,10)
|
|
S PRCVDT1=""
|
|
I PRCVDUZ]"" D
|
|
. I $P(PRCVND0,U,8)]"" S PRCVDT1=$$FMTHL7^XLFDT($P(PRCVND0,U,8))
|
|
. S PRCVNM("FILE")=200,PRCVNM("FIELD")=.01,PRCVNM("IENS")=PRCVDUZ_","
|
|
. S PRCVFLD=$P($$HLNAME^XLFNAME(.PRCVNM," ","^"),"^",1,2)
|
|
. S PRCVFLD=PRCVDUZ_PRCVCS_$P(PRCVFLD,"^")_PRCVCS_$P(PRCVFLD,"^",2)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVDT1
|
|
. I ($P(PRCVND3,U)]"")!($P(PRCVND3,U,3)]"") D
|
|
.. S PRCVDUZ=$P(PRCVND3,U,3)
|
|
.. S PRCVDT1=""
|
|
.. S PRCVSEG=PRCVSEG_PRCVFLD_PRCVRS
|
|
.. I $P(PRCVND3,U,2)]"" S PRCVDT1=$$FMTHL7^XLFDT($P(PRCVND3,U,2))
|
|
.. S PRCVNM("FILE")=200,PRCVNM("FIELD")=.01,PRCVNM("IENS")=PRCVDUZ_","
|
|
.. S PRCVFLD=$P($$HLNAME^XLFNAME(.PRCVNM," ","^"),"^",1,2)
|
|
.. S PRCVFLD=PRCVDUZ_PRCVCS_$P(PRCVFLD,"^")_PRCVCS_$P(PRCVFLD,"^",2)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVDT1
|
|
.. Q
|
|
. S PRCVSEG=PRCVSEG_PRCVFLD
|
|
. Q
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
; Replacement Item
|
|
I $P(PRCVND3,U,4)>0 D
|
|
. S PRCVFLD=$$CONV^PRCVUTSC($P(^PRC(441,$P(PRCVND3,U,4),0),U,2),"C",HLFS_HLECH)
|
|
. S PRCVFLD=$P(PRCVND3,U,4)_PRCVCS_PRCVFLD_PRCVCS_PRCVSTN
|
|
. S PRCVSEG=PRCVSEG_PRCVFLD
|
|
. Q
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
; MFG Part No.
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND3,U,5)_PRCVFS
|
|
; Food Group
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND3,U,7)_PRCVFS
|
|
; Stock Keeping Unit - SKU (required field in DynaMed)
|
|
S PRCVFLD=$P(PRCVND3,U,8)
|
|
; If no SKU in IFCAP, set default to "EACH"
|
|
I PRCVFLD']"" S PRCVFLD=$O(^PRCD(420.5,"C","EACH",0))
|
|
S PRCVFLD=$P(^PRCD(420.5,PRCVFLD,0),U)_PRCVCS_$P(^PRCD(420.5,PRCVFLD,0),U,2)_PRCVCS_"IFCAP"
|
|
S PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
|
|
; Drug Type Code
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND3,U,9)_PRCVFS
|
|
; Reusable Item Indicator
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND0,U,11)_PRCVFS
|
|
; Standard Industrial Classification Code - SIC Code
|
|
S PRCVSEG=PRCVSEG_$P(PRCVND3,U,10)_PRCVFS
|
|
;
|
|
S PRCVN1=PRCVN1+1
|
|
S HLA("HLS",PRCVN,PRCVN1)=PRCVSEG
|
|
; Pre_NIF_Long Description (Word Processing field)
|
|
S PRCVFLD=""
|
|
I $D(^TMP("PRCVIT",$J,PRCVIN,6)) D
|
|
. S PRCVN1=PRCVN1+1
|
|
. S PRCVFLD=$$CONV^PRCVUTSC(^TMP("PRCVIT",$J,PRCVIN,6,1),"C",HLFS_HLECH)
|
|
. S HLA("HLS",PRCVN,PRCVN1)=PRCVFLD
|
|
. S PRCVI=1
|
|
. F S PRCVI=$O(^TMP("PRCVIT",$J,PRCVIN,6,PRCVI)) Q:'PRCVI D
|
|
.. S PRCVN1=PRCVN1+1
|
|
.. S HLA("HLS",PRCVN,PRCVN1)=PRCVRS_$$CONV^PRCVUTSC(^TMP("PRCVIT",$J,PRCVIN,6,PRCVI),"C",HLFS_HLECH)
|
|
.. Q
|
|
. Q
|
|
S HLA("HLS",PRCVN,PRCVN1)=HLA("HLS",PRCVN,PRCVN1)_PRCVFS
|
|
; NIF Item Number
|
|
; Last part of ZIT Segment
|
|
I $P($G(PRCVND0),U,13) D
|
|
. S PRCVN1=PRCVN1+1
|
|
. S HLA("HLS",PRCVN,PRCVN1)=$P(PRCVND0,U,13)
|
|
. Q
|
|
;
|
|
; ZCP segments
|
|
;
|
|
S PRCVSEG=""
|
|
S PRCVI=0
|
|
F S PRCVI=$O(^TMP("PRCVIT",$J,PRCVIN,4,PRCVI)) Q:'PRCVI D
|
|
. S PRCVSEG=^TMP("PRCVIT",$J,PRCVIN,4,PRCVI)
|
|
. S PRCVSEG=$P(PRCVSEG,U)_PRCVFS_$P(PRCVSEG,U,2)_PRCVFS_$P(PRCVSEG,U,3)
|
|
. I $P(PRCVSEG,"|",3)]"" S PRCVSEG=PRCVSEG_PRCVCS_$P(^PRC(440,$P(PRCVSEG,"|",3),0),U)_PRCVCS_PRCVSTN
|
|
. S PRCVN=PRCVN+1
|
|
. S HLA("HLS",PRCVN)="ZCP"_PRCVFS_PRCVSEG
|
|
. Q
|
|
I $D(^TMP("PRCVIT",$J,PRCVIN,2)) D
|
|
. S PRCVI=0
|
|
. F S PRCVI=$O(^TMP("PRCVIT",$J,PRCVIN,2,PRCVI)) Q:'PRCVI D ZVI
|
|
. Q
|
|
;
|
|
Q
|
|
;
|
|
; Clean trailing BAR "|" - not used for now
|
|
BAR ;
|
|
; N PRCVL,PRCVL1
|
|
; S PRCVI=2
|
|
; F S PRCVI=$O(HLA("HLS",PRCVI)) Q:'PRCVI D
|
|
; . S PRCVL=$L(HLA("HLS",PRCVI))
|
|
; . F PRCVL1=PRCVL:-1 Q:PRCVL1<0 D
|
|
; .. I $E(HLA("HLS",PRCVI),PRCVL1)'="|" S PRCVL1=0 Q
|
|
; .. S HLA("HLS",PRCVI)=$E(HLA("HLS",PRCVI),1,PRCVL1-1)
|
|
; .. Q
|
|
; . Q
|
|
Q
|
|
;
|
|
ZVI ; ZVI segment
|
|
;
|
|
; Vendor
|
|
S PRCVSEG=""
|
|
S PRCVND2=^TMP("PRCVIT",$J,PRCVIN,2,PRCVI)
|
|
S PRCVSEG="ZVI"_PRCVFS_$P(PRCVND2,U)_PRCVCS_$P(^PRC(440,$P(PRCVND2,U),0),U)_PRCVCS_PRCVSTN
|
|
; Vendor Stock Number
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,4)
|
|
; National Drug Code
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,5)
|
|
; Contract
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
I $P(PRCVND2,U,3)]"" D
|
|
. S PRCVCON=$G(^PRC(440,$P(PRCVND2,U),4,$P(PRCVND2,U,3),0))
|
|
. S PRCVSEG=PRCVSEG_$P(PRCVCON,U)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_$$FMTHL7^XLFDT($P(PRCVCON,U,2))
|
|
. Q
|
|
; Unit Cost
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,2)_PRCVCS_"USD"
|
|
; Date of Unit Price
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
I $P(PRCVND2,U,6)]"" S PRCVSEG=PRCVSEG_$$FMTHL7^XLFDT($P(PRCVND2,U,6))
|
|
; Unit of Purchase - required field in DynaMed
|
|
S PRCVSEG=PRCVSEG_PRCVFS
|
|
; If no Unit of Purchase in IFCAP, set default to "EACH"
|
|
I $P(PRCVND2,U,7)="" S $P(PRCVND2,U,7)=$O(^PRCD(420.5,"C","EACH",0))
|
|
S PRCVUP=^PRCD(420.5,$P(PRCVND2,U,7),0)
|
|
S PRCVSEG=PRCVSEG_$P(PRCVUP,U)_PRCVCS_$P(PRCVUP,U,2)_PRCVCS_"IFCAP"
|
|
; Packaging Multiple
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,8)
|
|
; Unit of Conversion Factor
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,10)
|
|
; Required Order Multiple
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,11)
|
|
; Minimum Order Quantity
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,12)
|
|
; Maximum Order Quantity
|
|
S PRCVSEG=PRCVSEG_PRCVFS_$P(PRCVND2,U,9)
|
|
;
|
|
S PRCVN=PRCVN+1
|
|
S HLA("HLS",PRCVN)=PRCVSEG
|
|
Q
|
|
;
|
|
;
|
|
MFKPROC ;Process MFK^M01 response message
|
|
;
|
|
;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
|
|
N VAL
|
|
X HLNEXT
|
|
X HLNEXT
|
|
S VAL=$$FLD^HLCSUTL(HLNODE,2)
|
|
I VAL'="AA" D ERROR
|
|
D FIN
|
|
Q
|
|
;
|
|
ERROR ;Process ERR Segments
|
|
N N,PRCVERM,PRCVIT
|
|
S PRCVERC=0 F N=1:1 X HLNEXT Q:HLQUIT'>0 D
|
|
. S VAL=$$FLD^HLCSUTL(HLNODE,1)
|
|
. I VAL="MFA" S PRCVIT=$P($$FLD^HLCSUTL(HLNODE,6),U)
|
|
. I VAL="ERR" D
|
|
.. S PRCVERC=PRCVERC+1
|
|
.. S PRCVERM=$$FLD^HLCSUTL(HLNODE,6)
|
|
.. S PRCVERR(PRCVERC)="Unable to update item in DynaMed during an ITEM Update to the Inventory System the following error(s) occurred:"
|
|
.. S PRCVERC=PRCVERC+1
|
|
.. S PRCVERR(PRCVERC)=$P(PRCVERM,U,2)
|
|
.. Q
|
|
. Q
|
|
;
|
|
D CLIFP
|
|
Q
|
|
;
|
|
CLIFP ;Call partner app w/ mail message for users on error
|
|
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
|
|
S XMSUB="Item Number: "_PRCVIT_" - Inventory System ITEM Update Errors "_$$HTE^XLFDT($H)
|
|
S XMDUZ="IFCAP/COTS Inventory Interface"
|
|
S XMTEXT="PRCVERR("
|
|
S XMY("G.PRCV Item Vendor Edits")=""
|
|
D ^XMD
|
|
Q
|
|
;
|
|
FIN ;Clean up variables
|
|
K ^TMP("PRCVIT",$J)
|
|
K PRCVI,PRCVN,PRCVDP,PRCVPRO,HL,HLA,PRCVCS,PRCVRS,PRCVFS,PRCVDT,%
|
|
K VAL,PRCVERC,PRCVERM,PRCVERR
|
|
;
|
|
Q
|