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

PRCV442A.m

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