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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVIMF 9421 printed Dec 13, 2024@02:20:03 Page 2
PRCVIMF ;WOIFO/DST - DynaMed ITEM update HL7 messaging interface; 03/07/05
+1 ;;5.1;IFCAP;**81**;Oct 20,2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN(PRCVIN) ;Entry point for API Call
+1 ;
+2 NEW PRCVSEG,PRCVFLD,PRCVFS,PRCVCS,PRCVRS,PRCVI,PRCVN,PRCVCON
+3 NEW PRCVDT1,PRCVDUZ,PRCVND0,PRCVND2,PRCVND3,PRCVSTN,PRCVUP,PRCVERR
+4 NEW PRCVDP,PRCVPRO
+5 KILL HLA
+6 ;
+7 IF $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
QUIT
+8 IF $DATA(PRCVIN)=0
QUIT
+9 SET PRCVN=0
+10 DO HDRBLD
+11 IF $GET(PRCVERR)
DO FIN
QUIT
+12 DO MSGBLD
+13 ;
+14 SET PRCVDP=""
+15 DO GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
+16 IF +$PIECE(PRCVDP,U,2)
SET PRCVERR(1)="Error generating message through VistA HL7 package for ITEM Update with ITEM # "_PRCVIN
DO CLIFP
+17 DO FIN
+18 ;
+19 QUIT
+20 ;
HDRBLD ;Generate message header, MFI Segment
+1 ;
+2 KILL HL
SET PRCVPRO="PRCV_IFCAP_05_EV_ITEM_UPD"
+3 DO INIT^HLFNC2(PRCVPRO,.HL)
+4 IF $GET(HL)
SET PRCVERR(1)="Error generating message through VistA HL7 package for ITEM Update involving ITEM # "_PRCVIN
DO CLIFP
QUIT
+5 SET PRCVCS=$EXTRACT(HL("ECH"))
SET PRCVRS=$EXTRACT(HL("ECH"),2)
SET PRCVFS=HL("FS")
+6 ;
+7 ;PRCVDT Transaction Date/Time w/offset
+8 DO NOW^%DTC
+9 SET PRCVDT=$$FMTHL7^XLFDT(%)
+10 ;
+11 ;Build MFI Segment
+12 SET PRCVN=PRCVN+1
+13 SET HLA("HLS",PRCVN)="MFI"_PRCVFS_"OME"_PRCVFS_"441"_PRCVCS_"ITEM MASTER"_PRCVFS_"UPD"_PRCVFS_PRCVDT_PRCVFS_PRCVFS_"AL"
+14 ;
+15 QUIT
+16 ;
MSGBLD ; Build Message Body
+1 ; PRCVFLD - Field
+2 ;
+3 ; ITEM short description
+4 SET PRCVND0=^TMP("PRCVIT",$JOB,PRCVIN,0)
+5 SET PRCVFLD=$$CONV^PRCVUTSC($PIECE(PRCVND0,U,2),"C",HLFS_HLECH)
+6 ; Station Number
+7 SET PRCVSTN=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+8 ;
+9 ; MFE segment
+10 ;
+11 SET PRCVN=PRCVN+1
+12 SET HLA("HLS",PRCVN)="MFE"_PRCVFS_"MUP"_PRCVFS_PRCVIN_PRCVFS_PRCVDT_PRCVFS_PRCVIN_PRCVCS_PRCVFLD_PRCVCS_PRCVSTN_PRCVFS_"CE"
+13 ;
+14 ; ZIT segment
+15 ;
+16 NEW PRCVN1,PRCVNM
+17 SET PRCVN=PRCVN+1
+18 SET PRCVN1=1
+19 SET PRCVND3=$GET(^TMP("PRCVIT",$JOB,PRCVIN,3))
+20 ; Case/Cart Tray/instrument kit
+21 SET HLA("HLS",PRCVN)="ZIT"_PRCVFS_PRCVSTN_PRCVFS_$PIECE(PRCVND0,U,6)_PRCVFS
+22 ; Description (Word Processing field)
+23 IF $DATA(^TMP("PRCVIT",$JOB,PRCVIN,1))
Begin DoDot:1
+24 SET PRCVFLD=$$CONV^PRCVUTSC(^TMP("PRCVIT",$JOB,PRCVIN,1,1),"C",HLFS_HLECH)
+25 SET HLA("HLS",PRCVN,PRCVN1)=PRCVFLD
+26 SET PRCVI=1
+27 FOR
SET PRCVI=$ORDER(^TMP("PRCVIT",$JOB,PRCVIN,1,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:2
+28 SET PRCVN1=PRCVN1+1
+29 SET HLA("HLS",PRCVN,PRCVN1)=PRCVRS_$$CONV^PRCVUTSC(^TMP("PRCVIT",$JOB,PRCVIN,1,PRCVI),"C",HLFS_HLECH)
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 SET PRCVSEG=PRCVFS
+33 ; FSC
+34 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND0,U,3)_PRCVFS
+35 ; National Stock Number
+36 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND0,U,5)_PRCVFS
+37 ; National Stock Number Verified Date
+38 IF $PIECE(PRCVND3,U,6)'=""
SET PRCVSEG=PRCVSEG_$$FMTHL7^XLFDT($PIECE(PRCVND3,U,6))
+39 SET PRCVSEG=PRCVSEG_PRCVFS
+40 ; Hazardous Material
+41 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND0,U,14)_PRCVFS
+42 SET PRCVFLD=""
+43 ; Last Vendor Ordered
+44 IF $PIECE(PRCVND0,U,4)'=""
SET PRCVFLD=$PIECE(PRCVND0,U,4)_PRCVCS_$PIECE(^PRC(440,$PIECE(PRCVND0,U,4),0),U)_PRCVCS_PRCVSTN
+45 SET PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
+46 ; Mandatory Source
+47 SET PRCVFLD=""
+48 IF $PIECE(PRCVND0,U,7)'=""
SET PRCVFLD=$PIECE(PRCVND0,U,7)_PRCVCS_$PIECE(^PRC(440,$PIECE(PRCVND0,U,7),0),U)_PRCVCS_PRCVSTN
+49 SET PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
+50 ; Budget Object Code
+51 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND0,U,9)_PRCVFS
+52 ; Created/Inactivated By
+53 SET PRCVDUZ=$PIECE(PRCVND0,U,10)
+54 SET PRCVDT1=""
+55 IF PRCVDUZ]""
Begin DoDot:1
+56 IF $PIECE(PRCVND0,U,8)]""
SET PRCVDT1=$$FMTHL7^XLFDT($PIECE(PRCVND0,U,8))
+57 SET PRCVNM("FILE")=200
SET PRCVNM("FIELD")=.01
SET PRCVNM("IENS")=PRCVDUZ_","
+58 SET PRCVFLD=$PIECE($$HLNAME^XLFNAME(.PRCVNM," ","^"),"^",1,2)
+59 SET PRCVFLD=PRCVDUZ_PRCVCS_$PIECE(PRCVFLD,"^")_PRCVCS_$PIECE(PRCVFLD,"^",2)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVDT1
+60 IF ($PIECE(PRCVND3,U)]"")!($PIECE(PRCVND3,U,3)]"")
Begin DoDot:2
+61 SET PRCVDUZ=$PIECE(PRCVND3,U,3)
+62 SET PRCVDT1=""
+63 SET PRCVSEG=PRCVSEG_PRCVFLD_PRCVRS
+64 IF $PIECE(PRCVND3,U,2)]""
SET PRCVDT1=$$FMTHL7^XLFDT($PIECE(PRCVND3,U,2))
+65 SET PRCVNM("FILE")=200
SET PRCVNM("FIELD")=.01
SET PRCVNM("IENS")=PRCVDUZ_","
+66 SET PRCVFLD=$PIECE($$HLNAME^XLFNAME(.PRCVNM," ","^"),"^",1,2)
+67 SET PRCVFLD=PRCVDUZ_PRCVCS_$PIECE(PRCVFLD,"^")_PRCVCS_$PIECE(PRCVFLD,"^",2)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTN_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVDT1
+68 QUIT
End DoDot:2
+69 SET PRCVSEG=PRCVSEG_PRCVFLD
+70 QUIT
End DoDot:1
+71 SET PRCVSEG=PRCVSEG_PRCVFS
+72 ; Replacement Item
+73 IF $PIECE(PRCVND3,U,4)>0
Begin DoDot:1
+74 SET PRCVFLD=$$CONV^PRCVUTSC($PIECE(^PRC(441,$PIECE(PRCVND3,U,4),0),U,2),"C",HLFS_HLECH)
+75 SET PRCVFLD=$PIECE(PRCVND3,U,4)_PRCVCS_PRCVFLD_PRCVCS_PRCVSTN
+76 SET PRCVSEG=PRCVSEG_PRCVFLD
+77 QUIT
End DoDot:1
+78 SET PRCVSEG=PRCVSEG_PRCVFS
+79 ; MFG Part No.
+80 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND3,U,5)_PRCVFS
+81 ; Food Group
+82 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND3,U,7)_PRCVFS
+83 ; Stock Keeping Unit - SKU (required field in DynaMed)
+84 SET PRCVFLD=$PIECE(PRCVND3,U,8)
+85 ; If no SKU in IFCAP, set default to "EACH"
+86 IF PRCVFLD']""
SET PRCVFLD=$ORDER(^PRCD(420.5,"C","EACH",0))
+87 SET PRCVFLD=$PIECE(^PRCD(420.5,PRCVFLD,0),U)_PRCVCS_$PIECE(^PRCD(420.5,PRCVFLD,0),U,2)_PRCVCS_"IFCAP"
+88 SET PRCVSEG=PRCVSEG_PRCVFLD_PRCVFS
+89 ; Drug Type Code
+90 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND3,U,9)_PRCVFS
+91 ; Reusable Item Indicator
+92 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND0,U,11)_PRCVFS
+93 ; Standard Industrial Classification Code - SIC Code
+94 SET PRCVSEG=PRCVSEG_$PIECE(PRCVND3,U,10)_PRCVFS
+95 ;
+96 SET PRCVN1=PRCVN1+1
+97 SET HLA("HLS",PRCVN,PRCVN1)=PRCVSEG
+98 ; Pre_NIF_Long Description (Word Processing field)
+99 SET PRCVFLD=""
+100 IF $DATA(^TMP("PRCVIT",$JOB,PRCVIN,6))
Begin DoDot:1
+101 SET PRCVN1=PRCVN1+1
+102 SET PRCVFLD=$$CONV^PRCVUTSC(^TMP("PRCVIT",$JOB,PRCVIN,6,1),"C",HLFS_HLECH)
+103 SET HLA("HLS",PRCVN,PRCVN1)=PRCVFLD
+104 SET PRCVI=1
+105 FOR
SET PRCVI=$ORDER(^TMP("PRCVIT",$JOB,PRCVIN,6,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:2
+106 SET PRCVN1=PRCVN1+1
+107 SET HLA("HLS",PRCVN,PRCVN1)=PRCVRS_$$CONV^PRCVUTSC(^TMP("PRCVIT",$JOB,PRCVIN,6,PRCVI),"C",HLFS_HLECH)
+108 QUIT
End DoDot:2
+109 QUIT
End DoDot:1
+110 SET HLA("HLS",PRCVN,PRCVN1)=HLA("HLS",PRCVN,PRCVN1)_PRCVFS
+111 ; NIF Item Number
+112 ; Last part of ZIT Segment
+113 IF $PIECE($GET(PRCVND0),U,13)
Begin DoDot:1
+114 SET PRCVN1=PRCVN1+1
+115 SET HLA("HLS",PRCVN,PRCVN1)=$PIECE(PRCVND0,U,13)
+116 QUIT
End DoDot:1
+117 ;
+118 ; ZCP segments
+119 ;
+120 SET PRCVSEG=""
+121 SET PRCVI=0
+122 FOR
SET PRCVI=$ORDER(^TMP("PRCVIT",$JOB,PRCVIN,4,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+123 SET PRCVSEG=^TMP("PRCVIT",$JOB,PRCVIN,4,PRCVI)
+124 SET PRCVSEG=$PIECE(PRCVSEG,U)_PRCVFS_$PIECE(PRCVSEG,U,2)_PRCVFS_$PIECE(PRCVSEG,U,3)
+125 IF $PIECE(PRCVSEG,"|",3)]""
SET PRCVSEG=PRCVSEG_PRCVCS_$PIECE(^PRC(440,$PIECE(PRCVSEG,"|",3),0),U)_PRCVCS_PRCVSTN
+126 SET PRCVN=PRCVN+1
+127 SET HLA("HLS",PRCVN)="ZCP"_PRCVFS_PRCVSEG
+128 QUIT
End DoDot:1
+129 IF $DATA(^TMP("PRCVIT",$JOB,PRCVIN,2))
Begin DoDot:1
+130 SET PRCVI=0
+131 FOR
SET PRCVI=$ORDER(^TMP("PRCVIT",$JOB,PRCVIN,2,PRCVI))
if 'PRCVI
QUIT
DO ZVI
+132 QUIT
End DoDot:1
+133 ;
+134 QUIT
+135 ;
+136 ; Clean trailing BAR "|" - not used for now
BAR ;
+1 ; N PRCVL,PRCVL1
+2 ; S PRCVI=2
+3 ; F S PRCVI=$O(HLA("HLS",PRCVI)) Q:'PRCVI D
+4 ; . S PRCVL=$L(HLA("HLS",PRCVI))
+5 ; . F PRCVL1=PRCVL:-1 Q:PRCVL1<0 D
+6 ; .. I $E(HLA("HLS",PRCVI),PRCVL1)'="|" S PRCVL1=0 Q
+7 ; .. S HLA("HLS",PRCVI)=$E(HLA("HLS",PRCVI),1,PRCVL1-1)
+8 ; .. Q
+9 ; . Q
+10 QUIT
+11 ;
ZVI ; ZVI segment
+1 ;
+2 ; Vendor
+3 SET PRCVSEG=""
+4 SET PRCVND2=^TMP("PRCVIT",$JOB,PRCVIN,2,PRCVI)
+5 SET PRCVSEG="ZVI"_PRCVFS_$PIECE(PRCVND2,U)_PRCVCS_$PIECE(^PRC(440,$PIECE(PRCVND2,U),0),U)_PRCVCS_PRCVSTN
+6 ; Vendor Stock Number
+7 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,4)
+8 ; National Drug Code
+9 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,5)
+10 ; Contract
+11 SET PRCVSEG=PRCVSEG_PRCVFS
+12 IF $PIECE(PRCVND2,U,3)]""
Begin DoDot:1
+13 SET PRCVCON=$GET(^PRC(440,$PIECE(PRCVND2,U),4,$PIECE(PRCVND2,U,3),0))
+14 SET PRCVSEG=PRCVSEG_$PIECE(PRCVCON,U)_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_$$FMTHL7^XLFDT($PIECE(PRCVCON,U,2))
+15 QUIT
End DoDot:1
+16 ; Unit Cost
+17 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,2)_PRCVCS_"USD"
+18 ; Date of Unit Price
+19 SET PRCVSEG=PRCVSEG_PRCVFS
+20 IF $PIECE(PRCVND2,U,6)]""
SET PRCVSEG=PRCVSEG_$$FMTHL7^XLFDT($PIECE(PRCVND2,U,6))
+21 ; Unit of Purchase - required field in DynaMed
+22 SET PRCVSEG=PRCVSEG_PRCVFS
+23 ; If no Unit of Purchase in IFCAP, set default to "EACH"
+24 IF $PIECE(PRCVND2,U,7)=""
SET $PIECE(PRCVND2,U,7)=$ORDER(^PRCD(420.5,"C","EACH",0))
+25 SET PRCVUP=^PRCD(420.5,$PIECE(PRCVND2,U,7),0)
+26 SET PRCVSEG=PRCVSEG_$PIECE(PRCVUP,U)_PRCVCS_$PIECE(PRCVUP,U,2)_PRCVCS_"IFCAP"
+27 ; Packaging Multiple
+28 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,8)
+29 ; Unit of Conversion Factor
+30 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,10)
+31 ; Required Order Multiple
+32 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,11)
+33 ; Minimum Order Quantity
+34 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,12)
+35 ; Maximum Order Quantity
+36 SET PRCVSEG=PRCVSEG_PRCVFS_$PIECE(PRCVND2,U,9)
+37 ;
+38 SET PRCVN=PRCVN+1
+39 SET HLA("HLS",PRCVN)=PRCVSEG
+40 QUIT
+41 ;
+42 ;
MFKPROC ;Process MFK^M01 response message
+1 ;
+2 ;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
+3 NEW VAL
+4 XECUTE HLNEXT
+5 XECUTE HLNEXT
+6 SET VAL=$$FLD^HLCSUTL(HLNODE,2)
+7 IF VAL'="AA"
DO ERROR
+8 DO FIN
+9 QUIT
+10 ;
ERROR ;Process ERR Segments
+1 NEW N,PRCVERM,PRCVIT
+2 SET PRCVERC=0
FOR N=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+3 SET VAL=$$FLD^HLCSUTL(HLNODE,1)
+4 IF VAL="MFA"
SET PRCVIT=$PIECE($$FLD^HLCSUTL(HLNODE,6),U)
+5 IF VAL="ERR"
Begin DoDot:2
+6 SET PRCVERC=PRCVERC+1
+7 SET PRCVERM=$$FLD^HLCSUTL(HLNODE,6)
+8 SET PRCVERR(PRCVERC)="Unable to update item in DynaMed during an ITEM Update to the Inventory System the following error(s) occurred:"
+9 SET PRCVERC=PRCVERC+1
+10 SET PRCVERR(PRCVERC)=$PIECE(PRCVERM,U,2)
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 ;
+14 DO CLIFP
+15 QUIT
+16 ;
CLIFP ;Call partner app w/ mail message for users on error
+1 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET XMSUB="Item Number: "_PRCVIT_" - Inventory System ITEM Update Errors "_$$HTE^XLFDT($HOROLOG)
+3 SET XMDUZ="IFCAP/COTS Inventory Interface"
+4 SET XMTEXT="PRCVERR("
+5 SET XMY("G.PRCV Item Vendor Edits")=""
+6 DO ^XMD
+7 QUIT
+8 ;
FIN ;Clean up variables
+1 KILL ^TMP("PRCVIT",$JOB)
+2 KILL PRCVI,PRCVN,PRCVDP,PRCVPRO,HL,HLA,PRCVCS,PRCVRS,PRCVFS,PRCVDT,%
+3 KILL VAL,PRCVERC,PRCVERM,PRCVERR
+4 ;
+5 QUIT
