| 1 | PRCVRC1 ;WOIFO/BMM - silently build RIL for DynaMed ; 3/24/05 2:43pm
|
|---|
| 2 | V ;;5.1;IFCAP;**81**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;^XTMP format for incoming DM data is set:
|
|---|
| 6 | ;^XTMP("PRCVRE*ID",0)=termination date^entry date^ Transmit message
|
|---|
| 7 | ;to DynaMed for updates^date/time of this XTMP node built (debugging)
|
|---|
| 8 | ;^XTMP("PRCVRE*ID",0,"ERR")=Error message flag
|
|---|
| 9 | ;^XTMP("PRCVRE*ID",1)=Item counter/last item entered^FCP^CC^
|
|---|
| 10 | ;Order Control Code^Site Number^Date/Time message created^DUZ^
|
|---|
| 11 | ;Entered By Last Name^Entered by First Name
|
|---|
| 12 | ;^XTMP("PRCVRE*ID",1,n)=item #^quantity^vendor #^cost^Date Needed^
|
|---|
| 13 | ;DynaMed Document Number^NIF #^BOC
|
|---|
| 14 | ;^XTMP("PRCVRE*ID",1,n,"ERR")=error message
|
|---|
| 15 | ;
|
|---|
| 16 | ;need to validate the NIF# and BOC but not save to a file in IFCAP.
|
|---|
| 17 | ;send a message back to DM if validation fails
|
|---|
| 18 | ;
|
|---|
| 19 | ;pseudocode
|
|---|
| 20 | ;calling routine sends PRCVRE_message ID as parameter
|
|---|
| 21 | ;get information from ^XTMP
|
|---|
| 22 | ; validate NIF# and BOC, send back alerts if necessary
|
|---|
| 23 | ;look up the information on Item and Vendor that we need
|
|---|
| 24 | ;silently create the RIL in 410.3
|
|---|
| 25 | ; first create 410.3 record using Entry Number (site-FY-qtr-
|
|---|
| 26 | ; fcp-cc-txn#),
|
|---|
| 27 | ;if error - make ERR node for item in ^XTMP, he needs error code,
|
|---|
| 28 | ; severity, fields involved. if error is IFCAP (FileMan API) and
|
|---|
| 29 | ; not DM, send Vic an err at top level (1-node in XTMP) and he'll
|
|---|
| 30 | ; reject entire msg. else if FileMan API error is item-level then
|
|---|
| 31 | ; add to item-level ERR node
|
|---|
| 32 | ;
|
|---|
| 33 | ;summary info
|
|---|
| 34 | ;PRCVEF - error flag, set if any errors found with detail line
|
|---|
| 35 | ;PRCVLN1 - summary info line for record
|
|---|
| 36 | ;PRCVCTR - #detail line records
|
|---|
| 37 | ;PRCVDUZ - user DUZ
|
|---|
| 38 | ;PRCVIEN - new ien for RIL being created
|
|---|
| 39 | ;PRCVGL - global (first) subscript for ^XTMP
|
|---|
| 40 | ;PRCVMID - message id from PRCVGL (ID from comments above)
|
|---|
| 41 | ;PRCVFN, PRCVLN - user first and last name
|
|---|
| 42 | ;PRCVFCP - FCP
|
|---|
| 43 | ;PRCVHF - flag to prevent adding the header to the RIL if errors
|
|---|
| 44 | ;PRCVCC - CC
|
|---|
| 45 | ;PRCVOCC - Order Control Code
|
|---|
| 46 | ;PRCVST - site
|
|---|
| 47 | ;PRCVDT - date/time message created
|
|---|
| 48 | ;PRCVQTR - fiscal quarter
|
|---|
| 49 | ;PRCVFY - fiscal year
|
|---|
| 50 | ;PRCVSTR - becomes the RIL#, ST-FY-QTR-FCP-CC-TN
|
|---|
| 51 | ;PRCVTN - transaction#
|
|---|
| 52 | ;PRCVAS - data for Audit File #414.02,
|
|---|
| 53 | ; PRCVAS=DN-ITM-VN-DUZ-STR-DT-$$NOW^XLFDT
|
|---|
| 54 | ;PRCVAH - header data for Audit File, DUZ-LN-FN-STR-DT-$$NOW
|
|---|
| 55 | ;
|
|---|
| 56 | ;detail info
|
|---|
| 57 | ;PRCVMC - count of detail messages that get posted to 410.3. used
|
|---|
| 58 | ; to determine if any detail records were posted at all (if not
|
|---|
| 59 | ; then header is deleted and no RIL is created)
|
|---|
| 60 | ;PRCVA - array of values to add a detail record to 410.3
|
|---|
| 61 | ;PRCVDTL - each detail info line w/data below
|
|---|
| 62 | ;PRCVEL - counter for going through the detail records
|
|---|
| 63 | ;PRCVNIF - NIF #
|
|---|
| 64 | ;PRCVBOC - budget object code
|
|---|
| 65 | ;PRCVLF - flag to prevent adding a line item to the RIL if errors
|
|---|
| 66 | ;PRCVVN - vendor name
|
|---|
| 67 | ;PRCVCST - item unit cost
|
|---|
| 68 | ;PRCVQTY - quantity
|
|---|
| 69 | ;PRCVITM - item #
|
|---|
| 70 | ;PRCVDN - DynaMed document number
|
|---|
| 71 | ;PRCVDTN - date needed
|
|---|
| 72 | ;PRCVDR - date/time RIL is created
|
|---|
| 73 | ;
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | EN(PRCVGL) ;entry point
|
|---|
| 77 | Q:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
|
|---|
| 78 | N PRCVA,PRCVAH,PRCVAS,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR
|
|---|
| 79 | N PRCVDT,PRCVDTL,PRCVDN,PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP
|
|---|
| 80 | N PRCVFN,PRCVFY,PRCVHF,PRCVITM,PRCVIEN,PRCVLN,PRCVLN1,PRCVMID
|
|---|
| 81 | N PRCVMC,PRCVNIF,PRCVOCC,PRCVQTR,PRCVQTY,PRCVST,PRCVSTR,PRCVVN
|
|---|
| 82 | N PRCVVNM,PRCVTC,PRCVTN
|
|---|
| 83 | S (PRCVAH,PRCVAS,PRCVVNM,PRCVBOC,PRCVCC,PRCVFN,PRCVDR)=""
|
|---|
| 84 | S (PRCVCST,PRCVTC,PRCVDUZ,PRCVDT)=0,(PRCVDTL,PRCVDTN,PRCVA)=""
|
|---|
| 85 | S (PRCVEL,PRCVITM,PRCVLN,PRCVLN1)="",(PRCVFCP,PRCVFY,PRCVST)=0
|
|---|
| 86 | S (PRCVOCC,PRCVSTR,PRCVIEN)="",(PRCVNIF,PRCVQTR,PRCVQTY)=0
|
|---|
| 87 | S (PRCVCTR,PRCVMC,PRCVVN,PRCVTC,PRCVTN,PRCVIEN,PRCVHF)=0
|
|---|
| 88 | D:'$D(U) DT^DICRW
|
|---|
| 89 | ;check for existence of ^XTMP global, else quit
|
|---|
| 90 | I '$D(^XTMP(PRCVGL,0)) G EXIT
|
|---|
| 91 | ;get header and summary data on records, quit if undef
|
|---|
| 92 | S PRCVLN1=$G(^XTMP(PRCVGL,1))
|
|---|
| 93 | I PRCVLN1="" D G EXIT
|
|---|
| 94 | . D SENDMSG^PRCVRC2(2,PRCVGL,"",1)
|
|---|
| 95 | ;get message id - not needed for now
|
|---|
| 96 | ;S PRCVMID=$P(PRCVGL,"*",2)
|
|---|
| 97 | ;get data for other fields from ^XTMP
|
|---|
| 98 | S PRCVCTR=$P(PRCVLN1,U)+1
|
|---|
| 99 | I +PRCVCTR=1!(PRCVCTR'=+PRCVCTR) D S PRCVHF=1
|
|---|
| 100 | . D SENDMSG^PRCVRC2(1,PRCVGL,"",1)
|
|---|
| 101 | S PRCVDUZ=$P(PRCVLN1,U,7)
|
|---|
| 102 | S PRCVST=$P(PRCVLN1,U,5)
|
|---|
| 103 | S PRCVFCP=$P(PRCVLN1,U,2)
|
|---|
| 104 | I '$$CHKFCP^PRCVRC2(PRCVFCP,PRCVST) D S PRCVHF=1
|
|---|
| 105 | . D SENDMSG^PRCVRC2(25,PRCVGL,"",2)
|
|---|
| 106 | S PRCVCC=$P(PRCVLN1,U,3)
|
|---|
| 107 | ;check FCP and CC
|
|---|
| 108 | I '$$VALIDCC^PRCSECP(PRCVST,PRCVFCP,PRCVCC) D S PRCVHF=1
|
|---|
| 109 | . D SENDMSG^PRCVRC2(3,PRCVGL,"",3)
|
|---|
| 110 | ;S PRCVOCC=$O(PRCVLN1,U,4) not needed
|
|---|
| 111 | ;Date/time message created
|
|---|
| 112 | S PRCVDT=$P(PRCVLN1,U,6)
|
|---|
| 113 | ;check that PRCVDT is not in future
|
|---|
| 114 | I '$$CHKDT^PRCVRC2(PRCVDT) D S PRCVHF=1
|
|---|
| 115 | . D SENDMSG^PRCVRC2(4,PRCVGL,"",6)
|
|---|
| 116 | ;get date/time RIL created (now)
|
|---|
| 117 | S PRCVDR=$$NOW^XLFDT
|
|---|
| 118 | K PRCVA S PRCVA(410.3,"+1,",8)=PRCVDT
|
|---|
| 119 | S PRCVA(410.3,"+1,",4)=PRCVDR
|
|---|
| 120 | ;make Entry Number - in 410.3 not 410.31 multiple
|
|---|
| 121 | S PRCVQTR=$$GETQTR^PRCVRC2(PRCVDT)
|
|---|
| 122 | I 'PRCVQTR D SENDMSG^PRCVRC2(5,PRCVGL,"",6) S PRCVHF=1
|
|---|
| 123 | S PRCVFY=$$GETFY^PRCVRC2(PRCVDT)
|
|---|
| 124 | I 'PRCVFY D SENDMSG^PRCVRC2(6,PRCVGL,"",6) S PRCVHF=1
|
|---|
| 125 | S PRCVSTR=PRCVST_"-"_PRCVFY_"-"_PRCVQTR_"-"_PRCVFCP_"-"_PRCVCC
|
|---|
| 126 | S PRCVTN=$$GETTXN^PRCVRC2(PRCVSTR)
|
|---|
| 127 | I PRCVTN=0 D SENDMSG^PRCVRC2(7,PRCVGL,"",1) S PRCVHF=1
|
|---|
| 128 | S PRCVSTR=PRCVSTR_"-"_PRCVTN
|
|---|
| 129 | S PRCVA(410.3,"+1,",.01)=PRCVSTR
|
|---|
| 130 | ;validate DUZ
|
|---|
| 131 | S PRCVDUZ=$P(PRCVLN1,U,7)
|
|---|
| 132 | I '$$CHKDUZ^PRCVRC2(PRCVDUZ) D S PRCVHF=1
|
|---|
| 133 | . D SENDMSG^PRCVRC2(8,PRCVGL,"",7)
|
|---|
| 134 | ;create new RIL entry, new IEN in PRCVIEN(1)
|
|---|
| 135 | I 'PRCVHF D
|
|---|
| 136 | . D UPDATE^DIE("","PRCVA","PRCVIEN")
|
|---|
| 137 | . S PRCVIEN=$G(PRCVIEN(1))
|
|---|
| 138 | I PRCVHF K PRCVA
|
|---|
| 139 | ;user info- convert last name, first name to uppercase
|
|---|
| 140 | S PRCVLN=$$MAKECAP^PRCVRC2($P(PRCVLN1,U,8))
|
|---|
| 141 | S PRCVFN=$$MAKECAP^PRCVRC2($P(PRCVLN1,U,9))
|
|---|
| 142 | ;create header values string for Audit file
|
|---|
| 143 | S PRCVAH=PRCVDUZ_"^"_$E(PRCVLN_","_PRCVFN,1,35)_"^"_PRCVSTR
|
|---|
| 144 | S PRCVAH=PRCVAH_"^"_PRCVDR_"^"_PRCVDT
|
|---|
| 145 | ;
|
|---|
| 146 | ;get detail records. this is done inside loop to get all XTMP
|
|---|
| 147 | ;nodes for this FCP/CC
|
|---|
| 148 | S PRCVEL=1
|
|---|
| 149 | D1 S PRCVEL=PRCVEL+1,PRCVEF=0,PRCVAS=""
|
|---|
| 150 | G:PRCVEL>PRCVCTR EXIT
|
|---|
| 151 | S (PRCVDTL,PRCVVN)="" K PRCVA
|
|---|
| 152 | ;if no detail node then skip
|
|---|
| 153 | G:'$D(^XTMP(PRCVGL,2,PRCVEL-1)) D1
|
|---|
| 154 | ;detail info string
|
|---|
| 155 | S PRCVDTL=$G(^XTMP(PRCVGL,2,PRCVEL-1))
|
|---|
| 156 | ;get DynaMed doc id
|
|---|
| 157 | S PRCVDN=$P(PRCVDTL,U,6)
|
|---|
| 158 | I PRCVDN="" D S PRCVEF=1
|
|---|
| 159 | . D SENDMSG^PRCVRC2(24,PRCVGL,PRCVEL-1,1)
|
|---|
| 160 | I $D(^PRCV(414.02,"B",PRCVDN)) D S PRCVEF=1
|
|---|
| 161 | . D SENDMSG^PRCVRC2(22,PRCVGL,PRCVEL-1,6)
|
|---|
| 162 | S PRCVA(410.31,"+1,"_PRCVIEN_",",6)=PRCVDN
|
|---|
| 163 | ;Item
|
|---|
| 164 | S PRCVITM=$P(PRCVDTL,U)
|
|---|
| 165 | I '$$CHKITM^PRCVRC2(PRCVITM) D S PRCVEF=1
|
|---|
| 166 | . D SENDMSG^PRCVRC2(9,PRCVGL,PRCVEL-1,1)
|
|---|
| 167 | S PRCVA(410.31,"+1,"_PRCVIEN_",",.01)=PRCVITM
|
|---|
| 168 | ;Quantity
|
|---|
| 169 | S PRCVQTY=$P(PRCVDTL,U,2)
|
|---|
| 170 | I PRCVQTY'=+PRCVQTY D S PRCVEF=1
|
|---|
| 171 | . D SENDMSG^PRCVRC2(10,PRCVGL,PRCVEL-1,2)
|
|---|
| 172 | S PRCVA(410.31,"+1,"_PRCVIEN_",",1)=PRCVQTY
|
|---|
| 173 | ;Est. Item Unit Cost
|
|---|
| 174 | S PRCVCST=$P(PRCVDTL,U,4)
|
|---|
| 175 | I '(PRCVCST?.N.1".".2N) D S PRCVEF=1
|
|---|
| 176 | . D SENDMSG^PRCVRC2(11,PRCVGL,PRCVEL-1,4)
|
|---|
| 177 | S PRCVA(410.31,"+1,"_PRCVIEN_",",3)=PRCVCST
|
|---|
| 178 | ;Date Needed
|
|---|
| 179 | S PRCVDTN=$P(PRCVDTL,U,5)
|
|---|
| 180 | ;check that date needed is today or in future
|
|---|
| 181 | I '$$CHKDTN^PRCVRC2(PRCVDTN) D S PRCVEF=1
|
|---|
| 182 | . D SENDMSG^PRCVRC2(12,PRCVGL,PRCVEL-1,5)
|
|---|
| 183 | S PRCVA(410.31,"+1,"_PRCVIEN_",",7)=PRCVDTN
|
|---|
| 184 | ;Vendor # (pointer to 440)
|
|---|
| 185 | S PRCVVN=$P(PRCVDTL,U,3)
|
|---|
| 186 | I '$$CHKVEND^PRCVRC2(PRCVVN) D S PRCVEF=1
|
|---|
| 187 | . D SENDMSG^PRCVRC2(13,PRCVGL,PRCVEL-1,3)
|
|---|
| 188 | ;check that vendor and item relate
|
|---|
| 189 | I '$$CHKVI^PRCVRC2(PRCVVN,PRCVITM) D S PRCVEF=1
|
|---|
| 190 | . D SENDMSG^PRCVRC2(14,PRCVGL,PRCVEL-1,3)
|
|---|
| 191 | S PRCVA(410.31,"+1,"_PRCVIEN_",",4)=PRCVVN
|
|---|
| 192 | ;Vendor name
|
|---|
| 193 | S PRCVVNM=$$GET1^DIQ(440,PRCVVN_",",.01)
|
|---|
| 194 | I PRCVVNM="" D S PRCVEF=1
|
|---|
| 195 | . D SENDMSG^PRCVRC2(15,PRCVGL,PRCVEL-1,3)
|
|---|
| 196 | S PRCVA(410.31,"+1,"_PRCVIEN_",",2)=PRCVVNM
|
|---|
| 197 | ;create string to add entry to Audit file 414.02
|
|---|
| 198 | S PRCVAS=PRCVDN_"^"_PRCVITM_"^"_PRCVVN_"^"_PRCVAH_"^"_PRCVDTN
|
|---|
| 199 | ;add item record to 410.3 (if no errors)
|
|---|
| 200 | I 'PRCVEF D
|
|---|
| 201 | . D UPDATE^DIE("","PRCVA")
|
|---|
| 202 | . I $D(^TMP("DIERR",$J)) D Q
|
|---|
| 203 | . . D SENDMSG^PRCVRC2(16,PRCVGL,PRCVEL-1,6)
|
|---|
| 204 | . S PRCVMC=PRCVMC+1
|
|---|
| 205 | . ;add new item entry to DM Audit file
|
|---|
| 206 | . D ADDAUD^PRCVRC2(PRCVAS)
|
|---|
| 207 | . ;accumulate total cost
|
|---|
| 208 | . S PRCVTC=PRCVTC+(PRCVCST*PRCVQTY)
|
|---|
| 209 | ;
|
|---|
| 210 | S PRCVNIF=$P(PRCVDTL,U,7)
|
|---|
| 211 | ;validate NIF#
|
|---|
| 212 | I '$$CHKNIF^PRCVRC2(PRCVITM,PRCVNIF) D
|
|---|
| 213 | . D SENDMSG^PRCVRC2(17,PRCVGL,PRCVEL-1,7)
|
|---|
| 214 | S PRCVBOC=$P(PRCVDTL,U,8)
|
|---|
| 215 | ;validate BOC
|
|---|
| 216 | I '$$CHKBOC^PRCVRC2(PRCVITM,PRCVBOC) D
|
|---|
| 217 | . D SENDMSG^PRCVRC2(18,PRCVGL,PRCVEL-1,8)
|
|---|
| 218 | ;validate site/FCP/CC/BOC combination
|
|---|
| 219 | I '$$VALIDBOC^PRCSECP(PRCVST,PRCVFCP,PRCVCC,PRCVBOC) D
|
|---|
| 220 | . D SENDMSG^PRCVRC2(19,PRCVGL,PRCVEL-1,8)
|
|---|
| 221 | D2 G D1
|
|---|
| 222 | ;
|
|---|
| 223 | EXIT ;
|
|---|
| 224 | ;add total cost to entry
|
|---|
| 225 | I PRCVHF=0 D
|
|---|
| 226 | . K PRCVA S PRCVA(410.3,PRCVIEN_",",2)=PRCVTC
|
|---|
| 227 | . D UPDATE^DIE("","PRCVA")
|
|---|
| 228 | ;if no detail records added to RIL then kill it
|
|---|
| 229 | I PRCVMC=0,PRCVIEN>0 S DIK="^PRCS(410.3,",DA=PRCVIEN D ^DIK
|
|---|
| 230 | ;kill vars
|
|---|
| 231 | K PRCVA,PRCVBOC,PRCVCC,PRCVCST,PRCVCTR,PRCVDR,PRCVDT,PRCVDTL
|
|---|
| 232 | K PRCVDTN,PRCVDUZ,PRCVEF,PRCVEL,PRCVFCP,PRCVFN,PRCVFY,PRCVHF
|
|---|
| 233 | K PRCVITM,PRCVLN,PRCVLN1,PRCVMID,PRCVNIF,PRCVOCC,PRCVQTR
|
|---|
| 234 | K PRCVQTY,PRCVST,PRCVSTR,PRCVVN,PRCVVNM,PRCVTC,PRCVTN
|
|---|
| 235 | Q
|
|---|
| 236 | ;
|
|---|
