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