- 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 Jan 18, 2025@03:21:14 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