PRCV442A ;WOIFO/CC-GET PO VALUES TO SEND TO DYNAMED;1/29/05
V ;;5.1;IFCAP;**81,86**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
ITEM(POIEN,PRCVLINE,PRCVDATA,PRCVERR) ; Get Item data to send to DynaMed
;
; POIEN = the ien of the purchase order
; PRCVLINE = the ien of the line item number in the purchase order
; PRCVDATA = information from the PO level to keep for reference
; 2237 number ^ expected delivery date
; PRCVERR = flag to indicate if the item is not qualified for
; transmission to DynaMed as it has no DM DOC ID or an
; error occurred
;
N PRCV,PRCVDD,PRCVL,PRCVI
S PRCVDD="",PRCVERR=0,PRCVI=PRCVLINE_","_POIEN_","
D GETS^DIQ(442.01,PRCVI,".01;1.5;2;3;3.1;2;5;10;48","IE","PRCVL")
I $D(^TMP("DIERR",$J)) S PRCVERR=3 Q ; item not on file in PO
S $P(PRCV,"^",1)=PRCVL(442.01,PRCVI,48,"I") ; DM Doc ID (#48 N2P15)
I $P(PRCV,"^",1)']"" S PRCVERR=1 Q ; this is not a DM item
S $P(PRCV,"^",2)=PRCVL(442.01,PRCVI,1.5,"I") ; Item IEN (#1.5 N0 P5))
S $P(PRCV,"^",8)=$$GET1^DIQ(441,(PRCVL(442.01,PRCVI,1.5,"I")),51) ; NIF
S $P(PRCV,"^",3)=PRCVL(442.01,PRCVI,.01,"E") ; line item# #.01 n0,p1
S $P(PRCV,"^",6)=PRCVL(442.01,PRCVI,2,"I") ; QTY ORDERED (#2 N0 P 2)
S $P(PRCV,"^",5)=PRCVL(442.01,PRCVI,3,"E") ; UOP (#3 N 0 P 3)
S $P(PRCV,"^",9)=PRCVL(442.01,PRCVI,"3.1","E") ; pkg multiple (#3.1 N0 P12)
S $P(PRCV,"^",7)=PRCVL(442.01,PRCVI,5,"I") ; unit price (#5 N0 P 9)
S $P(PRCV,"^",4)=PRCVL(442.01,PRCVI,10,"E") ; 2237 IEN (#10 N0 P10)
I $P(PRCV,"^",4)']"" S $P(PRCV,"^",4)=$P(PRCVDATA,"^",1)
D DD(POIEN,PRCVL(442.01,PRCVI,.01,"E"),.PRCVDD) ; delivery date
S $P(PRCV,"^",13)=PRCVDD I PRCVDD="" S $P(PRCV,"^",13)=$P(PRCVDATA,"^",2)
S ^TMP("PRCV442A",$J,POIEN,PRCVLINE)=PRCV
;
Q
;
DD(POIEN,PRCVLINE,PRCVDD) ; get the earliest delivery date for the item
;
; POIEN = the ien of the purchase order
; PRCVLINE = the ien of the line item number in the purchase order
; PRCVDD = the purchase order's expected delivery date
;
N PRCVDS,PRCVDZ
S PRCVDZ="",PRCVDS=0
F S PRCVDS=$O(^PRC(442.8,"AC",POIEN,PRCVLINE,PRCVDS)) Q:+PRCVDS'>0!(PRCVDS']"") D
. S PRCVDZ=$P($G(^PRC(442.8,PRCVDS,0)),"^",3) ; get date from delivery schedule for item
. I PRCVDZ<PRCVDD S PRCVDD=PRCVDZ
. I PRCVDD']"" S PRCVDD=PRCVDZ
. Q
Q
;
PO(POIEN,PRCVDATA,PRCVERR) ; get PO information, station, DUZ
;
; POIEN = the ien of the purchase order
; PRCVDATA = information from the PO level to keep for reference
; 2237 number ^ expected delivery date
; PRCVERR = flag to indicate if the order is not a qualified DynaMed
; PO. 1 - indicates MOP is not suitable for a DM order
;
N PRCV,PRCVV,PRCVP,PRCVPO
S PRCVERR=0,PRCVPO=POIEN_","
D GETS^DIQ(442,PRCVPO,".01;.02;.07;5;7;17;62","IE","PRCVP")
I $D(^TMP("DIERR",$J)) S PRCVERR=2 Q ; PO not on file
I PRCVP(442,PRCVPO,.02,"I")'=1,PRCVP(442,PRCVPO,.02,"I")'=25 S PRCVERR=1 Q ; MOP (#.02 - n0,p2)
S $P(PRCV,"^",1)=PRCVP(442,PRCVPO,.01,"E") ; PO# (#.01 n0,p1)
S $P(PRCV,"^",4)=PRCVP(442,PRCVPO,5,"I") ; vendor IEN (#5 n1 p1)
; get FMS vendor ID & alt addr code from file 440, #34# - n3 p4&5
D GETS^DIQ(440,PRCVP(442,PRCVPO,5,"I")_",","34:35","E","PRCVV")
I $D(^TMP("DIERR",$J)) G PO1 ; vendor info not on file
S $P(PRCV,"^",5)=PRCVV(440,PRCVP(442,PRCVPO,5,"I")_",",34,"E") ; FMS vendor ID
S $P(PRCV,"^",6)=PRCVV(440,PRCVP(442,PRCVPO,5,"I")_",",35,"E") ; FMA alt add ind
PO1 S $P(PRCV,"^",7)=PRCVP(442,PRCVPO,17,"I") ; date signed (un-amended POs) n12 p3
S PRCVDATA=PRCVP(442,PRCVPO,62,"E") ; for PC orders MOP=25, 2237 is in #62 N23,P23
I PRCVDATA']"" S PRCVDATA=PRCVP(442,PRCVPO,.07,"E") ; for inv/rec MOP=1, 2237 is in #.07 - n0,p12
S $P(PRCVDATA,"^",2)=PRCVP(442,PRCVPO,7,"I") ; delivery date (#7 n0p10)
;
; get Station Number, DUZ
S $P(PRCV,"^",8)=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
S $P(PRCV,"^",3)=DUZ
;
S ^TMP("PRCV442A",$J,POIEN)=PRCV
Q
;
RR(POIEN,PRCVLINE,PRCVRR,PRCVERR,ACTION) ; get receipt data for item
;
; POIEN = the ien of the purchase order
; PRCVLINE = the ien of the line item number in the purchase order
; PRCVRR = the ien of the receiving report of interest
; PRCVERR = flag to indicate if the order does not qualify for
; transmission to DynaMed or error occurred
; ACTION = flag 1 - approved report ; 2- deleted report
;
N PRCV,PRCVI,PRCVDEL,PRCVR
S PRCVI=PRCVRR_","_PRCVLINE_","_POIEN_","
D GETS^DIQ(442.08,PRCVI,"1;2;3;4","I","PRCVR")
I $D(^TMP("DIERR",$J)) S PRCVERR=4 G RR2 ; RR not on file
S PRCVDEL="" I ACTION=2 S PRCVDEL="-"
S PRCV=$G(^TMP("PRCV442A",$J,POIEN,PRCVLINE))
S $P(PRCV,"^",10)=PRCVDEL_PRCVR(442.08,PRCVI,1,"I") ; qty received (#1, NO P2)
S $P(PRCV,"^",11)=PRCVDEL_PRCVR(442.08,PRCVI,2,"I") ; total item cost (#2 NO P3)
S $P(PRCV,"^",12)=PRCVDEL_PRCVR(442.08,PRCVI,4,"I") ; total discount for item(#4, N0 P5)
S ^TMP("PRCV442A",$J,POIEN,PRCVLINE)=PRCV
RR2 Q
;
UPD(POIEN) ; Update DynaMed of Approved POs with DynaMed items on them
;
; POIEN The IEN of the Purchase Order
;
N PRCVDATA,PRCVERR,PRCVLINE
S PRCVERR=0
K ^TMP("PRCV442A",$J)
D PO(POIEN,.PRCVDATA,.PRCVERR)
I PRCVERR=1 Q ; not a DynaMed order
I PRCVERR>0 S PRCVERR=PRCVERR_"U" G TMPERR Q
S PRCVLINE=0
F S PRCVLINE=$O(^PRC(442,POIEN,2,PRCVLINE)) Q:+PRCVLINE'>0!(PRCVLINE']"") D
. D ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
. I PRCVERR=1 Q
. I PRCVERR>0 S PRCVERR=PRCVERR_"U" D TMPERR Q
I $O(^TMP("PRCV442A",$J,POIEN,""))]"" D
. S $P(^TMP("PRCV442A",$J,POIEN),"^",2)=1
I $O(^TMP("PRCV442A",$J,POIEN,""))']"" S PRCVERR=1 D Q Q ; no item detail
D EN^PRCVPOSD(POIEN)
Q
;
DEL(POIEN) ; Update DynaMed of DynaMed items on a cancelled PC order
;
; POIEN The IEN of the Purchase Order
;
N PRCVDATA,PRCVDDAT,PRCVERR,PRCVLINE
S PRCVERR=0
K ^TMP("PRCV442A",$J)
D PO(POIEN,.PRCVDATA,.PRCVERR)
I PRCVERR=1 Q
I PRCVERR>0 S PRCVERR=PRCVERR_"D" G TMPERR Q
S PRCVDDAT=$$NOW^XLFDT
S $P(^TMP("PRCV442A",$J,POIEN),"^",7)=PRCVDDAT
S PRCVLINE=0
S $P(^TMP("PRCV442A",$J,POIEN),"^",2)=5
F S PRCVLINE=$O(^PRC(442,POIEN,2,PRCVLINE)) Q:+PRCVLINE'>0!(PRCVLINE']"") D
. D ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
. I PRCVERR=1 Q
. I PRCVERR>0 S PRCVERR=PRCVERR_"D" D TMPERR Q
. D DELAUD^PRCV442B($P(^TMP("PRCV442A",$J,POIEN,PRCVLINE),"^",1),PRCVDDAT,DUZ,POIEN,$P(^TMP("PRCV442A",$J,POIEN,PRCVLINE),"^",3),"") ; update DynaMed audit file
I $O(^TMP("PRCV442A",$J,POIEN,""))']"" S PRCVERR=1 D Q Q ; no item detail
D EN^PRCVPOSD(POIEN)
Q
;
REC(POIEN,PARTIAL,ACTION) ; Update DynaMed of Receiving Report activity
;
; POIEN The IEN of the Purchase Order
; PARTIAL The number of the Receiving Report
; ACTION 1-signed ; 2-deleted
;
N PRCV,PRCVDAT,PRCVERR,PRCVLINE,PRCVRR,PRCVDATA,PRCVSIG
S PRCVSIG=$$GET1^DIQ(442.11,(PARTIAL_","_POIEN_","),10,"I") ;WH D/T signed (#10 n0p11)
I PRCVSIG']"" Q ; send only signed RR
; Find all the items in the RR, get the fields needed
K ^TMP("PRCV442A",$J)
S PRCVERR=0
D PO(POIEN,.PRCVDATA,.PRCVERR)
I PRCVERR=1 D Q Q ; order has MOP not used for DynaMed items
I PRCVERR>0 S PRCVERR=PRCVERR_ACTION D TMPERR Q
S PRCVDAT=$$NOW^XLFDT ; use for deletions
S PRCVLINE=0
F S PRCVLINE=$O(^PRC(442,POIEN,2,PRCVLINE)) Q:+PRCVLINE'>0!(PRCVLINE']"") D
. S PRCVRR=0
. F S PRCVRR=$O(^PRC(442,POIEN,2,PRCVLINE,3,PRCVRR)) Q:+PRCVRR'>0!(PRCVRR']"") I $P(^PRC(442,POIEN,2,PRCVLINE,3,PRCVRR,0),"^",4)=PARTIAL D
. . D ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
. . I PRCVERR=1 Q ; this is not a DM item
. . I PRCVERR>0 S PRCVERR=PRCVERR_ACTION D TMPERR Q
. . D RR(POIEN,PRCVLINE,PRCVRR,.PRCVERR,ACTION)
. . I ACTION=2 S PRCV=$G(^TMP("PRCV442A",$J,POIEN,PRCVLINE)) D RRAUD^PRCV442B(POIEN,PRCV,PRCVSIG,PRCVDAT)
. . I PRCVERR>1 S PRCVERR=PRCVERR_ACTION D TMPERR ; sends blanks to DM?
I $O(^TMP("PRCV442A",$J,POIEN,""))]"" D
. S $P(^TMP("PRCV442A",$J,POIEN),"^",7)=$S(ACTION=2:PRCVDAT,1:PRCVSIG)
. S $P(^TMP("PRCV442A",$J,POIEN),"^",2)=$S(ACTION=2:4,1:3)
. D EN^PRCVPOSD(POIEN)
I $O(^TMP("PRCV442A",$J,POIEN,""))']"" S PRCVERR=1 D Q ; no item detail
Q
;
TMPERR ;
; D TMPERR^PRCV442B
Q
;
Q I PRCVERR K ^TMP("PRCV442A",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCV442A 8371 printed Oct 16, 2024@18:20:38 Page 2
PRCV442A ;WOIFO/CC-GET PO VALUES TO SEND TO DYNAMED;1/29/05
V ;;5.1;IFCAP;**81,86**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
ITEM(POIEN,PRCVLINE,PRCVDATA,PRCVERR) ; Get Item data to send to DynaMed
+1 ;
+2 ; POIEN = the ien of the purchase order
+3 ; PRCVLINE = the ien of the line item number in the purchase order
+4 ; PRCVDATA = information from the PO level to keep for reference
+5 ; 2237 number ^ expected delivery date
+6 ; PRCVERR = flag to indicate if the item is not qualified for
+7 ; transmission to DynaMed as it has no DM DOC ID or an
+8 ; error occurred
+9 ;
+10 NEW PRCV,PRCVDD,PRCVL,PRCVI
+11 SET PRCVDD=""
SET PRCVERR=0
SET PRCVI=PRCVLINE_","_POIEN_","
+12 DO GETS^DIQ(442.01,PRCVI,".01;1.5;2;3;3.1;2;5;10;48","IE","PRCVL")
+13 ; item not on file in PO
IF $DATA(^TMP("DIERR",$JOB))
SET PRCVERR=3
QUIT
+14 ; DM Doc ID (#48 N2P15)
SET $PIECE(PRCV,"^",1)=PRCVL(442.01,PRCVI,48,"I")
+15 ; this is not a DM item
IF $PIECE(PRCV,"^",1)']""
SET PRCVERR=1
QUIT
+16 ; Item IEN (#1.5 N0 P5))
SET $PIECE(PRCV,"^",2)=PRCVL(442.01,PRCVI,1.5,"I")
+17 ; NIF
SET $PIECE(PRCV,"^",8)=$$GET1^DIQ(441,(PRCVL(442.01,PRCVI,1.5,"I")),51)
+18 ; line item# #.01 n0,p1
SET $PIECE(PRCV,"^",3)=PRCVL(442.01,PRCVI,.01,"E")
+19 ; QTY ORDERED (#2 N0 P 2)
SET $PIECE(PRCV,"^",6)=PRCVL(442.01,PRCVI,2,"I")
+20 ; UOP (#3 N 0 P 3)
SET $PIECE(PRCV,"^",5)=PRCVL(442.01,PRCVI,3,"E")
+21 ; pkg multiple (#3.1 N0 P12)
SET $PIECE(PRCV,"^",9)=PRCVL(442.01,PRCVI,"3.1","E")
+22 ; unit price (#5 N0 P 9)
SET $PIECE(PRCV,"^",7)=PRCVL(442.01,PRCVI,5,"I")
+23 ; 2237 IEN (#10 N0 P10)
SET $PIECE(PRCV,"^",4)=PRCVL(442.01,PRCVI,10,"E")
+24 IF $PIECE(PRCV,"^",4)']""
SET $PIECE(PRCV,"^",4)=$PIECE(PRCVDATA,"^",1)
+25 ; delivery date
DO DD(POIEN,PRCVL(442.01,PRCVI,.01,"E"),.PRCVDD)
+26 SET $PIECE(PRCV,"^",13)=PRCVDD
IF PRCVDD=""
SET $PIECE(PRCV,"^",13)=$PIECE(PRCVDATA,"^",2)
+27 SET ^TMP("PRCV442A",$JOB,POIEN,PRCVLINE)=PRCV
+28 ;
+29 QUIT
+30 ;
DD(POIEN,PRCVLINE,PRCVDD) ; get the earliest delivery date for the item
+1 ;
+2 ; POIEN = the ien of the purchase order
+3 ; PRCVLINE = the ien of the line item number in the purchase order
+4 ; PRCVDD = the purchase order's expected delivery date
+5 ;
+6 NEW PRCVDS,PRCVDZ
+7 SET PRCVDZ=""
SET PRCVDS=0
+8 FOR
SET PRCVDS=$ORDER(^PRC(442.8,"AC",POIEN,PRCVLINE,PRCVDS))
if +PRCVDS'>0!(PRCVDS']"")
QUIT
Begin DoDot:1
+9 ; get date from delivery schedule for item
SET PRCVDZ=$PIECE($GET(^PRC(442.8,PRCVDS,0)),"^",3)
+10 IF PRCVDZ<PRCVDD
SET PRCVDD=PRCVDZ
+11 IF PRCVDD']""
SET PRCVDD=PRCVDZ
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
PO(POIEN,PRCVDATA,PRCVERR) ; get PO information, station, DUZ
+1 ;
+2 ; POIEN = the ien of the purchase order
+3 ; PRCVDATA = information from the PO level to keep for reference
+4 ; 2237 number ^ expected delivery date
+5 ; PRCVERR = flag to indicate if the order is not a qualified DynaMed
+6 ; PO. 1 - indicates MOP is not suitable for a DM order
+7 ;
+8 NEW PRCV,PRCVV,PRCVP,PRCVPO
+9 SET PRCVERR=0
SET PRCVPO=POIEN_","
+10 DO GETS^DIQ(442,PRCVPO,".01;.02;.07;5;7;17;62","IE","PRCVP")
+11 ; PO not on file
IF $DATA(^TMP("DIERR",$JOB))
SET PRCVERR=2
QUIT
+12 ; MOP (#.02 - n0,p2)
IF PRCVP(442,PRCVPO,.02,"I")'=1
IF PRCVP(442,PRCVPO,.02,"I")'=25
SET PRCVERR=1
QUIT
+13 ; PO# (#.01 n0,p1)
SET $PIECE(PRCV,"^",1)=PRCVP(442,PRCVPO,.01,"E")
+14 ; vendor IEN (#5 n1 p1)
SET $PIECE(PRCV,"^",4)=PRCVP(442,PRCVPO,5,"I")
+15 ; get FMS vendor ID & alt addr code from file 440, #34# - n3 p4&5
+16 DO GETS^DIQ(440,PRCVP(442,PRCVPO,5,"I")_",","34:35","E","PRCVV")
+17 ; vendor info not on file
IF $DATA(^TMP("DIERR",$JOB))
GOTO PO1
+18 ; FMS vendor ID
SET $PIECE(PRCV,"^",5)=PRCVV(440,PRCVP(442,PRCVPO,5,"I")_",",34,"E")
+19 ; FMA alt add ind
SET $PIECE(PRCV,"^",6)=PRCVV(440,PRCVP(442,PRCVPO,5,"I")_",",35,"E")
PO1 ; date signed (un-amended POs) n12 p3
SET $PIECE(PRCV,"^",7)=PRCVP(442,PRCVPO,17,"I")
+1 ; for PC orders MOP=25, 2237 is in #62 N23,P23
SET PRCVDATA=PRCVP(442,PRCVPO,62,"E")
+2 ; for inv/rec MOP=1, 2237 is in #.07 - n0,p12
IF PRCVDATA']""
SET PRCVDATA=PRCVP(442,PRCVPO,.07,"E")
+3 ; delivery date (#7 n0p10)
SET $PIECE(PRCVDATA,"^",2)=PRCVP(442,PRCVPO,7,"I")
+4 ;
+5 ; get Station Number, DUZ
+6 SET $PIECE(PRCV,"^",8)=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+7 SET $PIECE(PRCV,"^",3)=DUZ
+8 ;
+9 SET ^TMP("PRCV442A",$JOB,POIEN)=PRCV
+10 QUIT
+11 ;
RR(POIEN,PRCVLINE,PRCVRR,PRCVERR,ACTION) ; get receipt data for item
+1 ;
+2 ; POIEN = the ien of the purchase order
+3 ; PRCVLINE = the ien of the line item number in the purchase order
+4 ; PRCVRR = the ien of the receiving report of interest
+5 ; PRCVERR = flag to indicate if the order does not qualify for
+6 ; transmission to DynaMed or error occurred
+7 ; ACTION = flag 1 - approved report ; 2- deleted report
+8 ;
+9 NEW PRCV,PRCVI,PRCVDEL,PRCVR
+10 SET PRCVI=PRCVRR_","_PRCVLINE_","_POIEN_","
+11 DO GETS^DIQ(442.08,PRCVI,"1;2;3;4","I","PRCVR")
+12 ; RR not on file
IF $DATA(^TMP("DIERR",$JOB))
SET PRCVERR=4
GOTO RR2
+13 SET PRCVDEL=""
IF ACTION=2
SET PRCVDEL="-"
+14 SET PRCV=$GET(^TMP("PRCV442A",$JOB,POIEN,PRCVLINE))
+15 ; qty received (#1, NO P2)
SET $PIECE(PRCV,"^",10)=PRCVDEL_PRCVR(442.08,PRCVI,1,"I")
+16 ; total item cost (#2 NO P3)
SET $PIECE(PRCV,"^",11)=PRCVDEL_PRCVR(442.08,PRCVI,2,"I")
+17 ; total discount for item(#4, N0 P5)
SET $PIECE(PRCV,"^",12)=PRCVDEL_PRCVR(442.08,PRCVI,4,"I")
+18 SET ^TMP("PRCV442A",$JOB,POIEN,PRCVLINE)=PRCV
RR2 QUIT
+1 ;
UPD(POIEN) ; Update DynaMed of Approved POs with DynaMed items on them
+1 ;
+2 ; POIEN The IEN of the Purchase Order
+3 ;
+4 NEW PRCVDATA,PRCVERR,PRCVLINE
+5 SET PRCVERR=0
+6 KILL ^TMP("PRCV442A",$JOB)
+7 DO PO(POIEN,.PRCVDATA,.PRCVERR)
+8 ; not a DynaMed order
IF PRCVERR=1
QUIT
+9 IF PRCVERR>0
SET PRCVERR=PRCVERR_"U"
GOTO TMPERR
QUIT
+10 SET PRCVLINE=0
+11 FOR
SET PRCVLINE=$ORDER(^PRC(442,POIEN,2,PRCVLINE))
if +PRCVLINE'>0!(PRCVLINE']"")
QUIT
Begin DoDot:1
+12 DO ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
+13 IF PRCVERR=1
QUIT
+14 IF PRCVERR>0
SET PRCVERR=PRCVERR_"U"
DO TMPERR
QUIT
End DoDot:1
+15 IF $ORDER(^TMP("PRCV442A",$JOB,POIEN,""))]""
Begin DoDot:1
+16 SET $PIECE(^TMP("PRCV442A",$JOB,POIEN),"^",2)=1
End DoDot:1
+17 ; no item detail
IF $ORDER(^TMP("PRCV442A",$JOB,POIEN,""))']""
SET PRCVERR=1
DO Q
QUIT
+18 DO EN^PRCVPOSD(POIEN)
+19 QUIT
+20 ;
DEL(POIEN) ; Update DynaMed of DynaMed items on a cancelled PC order
+1 ;
+2 ; POIEN The IEN of the Purchase Order
+3 ;
+4 NEW PRCVDATA,PRCVDDAT,PRCVERR,PRCVLINE
+5 SET PRCVERR=0
+6 KILL ^TMP("PRCV442A",$JOB)
+7 DO PO(POIEN,.PRCVDATA,.PRCVERR)
+8 IF PRCVERR=1
QUIT
+9 IF PRCVERR>0
SET PRCVERR=PRCVERR_"D"
GOTO TMPERR
QUIT
+10 SET PRCVDDAT=$$NOW^XLFDT
+11 SET $PIECE(^TMP("PRCV442A",$JOB,POIEN),"^",7)=PRCVDDAT
+12 SET PRCVLINE=0
+13 SET $PIECE(^TMP("PRCV442A",$JOB,POIEN),"^",2)=5
+14 FOR
SET PRCVLINE=$ORDER(^PRC(442,POIEN,2,PRCVLINE))
if +PRCVLINE'>0!(PRCVLINE']"")
QUIT
Begin DoDot:1
+15 DO ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
+16 IF PRCVERR=1
QUIT
+17 IF PRCVERR>0
SET PRCVERR=PRCVERR_"D"
DO TMPERR
QUIT
+18 ; update DynaMed audit file
DO DELAUD^PRCV442B($PIECE(^TMP("PRCV442A",$JOB,POIEN,PRCVLINE),"^",1),PRCVDDAT,DUZ,POIEN,$PIECE(^TMP("PRCV442A",$JOB,POIEN,PRCVLINE),"^",3),"")
End DoDot:1
+19 ; no item detail
IF $ORDER(^TMP("PRCV442A",$JOB,POIEN,""))']""
SET PRCVERR=1
DO Q
QUIT
+20 DO EN^PRCVPOSD(POIEN)
+21 QUIT
+22 ;
REC(POIEN,PARTIAL,ACTION) ; Update DynaMed of Receiving Report activity
+1 ;
+2 ; POIEN The IEN of the Purchase Order
+3 ; PARTIAL The number of the Receiving Report
+4 ; ACTION 1-signed ; 2-deleted
+5 ;
+6 NEW PRCV,PRCVDAT,PRCVERR,PRCVLINE,PRCVRR,PRCVDATA,PRCVSIG
+7 ;WH D/T signed (#10 n0p11)
SET PRCVSIG=$$GET1^DIQ(442.11,(PARTIAL_","_POIEN_","),10,"I")
+8 ; send only signed RR
IF PRCVSIG']""
QUIT
+9 ; Find all the items in the RR, get the fields needed
+10 KILL ^TMP("PRCV442A",$JOB)
+11 SET PRCVERR=0
+12 DO PO(POIEN,.PRCVDATA,.PRCVERR)
+13 ; order has MOP not used for DynaMed items
IF PRCVERR=1
DO Q
QUIT
+14 IF PRCVERR>0
SET PRCVERR=PRCVERR_ACTION
DO TMPERR
QUIT
+15 ; use for deletions
SET PRCVDAT=$$NOW^XLFDT
+16 SET PRCVLINE=0
+17 FOR
SET PRCVLINE=$ORDER(^PRC(442,POIEN,2,PRCVLINE))
if +PRCVLINE'>0!(PRCVLINE']"")
QUIT
Begin DoDot:1
+18 SET PRCVRR=0
+19 FOR
SET PRCVRR=$ORDER(^PRC(442,POIEN,2,PRCVLINE,3,PRCVRR))
if +PRCVRR'>0!(PRCVRR']"")
QUIT
IF $PIECE(^PRC(442,POIEN,2,PRCVLINE,3,PRCVRR,0),"^",4)=PARTIAL
Begin DoDot:2
+20 DO ITEM(POIEN,PRCVLINE,PRCVDATA,.PRCVERR)
+21 ; this is not a DM item
IF PRCVERR=1
QUIT
+22 IF PRCVERR>0
SET PRCVERR=PRCVERR_ACTION
DO TMPERR
QUIT
+23 DO RR(POIEN,PRCVLINE,PRCVRR,.PRCVERR,ACTION)
+24 IF ACTION=2
SET PRCV=$GET(^TMP("PRCV442A",$JOB,POIEN,PRCVLINE))
DO RRAUD^PRCV442B(POIEN,PRCV,PRCVSIG,PRCVDAT)
+25 ; sends blanks to DM?
IF PRCVERR>1
SET PRCVERR=PRCVERR_ACTION
DO TMPERR
End DoDot:2
End DoDot:1
+26 IF $ORDER(^TMP("PRCV442A",$JOB,POIEN,""))]""
Begin DoDot:1
+27 SET $PIECE(^TMP("PRCV442A",$JOB,POIEN),"^",7)=$SELECT(ACTION=2:PRCVDAT,1:PRCVSIG)
+28 SET $PIECE(^TMP("PRCV442A",$JOB,POIEN),"^",2)=$SELECT(ACTION=2:4,1:3)
+29 DO EN^PRCVPOSD(POIEN)
End DoDot:1
+30 ; no item detail
IF $ORDER(^TMP("PRCV442A",$JOB,POIEN,""))']""
SET PRCVERR=1
DO Q
+31 QUIT
+32 ;
TMPERR ;
+1 ; D TMPERR^PRCV442B
+2 QUIT
+3 ;
Q IF PRCVERR
KILL ^TMP("PRCV442A",$JOB)
+1 QUIT
