VIAAIMUP ;ALB/CR - RTLS Send Item Master Update to WaveMark ;4/20/16 10:07 pm
;;1.0;RTLS;**4**;April 22, 2013;Build 21
;
Q
; Access to file #441 covered by IA #5921
; Access to file #440 covered by IA #5922
; Access to file #445 covered by IA #5923
; Access to file #445.6 covered by IA #6067
; Access to file #420.5 covered by IA #6068
;
;-- input required:
; item master # (IEN) - required
; inventory point name - required
;
;-- output: sent back in ^TMP("ITEMUPDATE",$J) via retsta
; item master number, #441
; vendor name, vendor ien, file #440
; item short description from #445 (preferred) or #441
; vendor stock #
; inventory point name
; unit of issue, from sub-file #445.01
; average cost, sub-file #445.01, field # 4.8
; group category code
; due-in
;-- for a failure a 3-digit code and a short message is returned
; to the calling application using the following format:
; "-###^"_failure_message
;
ITEM(RETSTA,IPNAME,ITEM) ; RPC call starts here
; RPC [VIAA GET ITEM MASTER UPDATE]
;
N DATA,DATAV,I,ITEMDESC,IPIEN,IPIEN1,AVGCOST,UNISSUE,VENDSTCK,VENDCNT,IT445DES,IT441DES,VENDPTR,VENDNAME,GCCODE,ITDUEIN
N VIAA
S VIAA="VIAAIMUP"
K ^TMP(VIAA)
I $G(IPNAME)="" S ^TMP(VIAA,$J,0)="-400^Inventory Point name cannot be null" D EXIT Q
I '$O(^PRCP(445,"B",IPNAME,"")) S ^TMP(VIAA,$J,0)="-404^"_IPNAME_" is not a legal Inventory Point" D EXIT Q
S IPIEN=$O(^PRCP(445,"B",IPNAME,""))
;
I $G(ITEM)="" S ^TMP(VIAA,$J,0)="-400^Item Master # cannot be null" D EXIT Q
I +ITEM=0 S ^TMP(VIAA,$J,0)="-400^Item Master # cannot be zero" D EXIT Q
I '$D(^PRC(441,"B",ITEM)) S ^TMP(VIAA,$J,0)="-404^Item Master # "_ITEM_" not found in File #441" D EXIT Q
I '$D(^PRCP(445,IPIEN,1,ITEM,0)) S ^TMP(VIAA,$J,0)="-404^Item Master # "_ITEM_" not found in Inventory Point "_IPNAME D EXIT Q
;
; -- get the item details WaveMark needs. IEN of IP below can be for
; a primary or a secondary IP
S IPIEN=$O(^PRCP(445,"B",IPNAME,"")) ; IEN of IP we start with
D T1(ITEM)
I $G(DATAV)="" S DATAV=""
;
; We need to refresh the IP info in case we have a secondary IP
S IPIEN1=$O(^PRCP(445,"B",IPNAME,""))
S IPTYPE=$P(^PRCP(445,IPIEN1,0),U,3) ; primary or secondary IP type
I IPTYPE="S" S IPIEN=IPIEN1
;
S VENDCNT=$P($G(^PRC(441,ITEM,2,0)),U,4) ; vendors in a multiple
F I=1:1:VENDCNT D
. S VENDPTR=+$O(^PRC(441,ITEM,2,"B",I)) I 'VENDPTR Q
. S VENDNAME=$P($G(^PRC(440,VENDPTR,0)),U,1)
. I '$D(VENDNAME) S VENDNAME=""
. S UNISSUE=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",4,"E")
. I '$D(UNISSUE)="" S UNISSUE=""
. S AVGCOST=$P($G(^PRCP(445,IPIEN,1,ITEM,0)),U,22)
. I '$D(AVGCOST) S AVGCOST=""
. S IT445DES=$P($G(^PRCP(445,IPIEN,1,ITEM,6)),U,1)
. S IT441DES=$P($G(^PRC(441,ITEM,0)),U,2)
. S ITEMDESC=$S(IT445DES'="":IT445DES,1:IT441DES)
. S GCCODE=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",.5,"E") ; gr cat code
. S ITDUEIN=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",8.1,"E") ; due-in
. S DATA=ITEMDESC_U_ITEM_U_DATAV_U_IPNAME_U_UNISSUE_U_AVGCOST_U_GCCODE_U_ITDUEIN
. S ^TMP(VIAA,$J,0)=DATA
;
I '$D(^TMP(VIAA,$J)) S ^TMP(VIAA,$J,0)="-404^No data found for Inventory Point "_IPNAME
EXIT S RETSTA=$NA(^TMP(VIAA,$J))
Q
;
T1(ITEM) ; vendor detail: get mandatory and procurement sources
N IPTYPE,MVIEN,MVNAME,MVROOT,PRVEN,PRNAME,ROOT,VENDCNT,VSTCKMAN
N FLDEL,RECDEL,PRIMIP
S RECDEL="|" ; record delimiter within a multiple
S FLDEL="~" ; field delimiter within a record
; see if the inventory point (IP) is a secondary attached to a primary IP
; and get the vendor info from the parent primary IP. Otherwise, we have
; a stand-alone primary IP.
S IPIEN1=$O(^PRCP(445,"B",IPNAME,"")) ; prepare to swap child and parent IP
S IPTYPE=$P(^PRCP(445,IPIEN1,0),U,3) ; primary or secondary IP type
I IPTYPE="S" S PRIMIP=$P($P(^PRCP(445,IPIEN1,1,ITEM,0),U,12),";",1)
I $G(PRIMIP)'="" S IPIEN=PRIMIP ; primary IP Parent IEN
S MVROOT=$P($G(^PRCP(445,IPIEN,1,ITEM,0)),U,12) ; mandatory vendor
;
S MVIEN=$P($G(MVROOT),";",1) ; we need the IEN for the vendor
I MVIEN="" S MVNAME=""
I +MVIEN>0 S MVNAME=$P(^PRC(440,MVIEN,0),U,1) ; mandatory vendor name
S VSTCKMAN=$$GET1^DIQ(441.01,MVIEN_","_ITEM_",",3,"E") ; vendor stock # for mandatory vendor
S DATAV=""
;
F VENDCNT=0:0 S VENDCNT=$O(^PRCP(445,IPIEN,1,ITEM,5,VENDCNT)) Q:'VENDCNT D
. S PRVEN=$P($G(^PRCP(445,IPIEN,1,ITEM,5,VENDCNT,0)),";",1)
. Q:PRVEN=""
. S PRNAME=$P($G(^PRC(440,PRVEN,0)),U,1) ; procurement vendor name
. ; get procurement source stock #
. S VENDSTCK=$$GET1^DIQ(441.01,PRVEN_","_ITEM_",",3,"E") ;
. Q:PRNAME=""
. I MVIEN=PRVEN Q ; don't list twice a vendor as proc and mandatory
. S DATAV=DATAV_RECDEL_PRNAME_FLDEL_PRVEN_FLDEL_VENDSTCK
S MVIEN=MVIEN_FLDEL_VSTCKMAN ; attach vendor stock #
S DATAV=MVNAME_FLDEL_MVIEN_DATAV ; mandatory & proc. vendor names
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAAIMUP 4910 printed Apr 09, 2024@21:35:49 Page 2
VIAAIMUP ;ALB/CR - RTLS Send Item Master Update to WaveMark ;4/20/16 10:07 pm
+1 ;;1.0;RTLS;**4**;April 22, 2013;Build 21
+2 ;
+3 QUIT
+4 ; Access to file #441 covered by IA #5921
+5 ; Access to file #440 covered by IA #5922
+6 ; Access to file #445 covered by IA #5923
+7 ; Access to file #445.6 covered by IA #6067
+8 ; Access to file #420.5 covered by IA #6068
+9 ;
+10 ;-- input required:
+11 ; item master # (IEN) - required
+12 ; inventory point name - required
+13 ;
+14 ;-- output: sent back in ^TMP("ITEMUPDATE",$J) via retsta
+15 ; item master number, #441
+16 ; vendor name, vendor ien, file #440
+17 ; item short description from #445 (preferred) or #441
+18 ; vendor stock #
+19 ; inventory point name
+20 ; unit of issue, from sub-file #445.01
+21 ; average cost, sub-file #445.01, field # 4.8
+22 ; group category code
+23 ; due-in
+24 ;-- for a failure a 3-digit code and a short message is returned
+25 ; to the calling application using the following format:
+26 ; "-###^"_failure_message
+27 ;
ITEM(RETSTA,IPNAME,ITEM) ; RPC call starts here
+1 ; RPC [VIAA GET ITEM MASTER UPDATE]
+2 ;
+3 NEW DATA,DATAV,I,ITEMDESC,IPIEN,IPIEN1,AVGCOST,UNISSUE,VENDSTCK,VENDCNT,IT445DES,IT441DES,VENDPTR,VENDNAME,GCCODE,ITDUEIN
+4 NEW VIAA
+5 SET VIAA="VIAAIMUP"
+6 KILL ^TMP(VIAA)
+7 IF $GET(IPNAME)=""
SET ^TMP(VIAA,$JOB,0)="-400^Inventory Point name cannot be null"
DO EXIT
QUIT
+8 IF '$ORDER(^PRCP(445,"B",IPNAME,""))
SET ^TMP(VIAA,$JOB,0)="-404^"_IPNAME_" is not a legal Inventory Point"
DO EXIT
QUIT
+9 SET IPIEN=$ORDER(^PRCP(445,"B",IPNAME,""))
+10 ;
+11 IF $GET(ITEM)=""
SET ^TMP(VIAA,$JOB,0)="-400^Item Master # cannot be null"
DO EXIT
QUIT
+12 IF +ITEM=0
SET ^TMP(VIAA,$JOB,0)="-400^Item Master # cannot be zero"
DO EXIT
QUIT
+13 IF '$DATA(^PRC(441,"B",ITEM))
SET ^TMP(VIAA,$JOB,0)="-404^Item Master # "_ITEM_" not found in File #441"
DO EXIT
QUIT
+14 IF '$DATA(^PRCP(445,IPIEN,1,ITEM,0))
SET ^TMP(VIAA,$JOB,0)="-404^Item Master # "_ITEM_" not found in Inventory Point "_IPNAME
DO EXIT
QUIT
+15 ;
+16 ; -- get the item details WaveMark needs. IEN of IP below can be for
+17 ; a primary or a secondary IP
+18 ; IEN of IP we start with
SET IPIEN=$ORDER(^PRCP(445,"B",IPNAME,""))
+19 DO T1(ITEM)
+20 IF $GET(DATAV)=""
SET DATAV=""
+21 ;
+22 ; We need to refresh the IP info in case we have a secondary IP
+23 SET IPIEN1=$ORDER(^PRCP(445,"B",IPNAME,""))
+24 ; primary or secondary IP type
SET IPTYPE=$PIECE(^PRCP(445,IPIEN1,0),U,3)
+25 IF IPTYPE="S"
SET IPIEN=IPIEN1
+26 ;
+27 ; vendors in a multiple
SET VENDCNT=$PIECE($GET(^PRC(441,ITEM,2,0)),U,4)
+28 FOR I=1:1:VENDCNT
Begin DoDot:1
+29 SET VENDPTR=+$ORDER(^PRC(441,ITEM,2,"B",I))
IF 'VENDPTR
QUIT
+30 SET VENDNAME=$PIECE($GET(^PRC(440,VENDPTR,0)),U,1)
+31 IF '$DATA(VENDNAME)
SET VENDNAME=""
+32 SET UNISSUE=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",4,"E")
+33 IF '$DATA(UNISSUE)=""
SET UNISSUE=""
+34 SET AVGCOST=$PIECE($GET(^PRCP(445,IPIEN,1,ITEM,0)),U,22)
+35 IF '$DATA(AVGCOST)
SET AVGCOST=""
+36 SET IT445DES=$PIECE($GET(^PRCP(445,IPIEN,1,ITEM,6)),U,1)
+37 SET IT441DES=$PIECE($GET(^PRC(441,ITEM,0)),U,2)
+38 SET ITEMDESC=$SELECT(IT445DES'="":IT445DES,1:IT441DES)
+39 ; gr cat code
SET GCCODE=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",.5,"E")
+40 ; due-in
SET ITDUEIN=$$GET1^DIQ(445.01,ITEM_","_IPIEN_",",8.1,"E")
+41 SET DATA=ITEMDESC_U_ITEM_U_DATAV_U_IPNAME_U_UNISSUE_U_AVGCOST_U_GCCODE_U_ITDUEIN
+42 SET ^TMP(VIAA,$JOB,0)=DATA
End DoDot:1
+43 ;
+44 IF '$DATA(^TMP(VIAA,$JOB))
SET ^TMP(VIAA,$JOB,0)="-404^No data found for Inventory Point "_IPNAME
EXIT SET RETSTA=$NAME(^TMP(VIAA,$JOB))
+1 QUIT
+2 ;
T1(ITEM) ; vendor detail: get mandatory and procurement sources
+1 NEW IPTYPE,MVIEN,MVNAME,MVROOT,PRVEN,PRNAME,ROOT,VENDCNT,VSTCKMAN
+2 NEW FLDEL,RECDEL,PRIMIP
+3 ; record delimiter within a multiple
SET RECDEL="|"
+4 ; field delimiter within a record
SET FLDEL="~"
+5 ; see if the inventory point (IP) is a secondary attached to a primary IP
+6 ; and get the vendor info from the parent primary IP. Otherwise, we have
+7 ; a stand-alone primary IP.
+8 ; prepare to swap child and parent IP
SET IPIEN1=$ORDER(^PRCP(445,"B",IPNAME,""))
+9 ; primary or secondary IP type
SET IPTYPE=$PIECE(^PRCP(445,IPIEN1,0),U,3)
+10 IF IPTYPE="S"
SET PRIMIP=$PIECE($PIECE(^PRCP(445,IPIEN1,1,ITEM,0),U,12),";",1)
+11 ; primary IP Parent IEN
IF $GET(PRIMIP)'=""
SET IPIEN=PRIMIP
+12 ; mandatory vendor
SET MVROOT=$PIECE($GET(^PRCP(445,IPIEN,1,ITEM,0)),U,12)
+13 ;
+14 ; we need the IEN for the vendor
SET MVIEN=$PIECE($GET(MVROOT),";",1)
+15 IF MVIEN=""
SET MVNAME=""
+16 ; mandatory vendor name
IF +MVIEN>0
SET MVNAME=$PIECE(^PRC(440,MVIEN,0),U,1)
+17 ; vendor stock # for mandatory vendor
SET VSTCKMAN=$$GET1^DIQ(441.01,MVIEN_","_ITEM_",",3,"E")
+18 SET DATAV=""
+19 ;
+20 FOR VENDCNT=0:0
SET VENDCNT=$ORDER(^PRCP(445,IPIEN,1,ITEM,5,VENDCNT))
if 'VENDCNT
QUIT
Begin DoDot:1
+21 SET PRVEN=$PIECE($GET(^PRCP(445,IPIEN,1,ITEM,5,VENDCNT,0)),";",1)
+22 if PRVEN=""
QUIT
+23 ; procurement vendor name
SET PRNAME=$PIECE($GET(^PRC(440,PRVEN,0)),U,1)
+24 ; get procurement source stock #
+25 ;
SET VENDSTCK=$$GET1^DIQ(441.01,PRVEN_","_ITEM_",",3,"E")
+26 if PRNAME=""
QUIT
+27 ; don't list twice a vendor as proc and mandatory
IF MVIEN=PRVEN
QUIT
+28 SET DATAV=DATAV_RECDEL_PRNAME_FLDEL_PRVEN_FLDEL_VENDSTCK
End DoDot:1
+29 ; attach vendor stock #
SET MVIEN=MVIEN_FLDEL_VSTCKMAN
+30 ; mandatory & proc. vendor names
SET DATAV=MVNAME_FLDEL_MVIEN_DATAV
+31 QUIT
