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

PRCVIMF.m

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