PRCVRC1 ;WOIFO/BMM - silently build RIL for DynaMed ; 3/24/05 2:43pm
V ;;5.1;IFCAP;**81**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
;^XTMP format for incoming DM data is set:
;^XTMP("PRCVRE*ID",0)=termination date^entry date^ Transmit message
;to DynaMed for updates^date/time of this XTMP node built (debugging)
;^XTMP("PRCVRE*ID",0,"ERR")=Error message flag
;^XTMP("PRCVRE*ID",1)=Item counter/last item entered^FCP^CC^
;Order Control Code^Site Number^Date/Time message created^DUZ^
;Entered By Last Name^Entered by First Name
;^XTMP("PRCVRE*ID",1,n)=item #^quantity^vendor #^cost^Date Needed^
;DynaMed Document Number^NIF #^BOC
;^XTMP("PRCVRE*ID",1,n,"ERR")=error message
;
;need to validate the NIF# and BOC but not save to a file in IFCAP.
;send a message back to DM if validation fails
;
;pseudocode
;calling routine sends PRCVRE_message ID as parameter
;get information from ^XTMP
; validate NIF# and BOC, send back alerts if necessary
;look up the information on Item and Vendor that we need
;silently create the RIL in 410.3
; first create 410.3 record using Entry Number (site-FY-qtr-
; fcp-cc-txn#),
;if error - make ERR node for item in ^XTMP, he needs error code,
; severity, fields involved. if error is IFCAP (FileMan API) and
; not DM, send Vic an err at top level (1-node in XTMP) and he'll
; reject entire msg. else if FileMan API error is item-level then
; add to item-level ERR node
;
;summary info
;PRCVEF - error flag, set if any errors found with detail line
;PRCVLN1 - summary info line for record
;PRCVCTR - #detail line records
;PRCVDUZ - user DUZ
;PRCVIEN - new ien for RIL being created
;PRCVGL - global (first) subscript for ^XTMP
;PRCVMID - message id from PRCVGL (ID from comments above)
;PRCVFN, PRCVLN - user first and last name
;PRCVFCP - FCP
;PRCVHF - flag to prevent adding the header to the RIL if errors
;PRCVCC - CC
;PRCVOCC - Order Control Code
;PRCVST - site
;PRCVDT - date/time message created
;PRCVQTR - fiscal quarter
;PRCVFY - fiscal year
;PRCVSTR - becomes the RIL#, ST-FY-QTR-FCP-CC-TN
;PRCVTN - transaction#
;PRCVAS - data for Audit File #414.02,
; PRCVAS=DN-ITM-VN-DUZ-STR-DT-$$NOW^XLFDT
;PRCVAH - header data for Audit File, DUZ-LN-FN-STR-DT-$$NOW
;
;detail info
;PRCVMC - count of detail messages that get posted to 410.3. used
; to determine if any detail records were posted at all (if not
; then header is deleted and no RIL is created)
;PRCVA - array of values to add a detail record to 410.3
;PRCVDTL - each detail info line w/data below
;PRCVEL - counter for going through the detail records
;PRCVNIF - NIF #
;PRCVBOC - budget object code
;PRCVLF - flag to prevent adding a line item to the RIL if errors
;PRCVVN - vendor name
;PRCVCST - item unit cost
;PRCVQTY - quantity
;PRCVITM - item #
;PRCVDN - DynaMed document number
;PRCVDTN - date needed
;PRCVDR - date/time RIL is created
;
Q
;
EN(PRCVGL) ;entry point
Q:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
N PRCVA,PRCVAH,PRCVAS,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR
N PRCVDT,PRCVDTL,PRCVDN,PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP
N PRCVFN,PRCVFY,PRCVHF,PRCVITM,PRCVIEN,PRCVLN,PRCVLN1,PRCVMID
N PRCVMC,PRCVNIF,PRCVOCC,PRCVQTR,PRCVQTY,PRCVST,PRCVSTR,PRCVVN
N PRCVVNM,PRCVTC,PRCVTN
S (PRCVAH,PRCVAS,PRCVVNM,PRCVBOC,PRCVCC,PRCVFN,PRCVDR)=""
S (PRCVCST,PRCVTC,PRCVDUZ,PRCVDT)=0,(PRCVDTL,PRCVDTN,PRCVA)=""
S (PRCVEL,PRCVITM,PRCVLN,PRCVLN1)="",(PRCVFCP,PRCVFY,PRCVST)=0
S (PRCVOCC,PRCVSTR,PRCVIEN)="",(PRCVNIF,PRCVQTR,PRCVQTY)=0
S (PRCVCTR,PRCVMC,PRCVVN,PRCVTC,PRCVTN,PRCVIEN,PRCVHF)=0
D:'$D(U) DT^DICRW
;check for existence of ^XTMP global, else quit
I '$D(^XTMP(PRCVGL,0)) G EXIT
;get header and summary data on records, quit if undef
S PRCVLN1=$G(^XTMP(PRCVGL,1))
I PRCVLN1="" D G EXIT
. D SENDMSG^PRCVRC2(2,PRCVGL,"",1)
;get message id - not needed for now
;S PRCVMID=$P(PRCVGL,"*",2)
;get data for other fields from ^XTMP
S PRCVCTR=$P(PRCVLN1,U)+1
I +PRCVCTR=1!(PRCVCTR'=+PRCVCTR) D S PRCVHF=1
. D SENDMSG^PRCVRC2(1,PRCVGL,"",1)
S PRCVDUZ=$P(PRCVLN1,U,7)
S PRCVST=$P(PRCVLN1,U,5)
S PRCVFCP=$P(PRCVLN1,U,2)
I '$$CHKFCP^PRCVRC2(PRCVFCP,PRCVST) D S PRCVHF=1
. D SENDMSG^PRCVRC2(25,PRCVGL,"",2)
S PRCVCC=$P(PRCVLN1,U,3)
;check FCP and CC
I '$$VALIDCC^PRCSECP(PRCVST,PRCVFCP,PRCVCC) D S PRCVHF=1
. D SENDMSG^PRCVRC2(3,PRCVGL,"",3)
;S PRCVOCC=$O(PRCVLN1,U,4) not needed
;Date/time message created
S PRCVDT=$P(PRCVLN1,U,6)
;check that PRCVDT is not in future
I '$$CHKDT^PRCVRC2(PRCVDT) D S PRCVHF=1
. D SENDMSG^PRCVRC2(4,PRCVGL,"",6)
;get date/time RIL created (now)
S PRCVDR=$$NOW^XLFDT
K PRCVA S PRCVA(410.3,"+1,",8)=PRCVDT
S PRCVA(410.3,"+1,",4)=PRCVDR
;make Entry Number - in 410.3 not 410.31 multiple
S PRCVQTR=$$GETQTR^PRCVRC2(PRCVDT)
I 'PRCVQTR D SENDMSG^PRCVRC2(5,PRCVGL,"",6) S PRCVHF=1
S PRCVFY=$$GETFY^PRCVRC2(PRCVDT)
I 'PRCVFY D SENDMSG^PRCVRC2(6,PRCVGL,"",6) S PRCVHF=1
S PRCVSTR=PRCVST_"-"_PRCVFY_"-"_PRCVQTR_"-"_PRCVFCP_"-"_PRCVCC
S PRCVTN=$$GETTXN^PRCVRC2(PRCVSTR)
I PRCVTN=0 D SENDMSG^PRCVRC2(7,PRCVGL,"",1) S PRCVHF=1
S PRCVSTR=PRCVSTR_"-"_PRCVTN
S PRCVA(410.3,"+1,",.01)=PRCVSTR
;validate DUZ
S PRCVDUZ=$P(PRCVLN1,U,7)
I '$$CHKDUZ^PRCVRC2(PRCVDUZ) D S PRCVHF=1
. D SENDMSG^PRCVRC2(8,PRCVGL,"",7)
;create new RIL entry, new IEN in PRCVIEN(1)
I 'PRCVHF D
. D UPDATE^DIE("","PRCVA","PRCVIEN")
. S PRCVIEN=$G(PRCVIEN(1))
I PRCVHF K PRCVA
;user info- convert last name, first name to uppercase
S PRCVLN=$$MAKECAP^PRCVRC2($P(PRCVLN1,U,8))
S PRCVFN=$$MAKECAP^PRCVRC2($P(PRCVLN1,U,9))
;create header values string for Audit file
S PRCVAH=PRCVDUZ_"^"_$E(PRCVLN_","_PRCVFN,1,35)_"^"_PRCVSTR
S PRCVAH=PRCVAH_"^"_PRCVDR_"^"_PRCVDT
;
;get detail records. this is done inside loop to get all XTMP
;nodes for this FCP/CC
S PRCVEL=1
D1 S PRCVEL=PRCVEL+1,PRCVEF=0,PRCVAS=""
G:PRCVEL>PRCVCTR EXIT
S (PRCVDTL,PRCVVN)="" K PRCVA
;if no detail node then skip
G:'$D(^XTMP(PRCVGL,2,PRCVEL-1)) D1
;detail info string
S PRCVDTL=$G(^XTMP(PRCVGL,2,PRCVEL-1))
;get DynaMed doc id
S PRCVDN=$P(PRCVDTL,U,6)
I PRCVDN="" D S PRCVEF=1
. D SENDMSG^PRCVRC2(24,PRCVGL,PRCVEL-1,1)
I $D(^PRCV(414.02,"B",PRCVDN)) D S PRCVEF=1
. D SENDMSG^PRCVRC2(22,PRCVGL,PRCVEL-1,6)
S PRCVA(410.31,"+1,"_PRCVIEN_",",6)=PRCVDN
;Item
S PRCVITM=$P(PRCVDTL,U)
I '$$CHKITM^PRCVRC2(PRCVITM) D S PRCVEF=1
. D SENDMSG^PRCVRC2(9,PRCVGL,PRCVEL-1,1)
S PRCVA(410.31,"+1,"_PRCVIEN_",",.01)=PRCVITM
;Quantity
S PRCVQTY=$P(PRCVDTL,U,2)
I PRCVQTY'=+PRCVQTY D S PRCVEF=1
. D SENDMSG^PRCVRC2(10,PRCVGL,PRCVEL-1,2)
S PRCVA(410.31,"+1,"_PRCVIEN_",",1)=PRCVQTY
;Est. Item Unit Cost
S PRCVCST=$P(PRCVDTL,U,4)
I '(PRCVCST?.N.1".".2N) D S PRCVEF=1
. D SENDMSG^PRCVRC2(11,PRCVGL,PRCVEL-1,4)
S PRCVA(410.31,"+1,"_PRCVIEN_",",3)=PRCVCST
;Date Needed
S PRCVDTN=$P(PRCVDTL,U,5)
;check that date needed is today or in future
I '$$CHKDTN^PRCVRC2(PRCVDTN) D S PRCVEF=1
. D SENDMSG^PRCVRC2(12,PRCVGL,PRCVEL-1,5)
S PRCVA(410.31,"+1,"_PRCVIEN_",",7)=PRCVDTN
;Vendor # (pointer to 440)
S PRCVVN=$P(PRCVDTL,U,3)
I '$$CHKVEND^PRCVRC2(PRCVVN) D S PRCVEF=1
. D SENDMSG^PRCVRC2(13,PRCVGL,PRCVEL-1,3)
;check that vendor and item relate
I '$$CHKVI^PRCVRC2(PRCVVN,PRCVITM) D S PRCVEF=1
. D SENDMSG^PRCVRC2(14,PRCVGL,PRCVEL-1,3)
S PRCVA(410.31,"+1,"_PRCVIEN_",",4)=PRCVVN
;Vendor name
S PRCVVNM=$$GET1^DIQ(440,PRCVVN_",",.01)
I PRCVVNM="" D S PRCVEF=1
. D SENDMSG^PRCVRC2(15,PRCVGL,PRCVEL-1,3)
S PRCVA(410.31,"+1,"_PRCVIEN_",",2)=PRCVVNM
;create string to add entry to Audit file 414.02
S PRCVAS=PRCVDN_"^"_PRCVITM_"^"_PRCVVN_"^"_PRCVAH_"^"_PRCVDTN
;add item record to 410.3 (if no errors)
I 'PRCVEF D
. D UPDATE^DIE("","PRCVA")
. I $D(^TMP("DIERR",$J)) D Q
. . D SENDMSG^PRCVRC2(16,PRCVGL,PRCVEL-1,6)
. S PRCVMC=PRCVMC+1
. ;add new item entry to DM Audit file
. D ADDAUD^PRCVRC2(PRCVAS)
. ;accumulate total cost
. S PRCVTC=PRCVTC+(PRCVCST*PRCVQTY)
;
S PRCVNIF=$P(PRCVDTL,U,7)
;validate NIF#
I '$$CHKNIF^PRCVRC2(PRCVITM,PRCVNIF) D
. D SENDMSG^PRCVRC2(17,PRCVGL,PRCVEL-1,7)
S PRCVBOC=$P(PRCVDTL,U,8)
;validate BOC
I '$$CHKBOC^PRCVRC2(PRCVITM,PRCVBOC) D
. D SENDMSG^PRCVRC2(18,PRCVGL,PRCVEL-1,8)
;validate site/FCP/CC/BOC combination
I '$$VALIDBOC^PRCSECP(PRCVST,PRCVFCP,PRCVCC,PRCVBOC) D
. D SENDMSG^PRCVRC2(19,PRCVGL,PRCVEL-1,8)
D2 G D1
;
EXIT ;
;add total cost to entry
I PRCVHF=0 D
. K PRCVA S PRCVA(410.3,PRCVIEN_",",2)=PRCVTC
. D UPDATE^DIE("","PRCVA")
;if no detail records added to RIL then kill it
I PRCVMC=0,PRCVIEN>0 S DIK="^PRCS(410.3,",DA=PRCVIEN D ^DIK
;kill vars
K PRCVA,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR,PRCVDT,PRCVDTL
K PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP,PRCVFN,PRCVFY,PRCVHF
K PRCVITM,PRCVLN,PRCVLN1,PRCVMID,PRCVNIF,PRCVOCC,PRCVQTR
K PRCVQTY,PRCVST,PRCVSTR,PRCVVN,PRCVVNM,PRCVTC,PRCVTN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVRC1 9084 printed Apr 09, 2024@21:19:15 Page 2
PRCVRC1 ;WOIFO/BMM - silently build RIL for DynaMed ; 3/24/05 2:43pm
V ;;5.1;IFCAP;**81**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 ;^XTMP format for incoming DM data is set:
+4 ;^XTMP("PRCVRE*ID",0)=termination date^entry date^ Transmit message
+5 ;to DynaMed for updates^date/time of this XTMP node built (debugging)
+6 ;^XTMP("PRCVRE*ID",0,"ERR")=Error message flag
+7 ;^XTMP("PRCVRE*ID",1)=Item counter/last item entered^FCP^CC^
+8 ;Order Control Code^Site Number^Date/Time message created^DUZ^
+9 ;Entered By Last Name^Entered by First Name
+10 ;^XTMP("PRCVRE*ID",1,n)=item #^quantity^vendor #^cost^Date Needed^
+11 ;DynaMed Document Number^NIF #^BOC
+12 ;^XTMP("PRCVRE*ID",1,n,"ERR")=error message
+13 ;
+14 ;need to validate the NIF# and BOC but not save to a file in IFCAP.
+15 ;send a message back to DM if validation fails
+16 ;
+17 ;pseudocode
+18 ;calling routine sends PRCVRE_message ID as parameter
+19 ;get information from ^XTMP
+20 ; validate NIF# and BOC, send back alerts if necessary
+21 ;look up the information on Item and Vendor that we need
+22 ;silently create the RIL in 410.3
+23 ; first create 410.3 record using Entry Number (site-FY-qtr-
+24 ; fcp-cc-txn#),
+25 ;if error - make ERR node for item in ^XTMP, he needs error code,
+26 ; severity, fields involved. if error is IFCAP (FileMan API) and
+27 ; not DM, send Vic an err at top level (1-node in XTMP) and he'll
+28 ; reject entire msg. else if FileMan API error is item-level then
+29 ; add to item-level ERR node
+30 ;
+31 ;summary info
+32 ;PRCVEF - error flag, set if any errors found with detail line
+33 ;PRCVLN1 - summary info line for record
+34 ;PRCVCTR - #detail line records
+35 ;PRCVDUZ - user DUZ
+36 ;PRCVIEN - new ien for RIL being created
+37 ;PRCVGL - global (first) subscript for ^XTMP
+38 ;PRCVMID - message id from PRCVGL (ID from comments above)
+39 ;PRCVFN, PRCVLN - user first and last name
+40 ;PRCVFCP - FCP
+41 ;PRCVHF - flag to prevent adding the header to the RIL if errors
+42 ;PRCVCC - CC
+43 ;PRCVOCC - Order Control Code
+44 ;PRCVST - site
+45 ;PRCVDT - date/time message created
+46 ;PRCVQTR - fiscal quarter
+47 ;PRCVFY - fiscal year
+48 ;PRCVSTR - becomes the RIL#, ST-FY-QTR-FCP-CC-TN
+49 ;PRCVTN - transaction#
+50 ;PRCVAS - data for Audit File #414.02,
+51 ; PRCVAS=DN-ITM-VN-DUZ-STR-DT-$$NOW^XLFDT
+52 ;PRCVAH - header data for Audit File, DUZ-LN-FN-STR-DT-$$NOW
+53 ;
+54 ;detail info
+55 ;PRCVMC - count of detail messages that get posted to 410.3. used
+56 ; to determine if any detail records were posted at all (if not
+57 ; then header is deleted and no RIL is created)
+58 ;PRCVA - array of values to add a detail record to 410.3
+59 ;PRCVDTL - each detail info line w/data below
+60 ;PRCVEL - counter for going through the detail records
+61 ;PRCVNIF - NIF #
+62 ;PRCVBOC - budget object code
+63 ;PRCVLF - flag to prevent adding a line item to the RIL if errors
+64 ;PRCVVN - vendor name
+65 ;PRCVCST - item unit cost
+66 ;PRCVQTY - quantity
+67 ;PRCVITM - item #
+68 ;PRCVDN - DynaMed document number
+69 ;PRCVDTN - date needed
+70 ;PRCVDR - date/time RIL is created
+71 ;
+72 QUIT
+73 ;
EN(PRCVGL) ;entry point
+1 if $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
QUIT
+2 NEW PRCVA,PRCVAH,PRCVAS,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR
+3 NEW PRCVDT,PRCVDTL,PRCVDN,PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP
+4 NEW PRCVFN,PRCVFY,PRCVHF,PRCVITM,PRCVIEN,PRCVLN,PRCVLN1,PRCVMID
+5 NEW PRCVMC,PRCVNIF,PRCVOCC,PRCVQTR,PRCVQTY,PRCVST,PRCVSTR,PRCVVN
+6 NEW PRCVVNM,PRCVTC,PRCVTN
+7 SET (PRCVAH,PRCVAS,PRCVVNM,PRCVBOC,PRCVCC,PRCVFN,PRCVDR)=""
+8 SET (PRCVCST,PRCVTC,PRCVDUZ,PRCVDT)=0
SET (PRCVDTL,PRCVDTN,PRCVA)=""
+9 SET (PRCVEL,PRCVITM,PRCVLN,PRCVLN1)=""
SET (PRCVFCP,PRCVFY,PRCVST)=0
+10 SET (PRCVOCC,PRCVSTR,PRCVIEN)=""
SET (PRCVNIF,PRCVQTR,PRCVQTY)=0
+11 SET (PRCVCTR,PRCVMC,PRCVVN,PRCVTC,PRCVTN,PRCVIEN,PRCVHF)=0
+12 if '$DATA(U)
DO DT^DICRW
+13 ;check for existence of ^XTMP global, else quit
+14 IF '$DATA(^XTMP(PRCVGL,0))
GOTO EXIT
+15 ;get header and summary data on records, quit if undef
+16 SET PRCVLN1=$GET(^XTMP(PRCVGL,1))
+17 IF PRCVLN1=""
Begin DoDot:1
+18 DO SENDMSG^PRCVRC2(2,PRCVGL,"",1)
End DoDot:1
GOTO EXIT
+19 ;get message id - not needed for now
+20 ;S PRCVMID=$P(PRCVGL,"*",2)
+21 ;get data for other fields from ^XTMP
+22 SET PRCVCTR=$PIECE(PRCVLN1,U)+1
+23 IF +PRCVCTR=1!(PRCVCTR'=+PRCVCTR)
Begin DoDot:1
+24 DO SENDMSG^PRCVRC2(1,PRCVGL,"",1)
End DoDot:1
SET PRCVHF=1
+25 SET PRCVDUZ=$PIECE(PRCVLN1,U,7)
+26 SET PRCVST=$PIECE(PRCVLN1,U,5)
+27 SET PRCVFCP=$PIECE(PRCVLN1,U,2)
+28 IF '$$CHKFCP^PRCVRC2(PRCVFCP,PRCVST)
Begin DoDot:1
+29 DO SENDMSG^PRCVRC2(25,PRCVGL,"",2)
End DoDot:1
SET PRCVHF=1
+30 SET PRCVCC=$PIECE(PRCVLN1,U,3)
+31 ;check FCP and CC
+32 IF '$$VALIDCC^PRCSECP(PRCVST,PRCVFCP,PRCVCC)
Begin DoDot:1
+33 DO SENDMSG^PRCVRC2(3,PRCVGL,"",3)
End DoDot:1
SET PRCVHF=1
+34 ;S PRCVOCC=$O(PRCVLN1,U,4) not needed
+35 ;Date/time message created
+36 SET PRCVDT=$PIECE(PRCVLN1,U,6)
+37 ;check that PRCVDT is not in future
+38 IF '$$CHKDT^PRCVRC2(PRCVDT)
Begin DoDot:1
+39 DO SENDMSG^PRCVRC2(4,PRCVGL,"",6)
End DoDot:1
SET PRCVHF=1
+40 ;get date/time RIL created (now)
+41 SET PRCVDR=$$NOW^XLFDT
+42 KILL PRCVA
SET PRCVA(410.3,"+1,",8)=PRCVDT
+43 SET PRCVA(410.3,"+1,",4)=PRCVDR
+44 ;make Entry Number - in 410.3 not 410.31 multiple
+45 SET PRCVQTR=$$GETQTR^PRCVRC2(PRCVDT)
+46 IF 'PRCVQTR
DO SENDMSG^PRCVRC2(5,PRCVGL,"",6)
SET PRCVHF=1
+47 SET PRCVFY=$$GETFY^PRCVRC2(PRCVDT)
+48 IF 'PRCVFY
DO SENDMSG^PRCVRC2(6,PRCVGL,"",6)
SET PRCVHF=1
+49 SET PRCVSTR=PRCVST_"-"_PRCVFY_"-"_PRCVQTR_"-"_PRCVFCP_"-"_PRCVCC
+50 SET PRCVTN=$$GETTXN^PRCVRC2(PRCVSTR)
+51 IF PRCVTN=0
DO SENDMSG^PRCVRC2(7,PRCVGL,"",1)
SET PRCVHF=1
+52 SET PRCVSTR=PRCVSTR_"-"_PRCVTN
+53 SET PRCVA(410.3,"+1,",.01)=PRCVSTR
+54 ;validate DUZ
+55 SET PRCVDUZ=$PIECE(PRCVLN1,U,7)
+56 IF '$$CHKDUZ^PRCVRC2(PRCVDUZ)
Begin DoDot:1
+57 DO SENDMSG^PRCVRC2(8,PRCVGL,"",7)
End DoDot:1
SET PRCVHF=1
+58 ;create new RIL entry, new IEN in PRCVIEN(1)
+59 IF 'PRCVHF
Begin DoDot:1
+60 DO UPDATE^DIE("","PRCVA","PRCVIEN")
+61 SET PRCVIEN=$GET(PRCVIEN(1))
End DoDot:1
+62 IF PRCVHF
KILL PRCVA
+63 ;user info- convert last name, first name to uppercase
+64 SET PRCVLN=$$MAKECAP^PRCVRC2($PIECE(PRCVLN1,U,8))
+65 SET PRCVFN=$$MAKECAP^PRCVRC2($PIECE(PRCVLN1,U,9))
+66 ;create header values string for Audit file
+67 SET PRCVAH=PRCVDUZ_"^"_$EXTRACT(PRCVLN_","_PRCVFN,1,35)_"^"_PRCVSTR
+68 SET PRCVAH=PRCVAH_"^"_PRCVDR_"^"_PRCVDT
+69 ;
+70 ;get detail records. this is done inside loop to get all XTMP
+71 ;nodes for this FCP/CC
+72 SET PRCVEL=1
D1 SET PRCVEL=PRCVEL+1
SET PRCVEF=0
SET PRCVAS=""
+1 if PRCVEL>PRCVCTR
GOTO EXIT
+2 SET (PRCVDTL,PRCVVN)=""
KILL PRCVA
+3 ;if no detail node then skip
+4 if '$DATA(^XTMP(PRCVGL,2,PRCVEL-1))
GOTO D1
+5 ;detail info string
+6 SET PRCVDTL=$GET(^XTMP(PRCVGL,2,PRCVEL-1))
+7 ;get DynaMed doc id
+8 SET PRCVDN=$PIECE(PRCVDTL,U,6)
+9 IF PRCVDN=""
Begin DoDot:1
+10 DO SENDMSG^PRCVRC2(24,PRCVGL,PRCVEL-1,1)
End DoDot:1
SET PRCVEF=1
+11 IF $DATA(^PRCV(414.02,"B",PRCVDN))
Begin DoDot:1
+12 DO SENDMSG^PRCVRC2(22,PRCVGL,PRCVEL-1,6)
End DoDot:1
SET PRCVEF=1
+13 SET PRCVA(410.31,"+1,"_PRCVIEN_",",6)=PRCVDN
+14 ;Item
+15 SET PRCVITM=$PIECE(PRCVDTL,U)
+16 IF '$$CHKITM^PRCVRC2(PRCVITM)
Begin DoDot:1
+17 DO SENDMSG^PRCVRC2(9,PRCVGL,PRCVEL-1,1)
End DoDot:1
SET PRCVEF=1
+18 SET PRCVA(410.31,"+1,"_PRCVIEN_",",.01)=PRCVITM
+19 ;Quantity
+20 SET PRCVQTY=$PIECE(PRCVDTL,U,2)
+21 IF PRCVQTY'=+PRCVQTY
Begin DoDot:1
+22 DO SENDMSG^PRCVRC2(10,PRCVGL,PRCVEL-1,2)
End DoDot:1
SET PRCVEF=1
+23 SET PRCVA(410.31,"+1,"_PRCVIEN_",",1)=PRCVQTY
+24 ;Est. Item Unit Cost
+25 SET PRCVCST=$PIECE(PRCVDTL,U,4)
+26 IF '(PRCVCST?.N.1".".2N)
Begin DoDot:1
+27 DO SENDMSG^PRCVRC2(11,PRCVGL,PRCVEL-1,4)
End DoDot:1
SET PRCVEF=1
+28 SET PRCVA(410.31,"+1,"_PRCVIEN_",",3)=PRCVCST
+29 ;Date Needed
+30 SET PRCVDTN=$PIECE(PRCVDTL,U,5)
+31 ;check that date needed is today or in future
+32 IF '$$CHKDTN^PRCVRC2(PRCVDTN)
Begin DoDot:1
+33 DO SENDMSG^PRCVRC2(12,PRCVGL,PRCVEL-1,5)
End DoDot:1
SET PRCVEF=1
+34 SET PRCVA(410.31,"+1,"_PRCVIEN_",",7)=PRCVDTN
+35 ;Vendor # (pointer to 440)
+36 SET PRCVVN=$PIECE(PRCVDTL,U,3)
+37 IF '$$CHKVEND^PRCVRC2(PRCVVN)
Begin DoDot:1
+38 DO SENDMSG^PRCVRC2(13,PRCVGL,PRCVEL-1,3)
End DoDot:1
SET PRCVEF=1
+39 ;check that vendor and item relate
+40 IF '$$CHKVI^PRCVRC2(PRCVVN,PRCVITM)
Begin DoDot:1
+41 DO SENDMSG^PRCVRC2(14,PRCVGL,PRCVEL-1,3)
End DoDot:1
SET PRCVEF=1
+42 SET PRCVA(410.31,"+1,"_PRCVIEN_",",4)=PRCVVN
+43 ;Vendor name
+44 SET PRCVVNM=$$GET1^DIQ(440,PRCVVN_",",.01)
+45 IF PRCVVNM=""
Begin DoDot:1
+46 DO SENDMSG^PRCVRC2(15,PRCVGL,PRCVEL-1,3)
End DoDot:1
SET PRCVEF=1
+47 SET PRCVA(410.31,"+1,"_PRCVIEN_",",2)=PRCVVNM
+48 ;create string to add entry to Audit file 414.02
+49 SET PRCVAS=PRCVDN_"^"_PRCVITM_"^"_PRCVVN_"^"_PRCVAH_"^"_PRCVDTN
+50 ;add item record to 410.3 (if no errors)
+51 IF 'PRCVEF
Begin DoDot:1
+52 DO UPDATE^DIE("","PRCVA")
+53 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:2
+54 DO SENDMSG^PRCVRC2(16,PRCVGL,PRCVEL-1,6)
End DoDot:2
QUIT
+55 SET PRCVMC=PRCVMC+1
+56 ;add new item entry to DM Audit file
+57 DO ADDAUD^PRCVRC2(PRCVAS)
+58 ;accumulate total cost
+59 SET PRCVTC=PRCVTC+(PRCVCST*PRCVQTY)
End DoDot:1
+60 ;
+61 SET PRCVNIF=$PIECE(PRCVDTL,U,7)
+62 ;validate NIF#
+63 IF '$$CHKNIF^PRCVRC2(PRCVITM,PRCVNIF)
Begin DoDot:1
+64 DO SENDMSG^PRCVRC2(17,PRCVGL,PRCVEL-1,7)
End DoDot:1
+65 SET PRCVBOC=$PIECE(PRCVDTL,U,8)
+66 ;validate BOC
+67 IF '$$CHKBOC^PRCVRC2(PRCVITM,PRCVBOC)
Begin DoDot:1
+68 DO SENDMSG^PRCVRC2(18,PRCVGL,PRCVEL-1,8)
End DoDot:1
+69 ;validate site/FCP/CC/BOC combination
+70 IF '$$VALIDBOC^PRCSECP(PRCVST,PRCVFCP,PRCVCC,PRCVBOC)
Begin DoDot:1
+71 DO SENDMSG^PRCVRC2(19,PRCVGL,PRCVEL-1,8)
End DoDot:1
D2 GOTO D1
+1 ;
EXIT ;
+1 ;add total cost to entry
+2 IF PRCVHF=0
Begin DoDot:1
+3 KILL PRCVA
SET PRCVA(410.3,PRCVIEN_",",2)=PRCVTC
+4 DO UPDATE^DIE("","PRCVA")
End DoDot:1
+5 ;if no detail records added to RIL then kill it
+6 IF PRCVMC=0
IF PRCVIEN>0
SET DIK="^PRCS(410.3,"
SET DA=PRCVIEN
DO ^DIK
+7 ;kill vars
+8 KILL PRCVA,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR,PRCVDT,PRCVDTL
+9 KILL PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP,PRCVFN,PRCVFY,PRCVHF
+10 KILL PRCVITM,PRCVLN,PRCVLN1,PRCVMID,PRCVNIF,PRCVOCC,PRCVQTR
+11 KILL PRCVQTY,PRCVST,PRCVSTR,PRCVVN,PRCVVNM,PRCVTC,PRCVTN
+12 QUIT
+13 ;
